chiark - git - mdw - rocl/blob - elite-editor

   1 #! /usr/bin/wish
   2 #
   3 # $Id: elite-editor,v 1.8 2003/03/07 00:43:12 mdw Exp $
   4
   5 package require "elite" "1.0.1"
   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
  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} {
  70   if {![regexp {^\d+$} $sc]} {
  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
  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
  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
 142   upvar \#0 adj-$map(galaxy)-$map(fuel) adj
 143   upvar \#0 ww-$map(galaxy) ww
 144   set tl .map-$seq
 145   $tl.map delete conn
 146   if {!$map(connect)} {
 147     show-path $seq
 148     return
 149   }
 150   if {![info exists adj]} { elite-adjacency adj $ww $map(fuel) }
 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
 162   show-path $seq
 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
 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)
 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
 260 }
 261
 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
 329 proc show-shortest-path {seq weight} {
 330   upvar \#0 map-$seq map
 331   upvar \#0 adj-$map(galaxy)-$map(fuel) adj
 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   }
 340   if {![info exists adj]} { elite-adjacency adj $ww $map(fuel) }
 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
 348   foreach i {2 3 11} {
 349     $tl.menu.path entryconfigure $i -state normal
 350   }
 351   show-path $seq
 352 }
 353
 354 # --- Planet information box ---
 355
 356 proc show-worldinfo {tag p} {
 357   global economy government
 358   upvar \#0 info-$tag info
 359   set tl .world-info-$tag
 360   elite-worldinfo info $p
 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
 407 proc do-getinfo {tag seq x y} {
 408   show-worldinfo $tag [find-click $seq $x $y]
 409 }
 410
 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
 495     return 1
 496   } elseif {[info exists map($seed)]} {
 497     bell
 498     set map($name) [worldname $map($seed)]
 499     return 0
 500   } else {
 501     bell
 502     set map($name) ""
 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)
 511   }
 512 }
 513
 514 proc set-selection {seq p} {
 515   upvar \#0 map-$seq map
 516   if {[info exists map(cmdr)]} {
 517     set p [cmdr-set-world $map(cmdr) $p]
 518   }
 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   }
 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" \
 546         [expr {[elite-distance $ps(x) $ps(y) $pd(x) $pd(y)] / 10.0}]]
 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
 565   if {![info exists ww]} { set ww [elite-galaxylist $map(galaxy)] }
 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
 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
 616   .map-$seq.menu.view entryconfigure 3 -state disabled
 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
 643   set map(fuel) [expr {int($qty)}]
 644   select-world $seq
 645   show-connectivity $seq
 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..." \
 700       -command [list get-line .new-view "New map" "Galaxy" $ng new-view]
 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]]]
 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]]]
 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
 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
 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]
 747   $tl.menu.path add separator
 748   $tl.menu.path add command -label "Hide path" -state disabled \
 749       -command [list hide-path $seq]
 750   $tl.menu add cascade -label "Path" -menu $tl.menu.path
 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]
 765   bind $tl.map <Double-3> [list do-getinfo select $seq %x %y]
 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]
 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]
 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
 913   upvar \#0 ww-$cmdr(gal-seed) ww
 914   elite-worldinfo i $p
 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)
 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
 926   return $i(seed)
 927 }
 928
 929 proc cmdr-update-world {seq} {
 930   upvar \#0 cmdr-$seq cmdr
 931   upvar \#0 ww-$cmdr(gal-seed) ww
 932   if {![info exists ww]} { set ww [elite-galaxylist $cmdr(gal-seed)] }
 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 \
1046                                                   "Poor"               16 \
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 {} {
1270   global seq
1271   incr seq
1272   upvar \#0 cmdr-$seq cmdr
1273   jameson cmdr
1274   cmdr-open $seq
1275 }
1276
1277 #----- Main program ---------------------------------------------------------
1278
1279 wm withdraw .
1280
1281 bind Entry <Control-u> { %W delete 0 end }
1282
1283 if {[llength $argv]} {
1284   foreach a $argv {
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       }
1302     }
1303   }
1304 } else {
1305   map-new 1 $galaxy1
1306 }
1307 if {!$nwin} { exit }
1308
1309 #----- That's all, folks ----------------------------------------------------