3 package require "elite" "1.0.0"
5 # --- Utility procedures ----------------------------------------------------
9 tk_messageBox -message $msg -default ok -title $argv0 -type ok -icon error
12 proc debug-array {name} {
15 if {[winfo exists .$tl]} { return }
16 set s [array startsearch a]
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
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]]} {
40 fconfigure $f -translation $trans
41 puts -nonewline $f $contents
45 catch { file rename -force "$name.old" $name }
51 proc read-file {name {trans binary}} {
53 fconfigure $f -translation $trans
59 proc get-line-done {tl cmd} {
60 if {![uplevel \#0 [concat $cmd [$tl.entry get]]]} {
65 proc get-line {tl title prompt def cmd} {
66 if {[winfo exists $tl]} {
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
81 proc entry-on-change {widget what} {
82 bind $widget <Return> $what
83 bind $widget <FocusOut> $what
86 #----- Map editing machinery ------------------------------------------------
88 tab col red orange yellow green blue magenta violet white
92 array set default {scale 15 colourby off connect 0}
94 proc set-scale {seq sc} {
95 if {![regexp {^[0-9]+$} $sc]} {
96 moan "bad scale factor `$sc'"
104 set g [parse-galaxy-spec $gs]
106 moan "bad galaxy spec `$gs'"
109 destructure {ng g} $g
114 # --- Colour-coding planets ---
116 proc colour-by {seq} {
117 upvar \#0 map-$seq map
120 switch -exact -- $map(colourby) {
122 foreach-world $map(galaxy) p {
123 $tl.map itemconfigure $p(seed) -fill white -outline white
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)
133 foreach-world $map(galaxy) p {
135 $tl.map itemconfigure $p(seed) -fill $col($c) -outline $col($c)
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)
147 proc set-colour-by {seq} {
149 upvar \#0 map-$seq map
150 set default(colourby) $map(colourby)
154 # --- Connectivity maps ---
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
162 if {!$map(connect)} {
165 if {![info exists adj]} { adjacency $ww adj }
166 foreach {s x y} $ww {
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
176 $tl.map lower conn sep
179 proc set-connectivity {seq} {
181 upvar \#0 map-$seq map
182 set default(connect) $map(connect)
183 show-connectivity $seq
186 # --- Planet names ---
188 proc show-names {seq} {
189 upvar \#0 map-$seq map
195 foreach-world $map(galaxy) p {
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]}]
202 foreach {a ox oy dx x y xx yy} {
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
210 ne -2 2 10 -30 0 0 10
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}]]]} {
224 $tl.map create text $offx $offy -text $p(name) \
225 -fill white -anchor $a -tags names
229 proc set-names {seq} {
231 upvar \#0 map-$seq map
232 set default(names) $map(names)
236 # --- Shortest path handling ---
238 proc show-path {seq} {
239 upvar \#0 map-$seq map
242 if {![info exists map(path)]} { return }
243 foreach n $map(path) {
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
254 $tl.map lower path sep
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
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"
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"
279 # --- Planet information box ---
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]} {
291 foreach {item label} {
296 gov-name "Government"
297 techlevel "Tech. level"
299 prod-str "Productivity"
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
308 scrollbar $tl.descscr -orient vertical -command [list $tl.desc yview]
309 text $tl.desc -wrap word -yscrollcommand [list $tl.descscr set] \
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
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))
321 [format "%s billion (%s)" \
322 [expr {$info(population)/10}] \
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
332 # --- Messing with selections ---
335 upvar \#0 map-$seq map
336 return [expr {$x * $map(scale) / 10.0}]
339 proc to-map {seq x} {
340 upvar \#0 map-$seq map
341 return [expr {$x * 10 / $map(scale)}]
344 proc find-click {seq x y} {
345 upvar \#0 map-$seq map
346 upvar \#0 ww-$map(galaxy) ww
349 set x [to-ly $seq [$tl.map canvasx $x]]
350 set y [to-ly $seq [$tl.map canvasy $y]]
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}]
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
376 proc destination-world {seq} {
377 upvar \#0 map-$seq map
379 if {![info exists map(dest)]} { return }
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
391 proc select-world {seq} {
392 upvar \#0 map-$seq map
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
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]} {
416 } elseif {[info exists map($seed)]} {
418 set map($name) [worldname $map($seed)]
425 proc set-selection {seq p} {
426 upvar \#0 map-$seq map
428 elite-worldinfo pp $p
430 set map(sel-name) $pp(name)
431 if {![info exists map(dest)]} {
432 set-destination $seq $p
434 set-destination $seq $map(dest)
436 if {[info exists map(cmdr)]} {
437 cmdr-set-world $map(cmdr) $p
441 proc do-select {seq x y} {
442 set-selection $seq [find-click $seq $x $y]
445 proc set-destination {seq p} {
446 upvar \#0 map-$seq map
447 if {![info exists map(select)]} {
448 set-selection $seq $p
450 elite-worldinfo ps $map(select)
451 elite-worldinfo pd $p
453 destination-world $seq
454 set map(dest-name) $pd(name)
457 [expr {[world-distance $ps(x) $ps(y) $pd(x) $pd(y)] / 10.0}]]
461 proc do-destination {seq x y} {
462 set-destination $seq [find-click $seq $x $y]
465 # --- Redrawing a map ---
467 proc map-populate {seq} {
468 global colourby-$seq connect-$seq
469 upvar \#0 map-$seq map
470 upvar \#0 ww-$map(galaxy) ww
473 set scale $map(scale)
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]
490 show-connectivity $seq
494 destination-world $seq
497 # --- Miscellaneous stuff ---
499 proc map-setscale {seq sc} {
501 upvar \#0 map-$seq map
503 set wd [expr {10240/$sc + 40}]
504 set ht [expr {5120/$sc} + 10]
505 $tl.map configure -scrollregion [list -40 -10 $wd $ht]
507 set default(scale) $sc
511 proc map-destroy {seq} {
513 upvar \#0 map-$seq map
514 if {[info exists map(cmdr)]} {
515 upvar \#0 cmdr-$map(cmdr) cmdr
519 destroy .map-$seq .set-scale-$seq
524 proc map-attach-cmdr {seq cmdr} {
525 upvar \#0 map-$seq map
530 proc map-set-title {seq} {
531 upvar \#0 map-$seq map
533 set t "Galaxy $map(galaxy-num)"
534 if {[info exists map(cmdr)]} {
535 append t " (commander [cmdr-name $map(cmdr)])"
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
547 foreach i {select select-name dest dest-name} {
548 catch { unset map($i) }
552 proc map-set-fuel {seq qty} {
553 upvar \#0 map-$seq map
558 # --- Making a new map window ---
560 proc map-new {ng g} {
561 global seq nwin default
564 upvar \#0 map-$seq map
566 array set map [array get default]
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 }
578 -xscrollcommand [list $tl.hscr set] \
579 -yscrollcommand [list $tl.vscr set] \
580 -width $vwd -height $vht
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
590 $tl.info.lhome $tl.info.home \
591 $tl.info.ldest $tl.info.dest \
592 $tl.info.ldist $tl.info.dist \
595 scrollbar $tl.hscr -orient horizontal \
596 -command [list $tl.map xview]
597 scrollbar $tl.vscr -orient vertical \
598 -command [list $tl.map yview]
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
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
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
649 wm protocol $tl WM_DELETE_WINDOW [list map-destroy $seq]
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
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]
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
672 #----- Commander editing machinery ------------------------------------------
674 # --- Validation and factor-of-10 fixing ---
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)}]] }
681 proc numericp {min max n} {
682 if {[catch { expr {$n + 0} }]} { return 0 }
683 if {$n < $min || $n > $max} { return 0 }
687 proc integerp {min max n} {
688 if {[catch { incr n 0}]} { return 0 }
689 if {$n < $min || $n > $max} { return 0 }
694 if {![regexp {^[0-9a-fA-F]{12}$} $s]} { return 0 }
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
705 set cmdr(ok/$widget) 1
706 $widget configure -foreground black
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]
719 # --- Cargo window handling ---
721 proc cmdr-set-fluc {seq} {
722 upvar \#0 cmdr-$seq cmdr
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}]]
732 proc cmdr-cargo {seq} {
733 upvar \#0 cmdr-$seq cmdr
734 set tl .cmdr-$seq.cargo-qty
735 if {[winfo exists $tl]} {
740 wm title $tl "Cargo for commander $cmdr(name)"
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
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
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
769 grid configure $tl.l-$tag -row $r -column 0 -sticky e
770 grid configure $tl.price-$tag -row $r -column 1 -sticky we
773 grid columnconfigure $tl 1 -weight 1
774 grid columnconfigure $tl 2 -weight 1
775 grid columnconfigure $tl 3 -weight 1
778 # --- Miscellaneous stuff ---
780 proc cmdr-destroy {seq} {
781 upvar \#0 cmdr-$seq cmdr
784 if {[info exists cmdr(map)]} { map-destroy $cmdr(map) }
791 proc cmdrdb-set {seq tag value} {
792 upvar \#0 cmdr-$seq cmdr
794 set cmdr($tag) $value
795 $tl.$tag configure -state disabled
798 proc cmdrdb-custom {seq tag} {
800 $tl.$tag configure -state normal
803 proc cmdr-set-world {seq p} {
804 upvar \#0 cmdr-$seq cmdr
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}]
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)] }
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)
824 set ng $cmdr(gal-seed)
826 map-set-galaxy $cmdr(map) $ng $cmdr(gal-seed)
827 set-selection $cmdr(map) $w
829 cmdr-set-world $seq $w
832 proc cmdr-set-gal-num {seq} {
833 upvar \#0 cmdr-$seq cmdr
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
842 proc cmdr-std-gal {seq} {
843 upvar \#0 cmdr-$seq cmdr
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
851 $tl.gal-seed configure -state normal
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)
862 proc cmdr-name {seq} {
863 upvar \#0 cmdr-$seq cmdr
867 proc cmdr-show-map {seq} {
868 upvar \#0 cmdr-$seq cmdr
869 if {[info exists cmdr(map)]} {
872 if {$cmdr(std-gal)} {
873 set ng $cmdr(gal-number)
875 set ng $cmdr(gal-seed)
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)
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)]]]
888 set cmdr(name) JAMESON
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)"
898 proc cmdr-check {seq} {
899 upvar \#0 cmdr-$seq cmdr
901 moan("invalid values in commander data -- fix items highlighted in red")
907 # --- Initial population ---
909 proc cmdr-open {seq} {
910 upvar \#0 cmdr-$seq cmdr
925 foreach {tag label kind} [list \
926 mission "Mission" { entry 2 255 } \
927 score "Rating" { dropbox 65535\
929 "Mostly harmless" 8 \
937 legal-status "Legal status" { dropbox 255 \
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 \
949 front-laser "Front laser" $laser \
950 rear-laser "Front laser" $laser \
951 left-laser "Left laser" $laser \
952 right-laser "Right laser" $laser \
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 \
962 switch -exact -- [lindex $kind 0] {
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
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
984 checkbutton $tl.$tag -text $label -variable cmdr-${seq}($tag)
985 grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky w
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 \
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
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
1016 button $tl.$tag -text $label -command [list cmdr-cargo $seq]
1017 grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky we
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
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
1040 if {[string equal $cmdr(gal-seed) [galaxy $cmdr(gal-number)]]} {
1042 $tl.gal-seed configure -state disabled
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
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
1058 label $tl.l-$tag -text "($label)" -justify left
1059 grid configure $tl.l-$tag -row $r -column 0 -sticky w
1064 entry-on-change $tl.fuel [list cmdr-set-fuel $seq]
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
1088 # --- File handling ---
1090 proc cmdr-load {file} {
1093 set c [read-file $file]
1094 upvar \#0 cmdr-$seq cmdr
1095 elite-unpackcmdr cmdr $c
1096 set cmdr(file) $file
1100 set cmdr-filetypes {
1101 { "Commander file" ".nkc" }
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 ""]} {
1114 proc cmdr-save-file {seq file} {
1115 upvar \#0 cmdr-$seq cmdr
1117 if {[catch { write-file $file [elite-packcmdr cmdr] } err]} {
1120 set cmdr(file) $file
1125 proc cmdr-saveas {seq} {
1126 upvar \#0 cmdr-$seq cmdr
1127 global cmdr-filetypes
1128 if {![cmdr-check $seq]} { return }
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)]
1136 lappend opts -initialfile "JAMESON.nkc"
1138 set f [eval tk_getSaveFile $opts]
1139 if {[string equal $f ""]} { return }
1140 cmdr-save-file $seq $f
1143 proc cmdr-save {seq} {
1144 upvar \#0 cmdr-$seq cmdr
1145 if {![info exists cmdr(file)]} {
1149 if {![cmdr-check $seq]} { return }
1150 cmdr-save-file $seq $cmdr(file)
1154 global seq galaxy1 products
1156 upvar \#0 cmdr-$seq cmdr
1172 set cmdr(gal-seed) $galaxy1
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)
1185 set cmdr(station-alien-items) 0
1189 #----- Main program ---------------------------------------------------------
1193 if {[llength $argv]} {
1195 set g [parse-galaxy-spec $a]
1197 destructure {ng g} $g
1206 if {!$nwin} { exit }
1208 #----- That's all, folks ----------------------------------------------------