chiark / gitweb /
Print seed -- it's useful.
[rocl] / elite-path
CommitLineData
1304202a 1#! /usr/bin/tclsh
b130b8f5 2#
2b1a5911 3# $Id: elite-path,v 1.4 2003/03/07 00:42:10 mdw Exp $
1304202a 4
2b1a5911 5package require "elite" "1.0.1"
1304202a 6
7set g $galaxy1
8set ng 1
9set weight weight-hops
2b1a5911 10set d 70
2f931a32 11set acc distance
1304202a 12for {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 }
2b1a5911 25 "-d" {
26 incr i
27 set d [expr {int([lindex $argv $i] * 10)}]
28 }
1304202a 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 }
2f931a32 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 }
1304202a 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
64set r {}
2b1a5911 65set ww [elite-galaxylist $g]
1304202a 66foreach-world $g ii {
67 set px($ii(seed)) 1
68}
69foreach 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}
81if {[llength $r] < 2} {
2b1a5911 82 puts stderr "usage: $argv0 \[-g GAL\] \[-d DIST\] \[-w WEIGHT\] \[-a ACC\] PLANET PLANET ..."
1304202a 83 exit 1
84}
2b1a5911 85elite-adjacency adj $ww $d
1304202a 86set home [lindex $r 0]
2f931a32 87set start $home
1304202a 88set rt {}
2f931a32 89set tm 0
1304202a 90foreach w [lrange $r 1 end] {
2f931a32 91 destructure {p m} [shortest-path adj $home $w $weight]
1304202a 92 if {![llength $p]} {
2b1a5911 93 puts stderr "$argv0: no route from [worldname $home] to [worldname $w]"
1304202a 94 exit 1
95 }
2f931a32 96 set tm [expr {$tm + $m}]
1304202a 97 eval lappend rt $p
98 set home $w
99}
2f931a32 100puts [format " 1 %s" [world-summary $start]]
101set last $start
102unset p
103elite-worldinfo p $start
104destructure {x y} [list $p(x) $p(y)]
105set h 1
106set td 0
107set tw 0
1304202a 108foreach s $rt {
109 if {![string equal $s $last]} {
2f931a32 110 elite-worldinfo p $s
2b1a5911 111 set d [expr {[elite-distance $x $y $p(x) $p(y)]/10.0}]
2f931a32 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)]
1304202a 128 set last $s
129 }
130}
2f931a32 131if {$tw != $tm} { error "inconsistent metric ($tw != $tm)" }
2b1a5911 132set summ "# ("
2f931a32 133set sep ""
134if {![string equal $acc "distance"]} {
135 append summ [format "%stotal distance = %.1f LY" $sep $td]
136 set sep "; "
137}
138if {![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}
143append summ ")"
2b1a5911 144if {![string equal $summ "# ()"]} { puts $summ }