1304202a |
1 | #! /usr/bin/tclsh |
b130b8f5 |
2 | # |
e1721994 |
3 | # $Id: elite-map,v 1.3 2003/02/26 01:12:57 mdw Exp $ |
1304202a |
4 | |
5 | package require "elite" "1.0.0" |
6 | |
7 | set syms "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" |
8 | proc 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 |
18 | proc 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 |
102 | proc 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)" \ |
112 | [expr {[world-distance $p(x) $p(y) $pp(x) $pp(y)]/10.0}]] |
113 | } |
114 | puts $out |
115 | } |
116 | } |
117 | |
1304202a |
118 | set g $galaxy1 |
119 | set wx 72 |
120 | set wy 10 |
121 | set asp 2.17 |
122 | set d 70 |
e1721994 |
123 | set v 2 |
124 | set weight {} |
125 | set usage "usage: $argv0 \[-qv\] \[-g GAL\] \[-d DIST\] \[-w WEIGHT\]\n\t\[-W WD,HT\] \[-a ASP\] \[PLANET ...\]" |
1304202a |
126 | for {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 |
141 | set d [expr {[lindex $argv $i] * 10}] |
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 | |
184 | set p [lrange $argv $i end] |
e1721994 |
185 | set ww [worldinfo $g] |
186 | if {![llength $p]} { |
187 | set n {} |
188 | set rt {} |
189 | set w $ww |
190 | incr v -1 |
191 | } else { |
192 | if {![string equal $weight ""]} { |
193 | puts -nonewline stderr "\[computing adjacency table..." |
194 | adjacency $ww adj |
195 | puts stderr " done\]" |
196 | } |
197 | set n {} |
198 | foreach a $p { |
199 | set s [parse-planet-spec $g $a] |
200 | if {[string equal $s ""]} { |
1304202a |
201 | puts stderr "$argv0: unknown planet `$a'" |
202 | exit 1 |
203 | } |
e1721994 |
204 | lappend n $s |
1304202a |
205 | } |
e1721994 |
206 | set rt {} |
207 | if {![string equal $weight ""]} { |
208 | set home [lindex $n 0] |
209 | foreach w [lrange $n 1 end] { |
210 | destructure {p .} [shortest-path adj $home $w $weight] |
211 | if {![llength $p]} { |
212 | puts -stderr \ |
213 | "$argv0: no route from [worldinfo $home] to [worldinfo $w]" |
214 | exit 1 |
215 | } |
216 | eval lappend rt $p |
217 | set home $w |
218 | } |
219 | } |
220 | set x0 1024 |
221 | set y0 1024 |
222 | set x1 0 |
223 | set y1 0 |
224 | set w {} |
225 | foreach p [concat $n $rt] { |
226 | elite-worldinfo ii $p |
227 | if {$ii(x) < $x0} { set x0 $ii(x) } |
228 | if {$ii(y) < $y0} { set y0 $ii(y) } |
229 | if {$ii(x) > $x1} { set x1 $ii(x) } |
230 | if {$ii(y) > $y1} { set y1 $ii(y) } |
1304202a |
231 | } |
e1721994 |
232 | set x0 [expr {$x0 - $d - 5}] |
233 | set y0 [expr {$y0 - $d - 5}] |
234 | set x1 [expr {$x1 + $d + 5}] |
235 | set y1 [expr {$y1 + $d + 5}] |
236 | set w {} |
237 | foreach {p x y} $ww { |
238 | if {$x >= $x0 && $y >= $y0 && $x <= $x1 && $y <= $y1} { |
239 | lappend w $p $x $y |
240 | } |
241 | } |
242 | } |
243 | destructure {lmagic lpath lmain} [show-map $asp $wx $wy $w $n $rt] |
1304202a |
244 | if {$v > 0} { |
245 | puts "" |
e1721994 |
246 | show-key $lmagic $n |
1304202a |
247 | } |
e1721994 |
248 | if {$v > 1} { |
249 | if {[string equal $weight ""]} { |
250 | show-key $lmain $n |
251 | } else { |
252 | show-key $lpath $n |
253 | if {$v > 2} { |
254 | show-key $lmain $n |
255 | } |
256 | } |
257 | } |
258 | |
259 | |
260 | |