1304202a |
1 | #! /usr/bin/wish |
2 | |
3 | package require "elite" "1.0.0" |
4 | |
5 | # --- Utility procedures ---------------------------------------------------- |
6 | |
7 | proc moan {msg} { |
8 | global argv0 |
9 | tk_messageBox -message $msg -default ok -title $argv0 -type ok -icon error |
10 | } |
11 | |
12 | proc debug-array {name} { |
13 | upvar \#0 $name a |
14 | set tl .debug-$name |
15 | if {[winfo exists .$tl]} { return } |
16 | set s [array startsearch a] |
17 | toplevel $tl |
18 | set r 0 |
19 | set n 0 |
20 | while {[array anymore a $s]} { |
21 | set k [array nextelement a $s] |
22 | label $tl.k-$n -text $k -justify right |
23 | entry $tl.v-$n -textvariable ${name}($k) -state disabled |
24 | grid configure $tl.k-$n -row $r -column 0 -sticky e |
25 | grid configure $tl.v-$n -row $r -column 1 -sticky we |
26 | incr r |
27 | incr n |
28 | } |
29 | array donesearch a $s |
30 | } |
31 | |
32 | proc write-file {name contents {trans binary}} { |
33 | if {[file exists $name]} { |
34 | if {[set rc [catch { file copy -force $name "$name.old" } err]]} { |
35 | return -code $rc $err |
36 | } |
37 | } |
38 | if {[set rc [catch { |
39 | set f [open $name w] |
40 | fconfigure $f -translation $trans |
41 | puts -nonewline $f $contents |
42 | close $f |
43 | } err]]} { |
44 | catch { close $f } |
45 | catch { file rename -force "$name.old" $name } |
46 | return -code $rc $err |
47 | } |
48 | return "" |
49 | } |
50 | |
51 | proc read-file {name {trans binary}} { |
52 | set f [open $name] |
53 | fconfigure $f -translation $trans |
54 | set c [read $f] |
55 | close $f |
56 | return $c |
57 | } |
58 | |
59 | proc get-line-done {tl cmd} { |
60 | if {![uplevel \#0 [concat $cmd [$tl.entry get]]]} { |
61 | destroy $tl |
62 | } |
63 | } |
64 | |
65 | proc get-line {tl title prompt def cmd} { |
66 | if {[winfo exists $tl]} { |
67 | # raise $tl |
68 | return |
69 | } |
70 | toplevel $tl |
71 | wm title $tl $title |
72 | label $tl.label -text "$prompt: " |
73 | entry $tl.entry; $tl.entry insert 0 $def |
74 | button $tl.ok -text OK -default active \ |
75 | -command [list get-line-done $tl $cmd] |
76 | bind $tl <Return> [list get-line-done $tl $cmd] |
77 | bind $tl <Escape> [list destroy $tl] |
78 | pack $tl.label $tl.entry $tl.ok -side left -padx 2 -pady 2 |
79 | } |
80 | |
81 | proc entry-on-change {widget what} { |
82 | bind $widget <Return> $what |
83 | bind $widget <FocusOut> $what |
84 | } |
85 | |
86 | #----- Map editing machinery ------------------------------------------------ |
87 | |
88 | tab col red orange yellow green blue magenta violet white |
89 | |
90 | set seq 0 |
91 | set nwin 0 |
92 | array set default {scale 15 colourby off connect 0} |
93 | |
94 | proc set-scale {seq sc} { |
95 | if {![regexp {^[0-9]+$} $sc]} { |
96 | moan "bad scale factor `$sc'" |
97 | return 1 |
98 | } |
99 | map-setscale $seq $sc |
100 | return 0 |
101 | } |
102 | |
103 | proc new-view {gs} { |
104 | set g [parse-galaxy-spec $gs] |
105 | if {![llength $g]} { |
106 | moan "bad galaxy spec `$gs'" |
107 | return 1 |
108 | } |
109 | destructure {ng g} $g |
110 | map-new $ng $g |
111 | return 0 |
112 | } |
113 | |
114 | # --- Colour-coding planets --- |
115 | |
116 | proc colour-by {seq} { |
117 | upvar \#0 map-$seq map |
118 | set tl .map-$seq |
119 | global col |
120 | switch -exact -- $map(colourby) { |
121 | off { |
122 | foreach-world $map(galaxy) p { |
123 | $tl.map itemconfigure $p(seed) -fill white -outline white |
124 | } |
125 | } |
126 | economy { |
127 | foreach-world $map(galaxy) p { |
128 | set c [expr {7 - $p(economy)}] |
129 | $tl.map itemconfigure $p(seed) -fill $col($c) -outline $col($c) |
130 | } |
131 | } |
132 | government { |
133 | foreach-world $map(galaxy) p { |
134 | set c $p(government) |
135 | $tl.map itemconfigure $p(seed) -fill $col($c) -outline $col($c) |
136 | } |
137 | } |
138 | techlevel { |
139 | foreach-world $map(galaxy) p { |
140 | set c [expr {$p(techlevel) / 2}] |
141 | $tl.map itemconfigure $p(seed) -fill $col($c) -outline $col($c) |
142 | } |
143 | } |
144 | } |
145 | } |
146 | |
147 | proc set-colour-by {seq} { |
148 | global default |
149 | upvar \#0 map-$seq map |
150 | set default(colourby) $map(colourby) |
151 | colour-by $seq |
152 | } |
153 | |
154 | # --- Connectivity maps --- |
155 | |
156 | proc show-connectivity {seq} { |
157 | upvar \#0 map-$seq map |
158 | upvar \#0 adj-$map(galaxy) adj |
159 | upvar \#0 ww-$map(galaxy) ww |
160 | set tl .map-$seq |
161 | $tl.map delete conn |
162 | if {!$map(connect)} { |
163 | return |
164 | } |
165 | if {![info exists adj]} { adjacency $ww adj } |
166 | foreach {s x y} $ww { |
167 | set done($s) 1 |
168 | foreach {ss xx yy} $adj($s) { |
169 | if {[info exists done($ss)]} { continue } |
170 | $tl.map create line \ |
171 | [to-map $seq $x] [to-map $seq $y] \ |
172 | [to-map $seq $xx] [to-map $seq $yy] \ |
173 | -fill darkblue -tags conn |
174 | } |
175 | } |
176 | $tl.map lower conn sep |
177 | } |
178 | |
179 | proc set-connectivity {seq} { |
180 | global default |
181 | upvar \#0 map-$seq map |
182 | set default(connect) $map(connect) |
183 | show-connectivity $seq |
184 | } |
185 | |
186 | # --- Planet names --- |
187 | |
188 | proc show-names {seq} { |
189 | upvar \#0 map-$seq map |
190 | set tl .map-$seq |
191 | $tl.map delete names |
192 | if {!$map(names)} { |
193 | return |
194 | } |
195 | foreach-world $map(galaxy) p { |
196 | set anc nw |
197 | set px [to-map $seq $p(x)] |
198 | set py [to-map $seq $p(y)] |
199 | set offx [expr {$px + [to-map $seq 2]}] |
200 | set offy [expr {$py + [to-map $seq 2]}] |
201 | set what {} |
202 | foreach {a ox oy dx x y xx yy} { |
203 | nw 2 2 0 0 0 30 10 |
204 | nw 2 2 -10 0 0 30 10 |
205 | sw 2 -2 0 0 -10 30 0 |
206 | sw 2 -2 -10 0 -10 30 0 |
207 | se -2 -2 0 -30 -10 0 0 |
208 | se -2 -2 10 -30 -10 0 0 |
209 | ne -2 2 0 -30 0 0 10 |
210 | ne -2 2 10 -30 0 0 10 |
211 | } { |
212 | set ox [expr {$px + [to-map $seq $ox] + $dx}] |
213 | set oy [expr {$py + [to-map $seq $oy]}] |
214 | if {![llength [$tl.map find overlapping \ |
215 | [expr {$ox + $x}] [expr {$ox + $y}] \ |
216 | [expr {$ox + $xx}] [expr {$ox + $yy}]]]} { |
217 | set offx $ox |
218 | set offy $oy |
219 | set anc $a |
220 | break |
221 | } |
222 | lappend what $a |
223 | } |
224 | $tl.map create text $offx $offy -text $p(name) \ |
225 | -fill white -anchor $a -tags names |
226 | } |
227 | } |
228 | |
229 | proc set-names {seq} { |
230 | global default |
231 | upvar \#0 map-$seq map |
232 | set default(names) $map(names) |
233 | show-names $seq |
234 | } |
235 | |
236 | # --- Shortest path handling --- |
237 | |
238 | proc show-path {seq} { |
239 | upvar \#0 map-$seq map |
240 | set tl .map-$seq |
241 | $tl.map delete path |
242 | if {![info exists map(path)]} { return } |
243 | foreach n $map(path) { |
244 | elite-worldinfo p $n |
245 | if {[info exists x]} { |
246 | $tl.map create line \ |
247 | [to-map $seq $x] [to-map $seq $y] \ |
248 | [to-map $seq $p(x)] [to-map $seq $p(y)] \ |
249 | -fill darkorange -tags path |
250 | } |
251 | set x $p(x) |
252 | set y $p(y) |
253 | } |
254 | $tl.map lower path sep |
255 | } |
256 | |
257 | proc show-shortest-path {seq weight} { |
258 | upvar \#0 map-$seq map |
259 | upvar \#0 adj-$map(galaxy) adj |
260 | upvar \#0 ww-$map(galaxy) ww |
261 | set tl .map-$seq |
262 | $tl.map delete path |
263 | if {[info exists map(path)]} { unset map(path) } |
264 | if {![info exists map(select)] || ![info exists map(dest)]} { |
265 | moan "no source or destination set" |
266 | return |
267 | } |
268 | if {![info exists adj]} { adjacency $ww adj } |
269 | destructure {path weight} \ |
270 | [shortest-path adj $map(select) $map(dest) $weight] |
271 | if {![llength $path]} { |
272 | moan "no path exists" |
273 | return |
274 | } |
275 | set map(path) $path |
276 | show-path $seq |
277 | } |
278 | |
279 | # --- Planet information box --- |
280 | |
281 | proc do-getinfo {tag seq x y} { |
282 | global economy government |
283 | upvar \#0 info-$tag info |
284 | set tl .world-info-$tag |
285 | elite-worldinfo info [find-click $seq $x $y] |
286 | if {[winfo exists $tl]} { |
287 | # raise $tl |
288 | } else { |
289 | toplevel $tl |
290 | set r 0 |
291 | foreach {item label} { |
292 | name "Name" |
293 | seed "Seed" |
294 | position "Position" |
295 | eco-name "Economy" |
296 | gov-name "Government" |
297 | techlevel "Tech. level" |
298 | pop-str "Population" |
299 | prod-str "Productivity" |
300 | radius-km "Radius" |
301 | } { |
302 | label $tl.l-$item -text "$label: " -justify right |
303 | entry $tl.$item -textvariable info-${tag}($item) -state disabled |
304 | grid configure $tl.l-$item -row $r -column 0 -sticky e |
305 | grid configure $tl.$item -row $r -column 1 -columnspan 2 -sticky we |
306 | incr r |
307 | } |
308 | scrollbar $tl.descscr -orient vertical -command [list $tl.desc yview] |
309 | text $tl.desc -wrap word -yscrollcommand [list $tl.descscr set] \ |
310 | -width 40 -height 4 |
311 | grid configure $tl.desc -row $r -column 0 -columnspan 2 -sticky nsew |
312 | grid configure $tl.descscr -row $r -column 2 -sticky ns |
313 | grid columnconfigure $tl 1 -weight 1 |
314 | grid rowconfigure $tl $r -weight 1 |
315 | } |
316 | wm title $tl "Info: $info(name)" |
317 | set info(position) "$info(x), $info(y)" |
318 | set info(eco-name) $economy($info(economy)) |
319 | set info(gov-name) $government($info(government)) |
320 | set info(pop-str) \ |
321 | [format "%s billion (%s)" \ |
322 | [expr {$info(population)/10}] \ |
323 | $info(inhabitants)] |
324 | set info(prod-str) [format "%d M Cr" $info(productivity)] |
325 | set info(radius-km) [format "%d km" $info(radius)] |
326 | $tl.desc configure -state normal |
327 | $tl.desc delete 1.0 end |
328 | $tl.desc insert end $info(description) |
329 | $tl.desc configure -state disabled |
330 | } |
331 | |
332 | # --- Messing with selections --- |
333 | |
334 | proc to-ly {seq x} { |
335 | upvar \#0 map-$seq map |
336 | return [expr {$x * $map(scale) / 10.0}] |
337 | } |
338 | |
339 | proc to-map {seq x} { |
340 | upvar \#0 map-$seq map |
341 | return [expr {$x * 10 / $map(scale)}] |
342 | } |
343 | |
344 | proc find-click {seq x y} { |
345 | upvar \#0 map-$seq map |
346 | upvar \#0 ww-$map(galaxy) ww |
347 | set tl .map-$seq |
348 | |
349 | set x [to-ly $seq [$tl.map canvasx $x]] |
350 | set y [to-ly $seq [$tl.map canvasy $y]] |
351 | set best 100000 |
352 | foreach {seed px py} $ww { |
353 | set dx [expr {$x - $px}] |
354 | set dy [expr {$y - $py}] |
355 | set d [expr {$dx * $dx + $dy * $dy}] |
356 | if {$d < $best} { |
357 | set best $d |
358 | set p $seed |
359 | } |
360 | } |
361 | $tl.map delete here |
362 | |
363 | if 0 { |
364 | $tl.map create line \ |
365 | [expr {[to-map $seq $x] - 5}] [expr {[to-map $seq $y] - 5}] \ |
366 | [expr {[to-map $seq $x] + 5}] [expr {[to-map $seq $y] + 5}] \ |
367 | -tags here -fill green |
368 | $tl.map create line \ |
369 | [expr {[to-map $seq $x] - 5}] [expr {[to-map $seq $y] + 5}] \ |
370 | [expr {[to-map $seq $x] + 5}] [expr {[to-map $seq $y] - 5}] \ |
371 | -tags here -fill green |
372 | } |
373 | return $p |
374 | } |
375 | |
376 | proc destination-world {seq} { |
377 | upvar \#0 map-$seq map |
378 | set tl .map-$seq |
379 | if {![info exists map(dest)]} { return } |
380 | $tl.map delete dest |
381 | elite-worldinfo p $map(dest) |
382 | set px [to-map $seq $p(x)] |
383 | set py [to-map $seq $p(y)] |
384 | $tl.map create line [expr {$px - 10}] $py [expr {$px + 10}] $py \ |
385 | -tags {dest cross} -fill darkorange |
386 | $tl.map create line $px [expr {$py - 10}] $px [expr {$py + 10}] \ |
387 | -tags {dest cross} -fill darkorange |
388 | $tl.map raise dest sel |
389 | } |
390 | |
391 | proc select-world {seq} { |
392 | upvar \#0 map-$seq map |
393 | set tl .map-$seq |
394 | if {![info exists map(select)]} { return } |
395 | $tl.map delete sel dest |
396 | elite-worldinfo p $map(select) |
397 | set r [to-map $seq $map(fuel)] |
398 | set px [to-map $seq $p(x)] |
399 | set py [to-map $seq $p(y)] |
400 | $tl.map create line [expr {$px - 20}] $py [expr {$px + 20}] $py \ |
401 | -tags {sel cross} -fill darkred |
402 | $tl.map create line $px [expr {$py - 20}] $px [expr {$py + 20}] \ |
403 | -tags {sel cross} -fill darkred |
404 | $tl.map create oval \ |
405 | [expr {$px - $r}] [expr {$py - $r}] \ |
406 | [expr {$px + $r}] [expr {$py + $r}] \ |
407 | -tags {sel radius} -outline darkgreen |
408 | $tl.map raise sel sep |
409 | } |
410 | |
411 | proc select-byname {seq name seed proc} { |
412 | upvar \#0 map-$seq map |
413 | set p [parse-planet-spec $map(galaxy) $map($name)] |
414 | if {![string equal $p ""] && [in-galaxy-p $map(galaxy) $p]} { |
415 | $proc $seq $p |
416 | } elseif {[info exists map($seed)]} { |
417 | bell |
418 | set map($name) [worldname $map($seed)] |
419 | } else { |
420 | bell |
421 | set map($name) "" |
422 | } |
423 | } |
424 | |
425 | proc set-selection {seq p} { |
426 | upvar \#0 map-$seq map |
427 | set map(select) $p |
428 | elite-worldinfo pp $p |
429 | select-world $seq |
430 | set map(sel-name) $pp(name) |
431 | if {![info exists map(dest)]} { |
432 | set-destination $seq $p |
433 | } else { |
434 | set-destination $seq $map(dest) |
435 | } |
436 | if {[info exists map(cmdr)]} { |
437 | cmdr-set-world $map(cmdr) $p |
438 | } |
439 | } |
440 | |
441 | proc do-select {seq x y} { |
442 | set-selection $seq [find-click $seq $x $y] |
443 | } |
444 | |
445 | proc set-destination {seq p} { |
446 | upvar \#0 map-$seq map |
447 | if {![info exists map(select)]} { |
448 | set-selection $seq $p |
449 | } else { |
450 | elite-worldinfo ps $map(select) |
451 | elite-worldinfo pd $p |
452 | set map(dest) $p |
453 | destination-world $seq |
454 | set map(dest-name) $pd(name) |
455 | set map(distance) \ |
456 | [format "%.1f" \ |
457 | [expr {[world-distance $ps(x) $ps(y) $pd(x) $pd(y)] / 10.0}]] |
458 | } |
459 | } |
460 | |
461 | proc do-destination {seq x y} { |
462 | set-destination $seq [find-click $seq $x $y] |
463 | } |
464 | |
465 | # --- Redrawing a map --- |
466 | |
467 | proc map-populate {seq} { |
468 | global colourby-$seq connect-$seq |
469 | upvar \#0 map-$seq map |
470 | upvar \#0 ww-$map(galaxy) ww |
471 | set tl .map-$seq |
472 | |
473 | set scale $map(scale) |
474 | $tl.map delete all |
475 | $tl.map create line -10000 -20000 -10000 -20000 -fill black -tags sep |
476 | if {![info exists ww]} { set ww [worldinfo $map(galaxy)] } |
477 | foreach {seed x y} $ww { |
478 | elite-worldinfo p $seed |
479 | set x [expr {$x * 10 / $map(scale)}] |
480 | set y [expr {$y * 10 / $map(scale)}] |
481 | set r [expr {$p(radius) / (500 * $map(scale))}] |
482 | $tl.map create oval \ |
483 | [expr {$x - $r}] [expr {$y - $r}] \ |
484 | [expr {$x + $r}] [expr {$y + $r}] \ |
485 | -fill white -outline white \ |
486 | -tags [list $seed world] |
487 | } |
488 | |
489 | colour-by $seq |
490 | show-connectivity $seq |
491 | show-path $seq |
492 | show-names $seq |
493 | select-world $seq |
494 | destination-world $seq |
495 | } |
496 | |
497 | # --- Miscellaneous stuff --- |
498 | |
499 | proc map-setscale {seq sc} { |
500 | global default |
501 | upvar \#0 map-$seq map |
502 | set tl .map-$seq |
503 | set wd [expr {10240/$sc + 40}] |
504 | set ht [expr {5120/$sc} + 10] |
505 | $tl.map configure -scrollregion [list -40 -10 $wd $ht] |
506 | set map(scale) $sc |
507 | set default(scale) $sc |
508 | map-populate $seq |
509 | } |
510 | |
511 | proc map-destroy {seq} { |
512 | global nwin |
513 | upvar \#0 map-$seq map |
514 | if {[info exists map(cmdr)]} { |
515 | upvar \#0 cmdr-$map(cmdr) cmdr |
516 | unset cmdr(map) |
517 | } |
518 | unset map |
519 | destroy .map-$seq .set-scale-$seq |
520 | incr nwin -1 |
521 | if {!$nwin} { exit } |
522 | } |
523 | |
524 | proc map-attach-cmdr {seq cmdr} { |
525 | upvar \#0 map-$seq map |
526 | set map(cmdr) $cmdr |
527 | map-set-title $seq |
528 | } |
529 | |
530 | proc map-set-title {seq} { |
531 | upvar \#0 map-$seq map |
532 | set tl .map-$seq |
533 | set t "Galaxy $map(galaxy-num)" |
534 | if {[info exists map(cmdr)]} { |
535 | append t " (commander [cmdr-name $map(cmdr)])" |
536 | } |
537 | wm title $tl $t |
538 | } |
539 | |
540 | proc map-set-galaxy {seq ng g} { |
541 | upvar \#0 map-$seq map |
542 | if {[string equal $g $map(galaxy)]} { return } |
543 | set map(galaxy-num) $ng |
544 | map-set-title $seq |
545 | set map(galaxy) $g |
546 | map-populate $seq |
547 | foreach i {select select-name dest dest-name} { |
548 | catch { unset map($i) } |
549 | } |
550 | } |
551 | |
552 | proc map-set-fuel {seq qty} { |
553 | upvar \#0 map-$seq map |
554 | set map(fuel) $qty |
555 | select-world $seq |
556 | } |
557 | |
558 | # --- Making a new map window --- |
559 | |
560 | proc map-new {ng g} { |
561 | global seq nwin default |
562 | incr seq |
563 | incr nwin |
564 | upvar \#0 map-$seq map |
565 | |
566 | array set map [array get default] |
567 | set sc $map(scale) |
568 | set map(galaxy) $g |
569 | set map(galaxy-num) $ng |
570 | set tl [toplevel .map-$seq] |
571 | set wd [expr {10240/$sc + 80}] |
572 | set ht [expr {5120/$sc + 20}] |
573 | set vwd $wd; if {$vwd > 1120} { set vwd 768 } |
574 | set vht $ht; if {$vht > 1024} { set vht 768 } |
575 | set map(fuel) 70 |
576 | canvas $tl.map \ |
577 | -background black \ |
578 | -xscrollcommand [list $tl.hscr set] \ |
579 | -yscrollcommand [list $tl.vscr set] \ |
580 | -width $vwd -height $vht |
581 | frame $tl.info |
582 | label $tl.info.lhome -text "Home: " |
583 | entry $tl.info.home -textvariable map-${seq}(sel-name) |
584 | label $tl.info.ldest -text "Destination: " |
585 | entry $tl.info.dest -textvariable map-${seq}(dest-name) |
586 | label $tl.info.ldist -text "Distance: " |
587 | entry $tl.info.dist -textvariable map-${seq}(distance) \ |
588 | -state disabled -width 6 |
589 | pack \ |
590 | $tl.info.lhome $tl.info.home \ |
591 | $tl.info.ldest $tl.info.dest \ |
592 | $tl.info.ldist $tl.info.dist \ |
593 | -side left |
594 | |
595 | scrollbar $tl.hscr -orient horizontal \ |
596 | -command [list $tl.map xview] |
597 | scrollbar $tl.vscr -orient vertical \ |
598 | -command [list $tl.map yview] |
599 | menu $tl.menu |
600 | menu $tl.menu.file |
601 | $tl.menu.file add command -label "New commander" -command cmdr-new |
602 | $tl.menu.file add command -label "Load commander..." \ |
603 | -command { cmdr-loadfile } |
604 | $tl.menu.file add separator |
605 | $tl.menu.file add command -label "Close" -command [list map-destroy $seq] |
606 | $tl.menu.file add command -label "Quit" -command { exit } |
607 | $tl.menu add cascade -label "File" -menu $tl.menu.file |
608 | menu $tl.menu.view |
609 | $tl.menu.view add command -label "New map..." \ |
610 | -command [list get-line .new-view "New view" "Galaxy" $ng new-view] |
611 | $tl.menu.view add command -label "Set scale..." \ |
612 | -command [concat get-line .set-scale-$seq {"Set scale"} "Scale" \ |
613 | \[set map-${seq}(scale)\] [list [list set-scale $seq]]] |
614 | $tl.menu.view add separator |
615 | $tl.menu.view add radiobutton -label "Off" \ |
616 | -variable map-${seq}(colourby) -value off \ |
617 | -command [list set-colour-by $seq] |
618 | $tl.menu.view add radiobutton -label "Economy" \ |
619 | -variable map-${seq}(colourby) -value economy \ |
620 | -command [list set-colour-by $seq] |
621 | $tl.menu.view add radiobutton -label "Government" \ |
622 | -variable map-${seq}(colourby) -value government \ |
623 | -command [list set-colour-by $seq] |
624 | $tl.menu.view add radiobutton -label "Tech level" \ |
625 | -variable map-${seq}(colourby) -value techlevel \ |
626 | -command [list set-colour-by $seq] |
627 | $tl.menu.view add separator |
628 | $tl.menu.view add checkbutton -label "Connectivity" \ |
629 | -variable map-${seq}(connect) \ |
630 | -command [list set-connectivity $seq] |
631 | $tl.menu.view add checkbutton -label "Planet names" \ |
632 | -variable map-${seq}(names) \ |
633 | -command [list set-names $seq] |
634 | $tl.menu add cascade -label "View" -menu $tl.menu.view |
635 | menu $tl.menu.path |
636 | $tl.menu.path add command -label "Minimize hops" \ |
637 | -command [list show-shortest-path $seq weight-hops] |
638 | $tl.menu.path add command -label "Minimize fuel" \ |
639 | -command [list show-shortest-path $seq weight-fuel] |
640 | $tl.menu.path add command -label "Maximize safety" \ |
641 | -command [list show-shortest-path $seq weight-safety] |
642 | $tl.menu.path add command -label "Minimize safety" \ |
643 | -command [list show-shortest-path $seq weight-encounters] |
644 | $tl.menu.path add command -label "Maximize trading" \ |
645 | -command [list show-shortest-path $seq weight-trading] |
646 | $tl.menu add cascade -label "Compute path" -menu $tl.menu.path |
647 | $tl configure -menu $tl.menu |
648 | |
649 | wm protocol $tl WM_DELETE_WINDOW [list map-destroy $seq] |
650 | |
651 | grid $tl.map -column 0 -row 0 -sticky nsew |
652 | grid $tl.hscr -column 0 -row 1 -sticky ew |
653 | grid $tl.vscr -column 1 -row 0 -sticky ns |
654 | grid rowconfigure $tl 0 -weight 1 |
655 | grid columnconfigure $tl 0 -weight 1 |
656 | grid $tl.info -column 0 -columnspan 2 -row 2 -sticky ew |
657 | |
658 | bind $tl.map <3> [list do-select $seq %x %y] |
659 | bind $tl.map <1> [list do-destination $seq %x %y] |
660 | bind $tl.map <Double-1> [list do-getinfo dest $seq %x %y] |
661 | bind $tl.map <Double-3> [list do-getinfo home $seq %x %y] |
662 | |
663 | map-set-title $seq |
664 | entry-on-change $tl.info.home \ |
665 | [list select-byname $seq sel-name select set-selection] |
666 | entry-on-change $tl.info.dest \ |
667 | [list select-byname $seq dest-name dest set-destination] |
668 | map-setscale $seq $sc |
669 | return $seq |
670 | } |
671 | |
672 | #----- Commander editing machinery ------------------------------------------ |
673 | |
674 | # --- Validation and factor-of-10 fixing --- |
675 | |
676 | proc fix-tenth {tag arrvar full op} { |
677 | upvar \#0 $arrvar arr |
678 | catch { set arr($tag) [format "%d" [expr {int($arr($full) * 10)}]] } |
679 | } |
680 | |
681 | proc numericp {min max n} { |
682 | if {[catch { expr {$n + 0} }]} { return 0 } |
683 | if {$n < $min || $n > $max} { return 0 } |
684 | return 1 |
685 | } |
686 | |
687 | proc integerp {min max n} { |
688 | if {[catch { incr n 0}]} { return 0 } |
689 | if {$n < $min || $n > $max} { return 0 } |
690 | return 1 |
691 | } |
692 | |
693 | proc galaxyp {s} { |
694 | if {![regexp {^[0-9a-fA-F]{12}$} $s]} { return 0 } |
695 | return 1 |
696 | } |
697 | |
698 | proc cmdr-do-validate {seq widget check value} { |
699 | upvar \#0 cmdr-$seq cmdr |
700 | if {$cmdr(ok/$widget)} { incr cmdr(bogus) } |
701 | if {![eval $check [list $value]]} { |
702 | set cmdr(ok/$widget) 0 |
703 | $widget configure -foreground red |
704 | } else { |
705 | set cmdr(ok/$widget) 1 |
706 | $widget configure -foreground black |
707 | incr cmdr(bogus) -1 |
708 | } |
709 | return 1 |
710 | } |
711 | |
712 | proc cmdr-validate-widget {seq widget check} { |
713 | upvar \#0 cmdr-$seq cmdr |
714 | set cmdr(ok/$widget) 1 |
715 | $widget configure -validate key \ |
716 | -vcmd [list cmdr-do-validate $seq $widget $check %P] |
717 | } |
718 | |
719 | # --- Cargo window handling --- |
720 | |
721 | proc cmdr-set-fluc {seq} { |
722 | upvar \#0 cmdr-$seq cmdr |
723 | global products |
724 | set tl .cmdr-$seq.cargo-qty |
725 | if {!$cmdr(ok/$tl.fluc)} { bell; return } |
726 | elite-market m $cmdr(world-seed) $cmdr(market-fluc) |
727 | foreach {i .} $products { |
728 | set cmdr(price-$i) [format "%.1f" [expr {[lindex $m($i) 0]/10.0}]] |
729 | } |
730 | } |
731 | |
732 | proc cmdr-cargo {seq} { |
733 | upvar \#0 cmdr-$seq cmdr |
734 | set tl .cmdr-$seq.cargo-qty |
735 | if {[winfo exists $tl]} { |
736 | # raise $tl |
737 | return |
738 | } |
739 | toplevel $tl |
740 | wm title $tl "Cargo for commander $cmdr(name)" |
741 | global products |
742 | set r 0 |
743 | label $tl.l-fluc -text "Fluctuation: " -justify right |
744 | entry $tl.fluc -textvariable cmdr-${seq}(market-fluc) -justify right |
745 | cmdr-validate-widget $seq $tl.fluc [list integerp 0 255] |
746 | entry-on-change $tl.fluc [list cmdr-set-fluc $seq] |
747 | grid configure $tl.l-fluc -row $r -column 0 -sticky e |
748 | grid configure $tl.fluc -row $r -column 1 -columnspan 3 -sticky we |
749 | incr r |
750 | label $tl.l-item -text "Item" -justify center |
751 | label $tl.l-price -text "Price" -justify center |
752 | label $tl.l-station -text "Station" -justify center |
753 | label $tl.l-hold -text "Hold" -justify center |
754 | grid configure $tl.l-item -row $r -column 0 -sticky e |
755 | grid configure $tl.l-price -row $r -column 1 -sticky we |
756 | grid configure $tl.l-station -row $r -column 2 -sticky we |
757 | grid configure $tl.l-hold -row $r -column 3 -sticky we |
758 | incr r |
759 | foreach {tag label} $products { |
760 | label $tl.l-$tag -text "$label: " -justify right |
761 | entry $tl.price-$tag -textvariable cmdr-${seq}(price-${tag}) \ |
762 | -justify right -state disabled -width 4 |
763 | foreach {pre col} {station 2 hold 3} { |
764 | entry $tl.${pre}-${tag} -textvariable cmdr-${seq}(${pre}-${tag}) \ |
765 | -justify right -width 4 |
766 | cmdr-validate-widget $seq $tl.${pre}-${tag} [list integerp 0 255] |
767 | grid configure $tl.${pre}-${tag} -row $r -column $col -stick we |
768 | } |
769 | grid configure $tl.l-$tag -row $r -column 0 -sticky e |
770 | grid configure $tl.price-$tag -row $r -column 1 -sticky we |
771 | incr r |
772 | } |
773 | grid columnconfigure $tl 1 -weight 1 |
774 | grid columnconfigure $tl 2 -weight 1 |
775 | grid columnconfigure $tl 3 -weight 1 |
776 | } |
777 | |
778 | # --- Miscellaneous stuff --- |
779 | |
780 | proc cmdr-destroy {seq} { |
781 | upvar \#0 cmdr-$seq cmdr |
782 | global nwin |
783 | set tl .cmdr-$seq |
784 | if {[info exists cmdr(map)]} { map-destroy $cmdr(map) } |
785 | unset cmdr |
786 | destroy $tl |
787 | incr nwin -1 |
788 | if {!$nwin} { exit } |
789 | } |
790 | |
791 | proc cmdrdb-set {seq tag value} { |
792 | upvar \#0 cmdr-$seq cmdr |
793 | set tl .cmdr-$seq |
794 | set cmdr($tag) $value |
795 | $tl.$tag configure -state disabled |
796 | } |
797 | |
798 | proc cmdrdb-custom {seq tag} { |
799 | set tl .cmdr-$seq |
800 | $tl.$tag configure -state normal |
801 | } |
802 | |
803 | proc cmdr-set-world {seq p} { |
804 | upvar \#0 cmdr-$seq cmdr |
805 | elite-worldinfo i $p |
806 | set cmdr(world-seed) $p |
807 | set cmdr(world-name) $i(name) |
808 | set cmdr(world-x) [expr {$i(x)/4}] |
809 | set cmdr(world-y) [expr {$i(y)/2}] |
810 | cmdr-set-fluc $seq |
811 | } |
812 | |
813 | proc cmdr-update-world {seq} { |
814 | upvar \#0 cmdr-$seq cmdr |
815 | upvar \#0 ww-$cmdr(gal-seed) ww |
816 | if {![info exists ww]} { set ww [worldinfo $cmdr(gal-seed)] } |
817 | set tl .cmdr-$seq |
818 | set w [nearest-planet $ww \ |
819 | [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]] |
820 | if {[info exists cmdr(map)]} { |
821 | if {$cmdr(std-gal)} { |
822 | set ng $cmdr(gal-number) |
823 | } else { |
824 | set ng $cmdr(gal-seed) |
825 | } |
826 | map-set-galaxy $cmdr(map) $ng $cmdr(gal-seed) |
827 | set-selection $cmdr(map) $w |
828 | } |
829 | cmdr-set-world $seq $w |
830 | } |
831 | |
832 | proc cmdr-set-gal-num {seq} { |
833 | upvar \#0 cmdr-$seq cmdr |
834 | set tl .cmdr-$seq |
835 | if {!$cmdr(ok/$tl.gal-number)} { bell; return } |
836 | if {$cmdr(std-gal)} { |
837 | set cmdr(gal-seed) [galaxy $cmdr(gal-number)] |
838 | cmdr-update-world $seq |
839 | } |
840 | } |
841 | |
842 | proc cmdr-std-gal {seq} { |
843 | upvar \#0 cmdr-$seq cmdr |
844 | set tl .cmdr-$seq |
845 | if {$cmdr(std-gal)} { |
846 | if {!$cmdr(ok/$tl.gal-number)} { bell; return } |
847 | set cmdr(gal-seed) [galaxy $cmdr(gal-number)] |
848 | cmdr-update-world $seq |
849 | $tl.gal-seed configure -state disabled |
850 | } else { |
851 | $tl.gal-seed configure -state normal |
852 | } |
853 | } |
854 | |
855 | proc cmdr-set-fuel {seq} { |
856 | upvar \#0 cmdr-$seq cmdr |
857 | if {[info exists cmdr(map)]} { |
858 | map-set-fuel $cmdr(map) $cmdr(fuel) |
859 | } |
860 | } |
861 | |
862 | proc cmdr-name {seq} { |
863 | upvar \#0 cmdr-$seq cmdr |
864 | return $cmdr(name) |
865 | } |
866 | |
867 | proc cmdr-show-map {seq} { |
868 | upvar \#0 cmdr-$seq cmdr |
869 | if {[info exists cmdr(map)]} { |
870 | return |
871 | } |
872 | if {$cmdr(std-gal)} { |
873 | set ng $cmdr(gal-number) |
874 | } else { |
875 | set ng $cmdr(gal-seed) |
876 | } |
877 | set cmdr(map) [map-new $ng $cmdr(gal-seed)] |
878 | map-attach-cmdr $cmdr(map) $seq |
879 | map-set-fuel $cmdr(map) $cmdr(fuel) |
880 | set-selection $cmdr(map) $cmdr(world-seed) |
881 | } |
882 | |
883 | proc cmdr-set-name {seq} { |
884 | upvar \#0 cmdr-$seq cmdr |
885 | if {[info exists cmdr(file)]} { |
886 | set cmdr(name) [string toupper [file rootname [file tail $cmdr(file)]]] |
887 | } else { |
888 | set cmdr(name) JAMESON |
889 | } |
890 | set tl .cmdr-$seq |
891 | wm title $tl "Commander $cmdr(name)" |
892 | if {[info exists cmdr(map)]} { map-set-title $cmdr(map) } |
893 | if {[winfo exists $tl.cargo-qty]} { |
894 | wm title $tl.cargo-qty "Cargo for commander $cmdr(name)" |
895 | } |
896 | } |
897 | |
898 | proc cmdr-check {seq} { |
899 | upvar \#0 cmdr-$seq cmdr |
900 | if {$cmdr(bogus)} { |
901 | moan("invalid values in commander data -- fix items highlighted in red") |
902 | return 0 |
903 | } |
904 | return 1 |
905 | } |
906 | |
907 | # --- Initial population --- |
908 | |
909 | proc cmdr-open {seq} { |
910 | upvar \#0 cmdr-$seq cmdr |
911 | global cmdr-$seq |
912 | set tl .cmdr-$seq |
913 | global nwin |
914 | toplevel $tl |
915 | set laser { |
916 | dropbox 255 |
917 | "None" 0 |
918 | "Pulse" 0x0f |
919 | "Beam" 0x8f |
920 | "Military" 0x97 |
921 | "Mining" 0x32 |
922 | } |
923 | set r 0 |
924 | set cmdr(bogus) 0 |
925 | foreach {tag label kind} [list \ |
926 | mission "Mission" { entry 2 255 } \ |
927 | score "Rating" { dropbox 65535\ |
928 | "Harmless" 0 \ |
929 | "Mostly harmless" 8 \ |
930 | "Poor" 6 \ |
931 | "Average" 32 \ |
932 | "Above average" 64 \ |
933 | "Competent" 128 \ |
934 | "Dangerous" 512 \ |
935 | "Deadly" 2560 \ |
936 | "Elite" 6400 } \ |
937 | legal-status "Legal status" { dropbox 255 \ |
938 | "Clean" 0 \ |
939 | "Offender" 1 \ |
940 | "Fugitive" 50 } \ |
941 | world "Location" where \ |
942 | credits "Credits" { tenth 10 429496729.5 } \ |
943 | fuel "Fuel" { tenth 4 25.5 } \ |
944 | missiles "Missiles" { entry 4 255 } \ |
945 | energy-unit "Energy unit" { dropbox 255 \ |
946 | "None" 0 \ |
947 | "Standard" 1 \ |
948 | "Naval" 2 } \ |
949 | front-laser "Front laser" $laser \ |
950 | rear-laser "Front laser" $laser \ |
951 | left-laser "Left laser" $laser \ |
952 | right-laser "Right laser" $laser \ |
953 | ecm "ECM" toggle \ |
954 | fuel-scoop "Fuel scoops" toggle \ |
955 | energy-bomb "Energy bomb" toggle \ |
956 | escape-pod "Escape pod" toggle \ |
957 | docking-computer "Docking computers" toggle \ |
958 | gal-hyperdrive "Galactic hyperdrive" toggle \ |
959 | cargo "Cargo capacity" { entry 4 255 } \ |
960 | stuff "Cargo" cargo \ |
961 | ] { |
962 | switch -exact -- [lindex $kind 0] { |
963 | entry { |
964 | destructure {. wd max} $kind |
965 | label $tl.l-$tag -text "$label: " -justify right |
966 | entry $tl.$tag -textvariable cmdr-${seq}($tag) \ |
967 | -width $wd -justify right |
968 | cmdr-validate-widget $seq $tl.$tag [list integerp 0 $max] |
969 | grid configure $tl.l-$tag -row $r -column 0 -sticky e |
970 | grid configure $tl.$tag -row $r -column 1 -columnspan 2 -sticky we |
971 | } |
972 | tenth { |
973 | destructure {. wd max} $kind |
974 | label $tl.l-$tag -text "$label: " -justify right |
975 | entry $tl.$tag -textvariable cmdr-${seq}(div-$tag) \ |
976 | -width $wd -justify right |
977 | set cmdr(div-$tag) [format "%.1f" [expr {$cmdr($tag) / 10.0}]] |
978 | trace variable cmdr-${seq}(div-$tag) w [list fix-tenth $tag] |
979 | cmdr-validate-widget $seq $tl.$tag [list numericp 0 $max] |
980 | grid configure $tl.l-$tag -row $r -column 0 -sticky e |
981 | grid configure $tl.$tag -row $r -column 1 -columnspan 2 -sticky we |
982 | } |
983 | toggle { |
984 | checkbutton $tl.$tag -text $label -variable cmdr-${seq}($tag) |
985 | grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky w |
986 | } |
987 | dropbox { |
988 | label $tl.l-$tag -text "$label: " -justify right |
989 | set menu $tl.m-$tag.menu |
990 | menubutton $tl.m-$tag -textvariable cmdr-${seq}(r-${tag}) \ |
991 | -indicatoron 1 -relief raised -menu $menu -width 8 \ |
992 | -direction flush |
993 | entry $tl.$tag -textvariable cmdr-${seq}($tag) \ |
994 | -justify right -width 4 |
995 | cmdr-validate-widget $seq $tl.$tag [list integerp 0 [lindex $kind 1]] |
996 | menu $menu -tearoff 0 |
997 | set cmdr(r-$tag) "Custom" |
998 | foreach {name value} [lrange $kind 2 end] { |
999 | $menu add radiobutton -label "$name ($value)" \ |
1000 | -value $name -variable cmdr-${seq}(r-$tag) \ |
1001 | -command [list cmdrdb-set $seq $tag $value] |
1002 | if {$cmdr($tag) == $value} { |
1003 | set cmdr(r-$tag) $name |
1004 | set cmdr($tag) $value |
1005 | $tl.$tag configure -state disabled |
1006 | } |
1007 | } |
1008 | $menu add radiobutton -label "Custom" \ |
1009 | -value "Custom" -variable cmdr-${seq}(r-$tag) \ |
1010 | -command [list cmdrdb-custom $seq $tag] |
1011 | grid configure $tl.l-$tag -row $r -column 0 -sticky e |
1012 | grid configure $tl.m-$tag -row $r -column 1 -sticky we |
1013 | grid configure $tl.$tag -row $r -column 2 -sticky we |
1014 | } |
1015 | cargo { |
1016 | button $tl.$tag -text $label -command [list cmdr-cargo $seq] |
1017 | grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky we |
1018 | } |
1019 | where { |
1020 | label $tl.l-gal-number -text "Galaxy number: " -justify right |
1021 | entry $tl.gal-number -textvariable cmdr-${seq}(gal-number) \ |
1022 | -justify right -width 2 |
1023 | cmdr-validate-widget $seq $tl.gal-number [list integerp 1 8] |
1024 | checkbutton $tl.std-gal -text "Standard galaxy" \ |
1025 | -variable cmdr-${seq}(std-gal) -justify left \ |
1026 | -command [list cmdr-std-gal $seq] |
1027 | entry-on-change $tl.gal-number [list cmdr-set-gal-num $seq] |
1028 | grid configure $tl.l-gal-number -row $r -column 0 -sticky e |
1029 | grid configure $tl.std-gal -row $r -column 1 -sticky w |
1030 | grid configure $tl.gal-number -row $r -column 2 -sticky we |
1031 | incr r |
1032 | label $tl.l-gal-seed -text "Galaxy seed: " -justify right |
1033 | entry $tl.gal-seed -textvariable cmdr-${seq}(gal-seed) -width 12 |
1034 | cmdr-validate-widget $seq $tl.gal-seed galaxyp |
1035 | entry-on-change $tl.gal-seed [list cmdr-update-world $seq] |
1036 | grid configure $tl.l-gal-seed -row $r -column 0 -sticky e |
1037 | grid configure $tl.gal-seed -row $r \ |
1038 | -column 1 -columnspan 2 -sticky we |
1039 | incr r |
1040 | if {[string equal $cmdr(gal-seed) [galaxy $cmdr(gal-number)]]} { |
1041 | set cmdr(std-gal) 1 |
1042 | $tl.gal-seed configure -state disabled |
1043 | } else { |
1044 | set cmdr(std-gal) 0 |
1045 | } |
1046 | label $tl.l-world-name -text "Planet: " -justify right |
1047 | entry $tl.world-name -textvariable cmdr-${seq}(world-name) \ |
1048 | -state disabled -width 10 -justify left |
1049 | grid configure $tl.l-world-name -row $r -column 0 -sticky e |
1050 | grid configure $tl.world-name -row $r \ |
1051 | -column 1 -columnspan 2 -sticky we |
1052 | incr r |
1053 | button $tl.$tag -text "Show galaxy map" \ |
1054 | -command [list cmdr-show-map $seq] |
1055 | grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky we |
1056 | } |
1057 | default { |
1058 | label $tl.l-$tag -text "($label)" -justify left |
1059 | grid configure $tl.l-$tag -row $r -column 0 -sticky w |
1060 | } |
1061 | } |
1062 | incr r |
1063 | } |
1064 | entry-on-change $tl.fuel [list cmdr-set-fuel $seq] |
1065 | menu $tl.menu |
1066 | menu $tl.menu.file |
1067 | $tl.menu.file add command -label "New commander" -command cmdr-new |
1068 | $tl.menu.file add command -label "Load commander..." \ |
1069 | -command { cmdr-loadfile } |
1070 | $tl.menu.file add command -label "Save commander" \ |
1071 | -command [list cmdr-save $seq] |
1072 | $tl.menu.file add command -label "Save as..." \ |
1073 | -command [list cmdr-saveas $seq] |
1074 | $tl.menu.file add separator |
1075 | $tl.menu.file add command -label "Close" -command [list cmdr-destroy $seq] |
1076 | $tl.menu.file add command -label "Quit" -command { exit } |
1077 | $tl.menu add cascade -label "File" -menu $tl.menu.file |
1078 | $tl configure -menu $tl.menu |
1079 | grid columnconfigure $tl 2 -weight 1 |
1080 | wm protocol $tl WM_DELETE_WINDOW [list cmdr-destroy $seq] |
1081 | set cmdr(ok/$tl.cargo-qty.fluc) 1 |
1082 | cmdr-update-world $seq |
1083 | cmdr-set-name $seq |
1084 | incr nwin |
1085 | return $seq |
1086 | } |
1087 | |
1088 | # --- File handling --- |
1089 | |
1090 | proc cmdr-load {file} { |
1091 | global seq |
1092 | incr seq |
1093 | set c [read-file $file] |
1094 | upvar \#0 cmdr-$seq cmdr |
1095 | elite-unpackcmdr cmdr $c |
1096 | set cmdr(file) $file |
1097 | cmdr-open $seq |
1098 | } |
1099 | |
1100 | set cmdr-filetypes { |
1101 | { "Commander file" ".nkc" } |
1102 | } |
1103 | |
1104 | proc cmdr-loadfile {} { |
1105 | global cmdr-filetypes |
1106 | set f [tk_getOpenFile \ |
1107 | -defaultextension ".nkc" -filetypes ${cmdr-filetypes} \ |
1108 | -title "Load commander"] |
1109 | if {![string equal $f ""]} { |
1110 | cmdr-load $f |
1111 | } |
1112 | } |
1113 | |
1114 | proc cmdr-save-file {seq file} { |
1115 | upvar \#0 cmdr-$seq cmdr |
1116 | set tl .cmdr-$seq |
1117 | if {[catch { write-file $file [elite-packcmdr cmdr] } err]} { |
1118 | moan $err |
1119 | } else { |
1120 | set cmdr(file) $file |
1121 | cmdr-set-name $seq |
1122 | } |
1123 | } |
1124 | |
1125 | proc cmdr-saveas {seq} { |
1126 | upvar \#0 cmdr-$seq cmdr |
1127 | global cmdr-filetypes |
1128 | if {![cmdr-check $seq]} { return } |
1129 | set opts [list \ |
1130 | -defaultextension ".nkc" -filetypes ${cmdr-filetypes} \ |
1131 | -title "Save commander"] |
1132 | if {[info exists cmdr(file)]} { |
1133 | lappend opts -initialdir [file dirname $cmdr(file)] |
1134 | lappend opts -initialfile [file tail $cmdr(file)] |
1135 | } else { |
1136 | lappend opts -initialfile "JAMESON.nkc" |
1137 | } |
1138 | set f [eval tk_getSaveFile $opts] |
1139 | if {[string equal $f ""]} { return } |
1140 | cmdr-save-file $seq $f |
1141 | } |
1142 | |
1143 | proc cmdr-save {seq} { |
1144 | upvar \#0 cmdr-$seq cmdr |
1145 | if {![info exists cmdr(file)]} { |
1146 | cmdr-saveas $seq |
1147 | return |
1148 | } |
1149 | if {![cmdr-check $seq]} { return } |
1150 | cmdr-save-file $seq $cmdr(file) |
1151 | } |
1152 | |
1153 | proc cmdr-new {} { |
1154 | global seq galaxy1 products |
1155 | incr seq |
1156 | upvar \#0 cmdr-$seq cmdr |
1157 | array set cmdr { |
1158 | mission 0 |
1159 | credits 1000 |
1160 | fuel 70 |
1161 | gal-number 1 |
1162 | front-laser 0x0f |
1163 | rear-laser 0 |
1164 | left-laser 0 |
1165 | right-laser 0 |
1166 | cargo 20 |
1167 | missiles 3 |
1168 | legal-status 0 |
1169 | score 0 |
1170 | market-fluc 0 |
1171 | } |
1172 | set cmdr(gal-seed) $galaxy1 |
1173 | foreach i { |
1174 | ecm fuel-scoop energy-bomb energy-unit docking-computer |
1175 | gal-hyperdrive escape-pod |
1176 | } { set cmdr($i) 0 } |
1177 | elite-worldinfo lave [find-world $galaxy1 "Lave"] |
1178 | set cmdr(world-x) [expr {$lave(x)/4}] |
1179 | set cmdr(world-y) [expr {$lave(y)/2}] |
1180 | elite-market mkt $lave(seed) 0 |
1181 | foreach {t n} $products { |
1182 | destructure [list . cmdr(station-$t)] $mkt($t) |
1183 | set cmdr(hold-$t) 0 |
1184 | } |
1185 | set cmdr(station-alien-items) 0 |
1186 | cmdr-open $seq |
1187 | } |
1188 | |
1189 | #----- Main program --------------------------------------------------------- |
1190 | |
1191 | wm withdraw . |
1192 | |
1193 | if {[llength $argv]} { |
1194 | foreach a $argv { |
1195 | set g [parse-galaxy-spec $a] |
1196 | if {[llength $g]} { |
1197 | destructure {ng g} $g |
1198 | map-new $ng $g |
1199 | } else { |
1200 | cmdr-load $a |
1201 | } |
1202 | } |
1203 | } else { |
1204 | map-new 1 $galaxy1 |
1205 | } |
1206 | if {!$nwin} { exit } |
1207 | |
1208 | #----- That's all, folks ---------------------------------------------------- |