1304202a |
1 | #! /usr/bin/tclsh |
b130b8f5 |
2 | # |
2f931a32 |
3 | # $Id: elite-path,v 1.3 2003/03/04 10:26:18 mdw Exp $ |
1304202a |
4 | |
5 | package require "elite" "1.0.0" |
6 | |
7 | set g $galaxy1 |
8 | set ng 1 |
9 | set weight weight-hops |
2f931a32 |
10 | set acc distance |
1304202a |
11 | for {set i 0} {$i < [llength $argv]} {incr i} { |
12 | set a [lindex $argv $i] |
13 | switch -glob -- $a { |
14 | "-g" { |
15 | incr i |
16 | set a [lindex $argv $i] |
17 | set g [parse-galaxy-spec $a] |
18 | if {[string equal $g ""]} { |
19 | puts stderr "$argv0: bad galaxy string `$a'" |
20 | exit 1 |
21 | } |
22 | destructure {ng g} $g |
23 | } |
24 | "-w" { |
25 | incr i |
26 | set a [lindex $argv $i] |
27 | set weight "weight-$a" |
28 | if {[lsearch -exact [info commands "weight-*"] $weight] == -1} { |
29 | puts stderr "$argv0: unknown weight function `$a'" |
30 | puts stderr "$argv0: I know [info commands weight-*]" |
31 | exit 1 |
32 | } |
33 | } |
2f931a32 |
34 | "-a" { |
35 | incr i |
36 | set a [lindex $argv $i] |
37 | switch -exact -- $a { |
38 | "none" - "distance" - "weight" { set acc $a } |
39 | default { |
40 | puts stderr "$argv0: unknown accumulation `$a'" |
41 | puts stderr "$argv0: I know `none', `distance' and `weight'" |
42 | } |
43 | } |
44 | } |
1304202a |
45 | "--" { |
46 | incr i |
47 | break |
48 | } |
49 | "-*" { |
50 | puts stderr "unknown switch `$a'" |
51 | exit 1 |
52 | } |
53 | default { |
54 | break |
55 | } |
56 | } |
57 | } |
58 | |
59 | set r {} |
60 | set ww [worldinfo $g] |
61 | foreach-world $g ii { |
62 | set px($ii(seed)) 1 |
63 | } |
64 | foreach a [lrange $argv $i end] { |
65 | set s [parse-planet-spec $g $a] |
66 | if {[string equal $s ""]} { |
67 | puts stderr "$argv0: unknown planet `$a'" |
68 | exit 1 |
69 | } |
70 | if {![info exists px($s)]} { |
71 | puts stderr "$argv0: planet `$a' doesn't exist in galaxy $ng" |
72 | exit 1 |
73 | } |
74 | lappend r $s |
75 | } |
76 | if {[llength $r] < 2} { |
2f931a32 |
77 | puts stderr "usage: $argv0 \[-g GALAXY\] \[-w WEIGHT\] \[-a ACC\] PLANET PLANET ..." |
1304202a |
78 | exit 1 |
79 | } |
80 | puts -nonewline stderr "\[computing adjacency table..." |
81 | adjacency $ww adj |
82 | puts stderr " done\]" |
83 | set home [lindex $r 0] |
2f931a32 |
84 | set start $home |
1304202a |
85 | set rt {} |
2f931a32 |
86 | set tm 0 |
1304202a |
87 | foreach w [lrange $r 1 end] { |
2f931a32 |
88 | destructure {p m} [shortest-path adj $home $w $weight] |
1304202a |
89 | if {![llength $p]} { |
90 | puts -stderr "$argv0: no route from [worldinfo $home] to [worldinfo $w]" |
91 | exit 1 |
92 | } |
2f931a32 |
93 | set tm [expr {$tm + $m}] |
1304202a |
94 | eval lappend rt $p |
95 | set home $w |
96 | } |
2f931a32 |
97 | puts [format " 1 %s" [world-summary $start]] |
98 | set last $start |
99 | unset p |
100 | elite-worldinfo p $start |
101 | destructure {x y} [list $p(x) $p(y)] |
102 | set h 1 |
103 | set td 0 |
104 | set tw 0 |
1304202a |
105 | foreach s $rt { |
106 | if {![string equal $s $last]} { |
2f931a32 |
107 | elite-worldinfo p $s |
108 | set d [expr {[world-distance $x $y $p(x) $p(y)]/10.0}] |
109 | incr h |
110 | set td [expr {$td + $d}] |
111 | set summ [format "%3d %s" $h [world-summary $s]] |
112 | set w [eval $weight [list $last $s]] |
113 | set tw [expr {$tw + $w}] |
114 | switch -- $acc { |
115 | "none" { } |
116 | "distance" { |
117 | append summ [format " (+ %.1f = %.1f LY)" $d $td] |
118 | } |
119 | "weight" { |
120 | append summ [format " (+ %s = %s)" $w $tw] |
121 | } |
122 | } |
123 | puts $summ |
124 | destructure {x y} [list $p(x) $p(y)] |
1304202a |
125 | set last $s |
126 | } |
127 | } |
2f931a32 |
128 | if {$tw != $tm} { error "inconsistent metric ($tw != $tm)" } |
129 | set summ "(" |
130 | set sep "" |
131 | if {![string equal $acc "distance"]} { |
132 | append summ [format "%stotal distance = %.1f LY" $sep $td] |
133 | set sep "; " |
134 | } |
135 | if {![string equal $weight "weight-hops"] && \ |
136 | ![string equal $weight "weight-fuel"] && \ |
137 | ![string equal $acc "weight"]} { |
138 | append summ [format "%stotal metric = %s" $sep $tm] |
139 | } |
140 | append summ ")" |
141 | if {![string equal $summ "()"]} { puts $summ } |