chiark / gitweb /
Distribute elite.tcl. Duh.
[rocl] / elite-path
CommitLineData
1304202a 1#! /usr/bin/tclsh
2
3package require "elite" "1.0.0"
4
5set g $galaxy1
6set ng 1
7set weight weight-hops
8for {set i 0} {$i < [llength $argv]} {incr i} {
9 set a [lindex $argv $i]
10 switch -glob -- $a {
11 "-g" {
12 incr i
13 set a [lindex $argv $i]
14 set g [parse-galaxy-spec $a]
15 if {[string equal $g ""]} {
16 puts stderr "$argv0: bad galaxy string `$a'"
17 exit 1
18 }
19 destructure {ng g} $g
20 }
21 "-w" {
22 incr i
23 set a [lindex $argv $i]
24 set weight "weight-$a"
25 if {[lsearch -exact [info commands "weight-*"] $weight] == -1} {
26 puts stderr "$argv0: unknown weight function `$a'"
27 puts stderr "$argv0: I know [info commands weight-*]"
28 exit 1
29 }
30 }
31 "--" {
32 incr i
33 break
34 }
35 "-*" {
36 puts stderr "unknown switch `$a'"
37 exit 1
38 }
39 default {
40 break
41 }
42 }
43}
44
45set r {}
46set ww [worldinfo $g]
47foreach-world $g ii {
48 set px($ii(seed)) 1
49}
50foreach a [lrange $argv $i end] {
51 set s [parse-planet-spec $g $a]
52 if {[string equal $s ""]} {
53 puts stderr "$argv0: unknown planet `$a'"
54 exit 1
55 }
56 if {![info exists px($s)]} {
57 puts stderr "$argv0: planet `$a' doesn't exist in galaxy $ng"
58 exit 1
59 }
60 lappend r $s
61}
62if {[llength $r] < 2} {
63 puts stderr "usage: $argv0 \[-g GALAXY\] \[-w WEIGHT\] PLANET PLANET ..."
64 exit 1
65}
66puts -nonewline stderr "\[computing adjacency table..."
67adjacency $ww adj
68puts stderr " done\]"
69set home [lindex $r 0]
70set rt {}
71foreach w [lrange $r 1 end] {
72 destructure {p .} [shortest-path adj $home $w $weight]
73 if {![llength $p]} {
74 puts -stderr "$argv0: no route from [worldinfo $home] to [worldinfo $w]"
75 exit 1
76 }
77 eval lappend rt $p
78 set home $w
79}
80set last x
81foreach s $rt {
82 if {![string equal $s $last]} {
83 puts [world-summary $s]
84 set last $s
85 }
86}