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