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