chiark / gitweb /
Fix output formatting a little.
[rocl] / elite-map
CommitLineData
1304202a 1#! /usr/bin/tclsh
b130b8f5 2#
161e6ada 3# $Id: elite-map,v 1.4 2003/03/07 00:41:46 mdw Exp $
1304202a 4
5package require "elite" "1.0.0"
6
7set syms "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
8proc symbol {i} {
9 global syms
10 if {$i < [string length $syms]} {
11 return [string index $syms $i]
12 }
13 set hi [expr {$i / [string length $syms]}]
14 set lo [expr {$i % [string length $syms]}]
15 return [string index $syms $hi][string index $syms $lo]
16}
17
e1721994 18proc show-map {asp wx wy ww {n {}} {p {}}} {
1304202a 19 set minx 10000
20 set miny 10000
21 set maxx 0
22 set maxy 0
23
e1721994 24 set lmain {}
25 set lmagic {}
26 set lpath {}
27 if {[llength $n] == 1} {
28 set w [lindex $n 0]
29 set fancy($w) "*"
30 lappend lmagic $fancy($w) $w
31 } else {
32 set i 0
33 foreach w $n {
34 if {![info exists fancy($w)]} {
35 set fancy($w) "*[symbol $i]"
36 lappend lmagic $fancy($w) $w
37 incr i
38 }
39 }
40 }
41 set i 0
42 foreach w $p {
43 if {![info exists fancy($w)]} {
44 set fancy($w) "+[symbol $i]"
45 lappend lpath $fancy($w) $w
46 incr i
47 }
48 }
1304202a 49 foreach {s x y} $ww {
50 if {$x < $minx} { set minx $x}
51 if {$y < $miny} { set miny $y}
52 if {$x > $maxx} { set maxx $x}
53 if {$y > $maxy} { set maxy $y}
54 }
55 set dx [expr {$maxx - $minx}]
56 set dy [expr {$maxy - $miny}]
57 if {$dx == 0} { set dx 1 }
58 if {$dy == 0} { set dy 1 }
59
60 set sc [expr {$wx/double($dx)}]
61 if {$dy * $sc/$asp > $wy} {
62 set sc [expr {$wy * $asp/double($dy)}]
63 }
64 set gw {}
65 foreach {s x y} $ww {
66 set gx [expr {int(($x - $minx) * $sc + 0.5)}]
67 set gy [expr {int(($y - $miny) * $sc/$asp + 0.5)}]
68 lappend gw [list $s $gx $gy]
69 }
70
71 set pw [lsort -index 1 -integer -increasing $gw]
72 set pw [lsort -index 2 -integer -increasing $pw]
73 set x 0
74 set y 0
75 set i 0
1304202a 76 foreach w $pw {
77 destructure {s px py} $w
78 if {$y < $py} {
79 puts -nonewline [string repeat "\n" [expr {$py - $y}]]
80 set x 0
81 set y $py
82 }
83 if {$x < $px} {
84 puts -nonewline [string repeat " " [expr {$px - $x}]]
85 set x $px
86 }
e1721994 87 set l lmain
88 if {[info exists fancy($s)]} {
89 set sy $fancy($s)
1304202a 90 } else {
91 set sy [symbol $i]
e1721994 92 lappend $l $sy $s
1304202a 93 incr i
94 }
95 puts -nonewline $sy
96 incr x [string length $sy]
1304202a 97 }
98 puts -nonewline "\n"
e1721994 99 return [list $lmagic $lpath $lmain]
1304202a 100}
101
e1721994 102proc show-key {l {n {}}} {
1304202a 103 global gov eco
e1721994 104 if {[llength $n]} {
105 elite-worldinfo p [lindex $n 0]
1304202a 106 }
107 foreach {sy s} $l {
108 elite-worldinfo pp $s
109 set out [format "%2s %s" $sy [world-summary $s]]
e1721994 110 if {[llength $n]} {
1304202a 111 append out [format " (%.1f LY)" \
161e6ada 112 [expr {[elite-distance $p(x) $p(y) $pp(x) $pp(y)]/10.0}]]
1304202a 113 }
114 puts $out
115 }
116}
117
1304202a 118set g $galaxy1
119set wx 72
120set wy 10
121set asp 2.17
122set d 70
e1721994 123set v 2
124set weight {}
125set usage "usage: $argv0 \[-qv\] \[-g GAL\] \[-d DIST\] \[-w WEIGHT\]\n\t\[-W WD,HT\] \[-a ASP\] \[PLANET ...\]"
1304202a 126for {set i 0} {$i < [llength $argv]} {incr i} {
127 set a [lindex $argv $i]
128 switch -glob -- $a {
129 "-g" {
130 incr i
131 set a [lindex $argv $i]
132 set g [parse-galaxy-spec $a]
133 if {[string equal $g ""]} {
134 puts stderr "$argv0: bad galaxy string `$a'"
135 exit 1
136 }
137 destructure {. g} $g
138 }
139 "-d" {
140 incr i
161e6ada 141 set d [expr {int([lindex $argv $i] * 10)}]
1304202a 142 }
e1721994 143 "-W" {
1304202a 144 incr i
145 if {![regexp {^(\d+),(\d+)$} [lindex $argv $i] . wx wy]} {
146 puts stderr "$argv0: bad window size string"
147 exit 1
148 }
149 }
e1721994 150 "-w" {
151 incr i
152 set a [lindex $argv $i]
153 set weight "weight-$a"
154 if {[lsearch -exact [info commands "weight-*"] $weight] == -1} {
155 puts stderr "$argv0: unknown weight function `$a'"
156 puts stderr "$argv0: I know [info commands weight-*]"
157 exit 1
158 }
159 }
1304202a 160 "-a" {
161 incr i
162 set asp [lindex $argv $i]
163 }
164 "-v" {
165 incr v
166 }
167 "-q" {
168 incr v -1
169 }
170 "--" {
171 incr i
172 break
173 }
174 "-*" {
175 puts stderr $usage
176 exit 1
177 }
178 default {
179 break
180 }
181 }
182}
183
184set p [lrange $argv $i end]
161e6ada 185set ww [elite-galaxylist $g]
e1721994 186if {![llength $p]} {
187 set n {}
188 set rt {}
189 set w $ww
190 incr v -1
191} else {
161e6ada 192 if {![string equal $weight ""]} { elite-adjacency adj $ww $d }
e1721994 193 set n {}
194 foreach a $p {
195 set s [parse-planet-spec $g $a]
196 if {[string equal $s ""]} {
1304202a 197 puts stderr "$argv0: unknown planet `$a'"
198 exit 1
199 }
e1721994 200 lappend n $s
1304202a 201 }
e1721994 202 set rt {}
203 if {![string equal $weight ""]} {
204 set home [lindex $n 0]
205 foreach w [lrange $n 1 end] {
206 destructure {p .} [shortest-path adj $home $w $weight]
207 if {![llength $p]} {
161e6ada 208 puts stderr \
209 "$argv0: no route from [worldname $home] to [worldname $w]"
e1721994 210 exit 1
211 }
212 eval lappend rt $p
213 set home $w
214 }
215 }
216 set x0 1024
217 set y0 1024
218 set x1 0
219 set y1 0
220 set w {}
221 foreach p [concat $n $rt] {
222 elite-worldinfo ii $p
223 if {$ii(x) < $x0} { set x0 $ii(x) }
224 if {$ii(y) < $y0} { set y0 $ii(y) }
225 if {$ii(x) > $x1} { set x1 $ii(x) }
226 if {$ii(y) > $y1} { set y1 $ii(y) }
1304202a 227 }
e1721994 228 set x0 [expr {$x0 - $d - 5}]
229 set y0 [expr {$y0 - $d - 5}]
230 set x1 [expr {$x1 + $d + 5}]
231 set y1 [expr {$y1 + $d + 5}]
232 set w {}
233 foreach {p x y} $ww {
234 if {$x >= $x0 && $y >= $y0 && $x <= $x1 && $y <= $y1} {
235 lappend w $p $x $y
236 }
237 }
238}
239destructure {lmagic lpath lmain} [show-map $asp $wx $wy $w $n $rt]
1304202a 240if {$v > 0} {
241 puts ""
e1721994 242 show-key $lmagic $n
1304202a 243}
e1721994 244if {$v > 1} {
245 if {[string equal $weight ""]} {
246 show-key $lmain $n
247 } else {
248 show-key $lpath $n
249 if {$v > 2} {
250 show-key $lmain $n
251 }
252 }
253}
254
255
256