1304202a |
1 | #! /usr/bin/tclsh |
2 | |
3 | package require "elite" "1.0.0" |
4 | |
5 | set g $galaxy1 |
6 | set ng 1 |
7 | set weight weight-hops |
8 | for {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 | |
45 | set r {} |
46 | set ww [worldinfo $g] |
47 | foreach-world $g ii { |
48 | set px($ii(seed)) 1 |
49 | } |
50 | foreach 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 | } |
62 | if {[llength $r] < 2} { |
63 | puts stderr "usage: $argv0 \[-g GALAXY\] \[-w WEIGHT\] PLANET PLANET ..." |
64 | exit 1 |
65 | } |
66 | puts -nonewline stderr "\[computing adjacency table..." |
67 | adjacency $ww adj |
68 | puts stderr " done\]" |
69 | set home [lindex $r 0] |
70 | set rt {} |
71 | foreach 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 | } |
80 | set last x |
81 | foreach s $rt { |
82 | if {![string equal $s $last]} { |
83 | puts [world-summary $s] |
84 | set last $s |
85 | } |
86 | } |