chiark / gitweb /
Space out dialogues a bit more. Fix a few bugs. Allow map to be opened
authormdw <mdw>
Tue, 18 Mar 2003 10:40:32 +0000 (10:40 +0000)
committermdw <mdw>
Tue, 18 Mar 2003 10:40:32 +0000 (10:40 +0000)
from commander editor.

elite-editor

index 82ac25c..9689db8 100755 (executable)
@@ -1,10 +1,10 @@
 #! /usr/bin/wish
 #
-# $Id: elite-editor,v 1.8 2003/03/07 00:43:12 mdw Exp $
+# $Id: elite-editor,v 1.9 2003/03/18 10:40:32 mdw Exp $
 
 package require "elite" "1.0.1"
 
-# --- Utility procedures ----------------------------------------------------
+#----- Utility procedures ---------------------------------------------------
 
 proc moan {msg} {
   global argv0
@@ -23,8 +23,8 @@ proc debug-array {name} {
     set k [array nextelement a $s]
     label $tl.k-$n -text $k -justify right
     entry $tl.v-$n -textvariable ${name}($k) -state disabled
-    grid configure $tl.k-$n -row $r -column 0 -sticky e
-    grid configure $tl.v-$n -row $r -column 1 -sticky we
+    grid configure $tl.k-$n -row $r -column 0 -sticky e -padx 1 -pady 1
+    grid configure $tl.v-$n -row $r -column 1 -sticky we -padx 1 -pady 1
     incr r
     incr n
   }
@@ -44,7 +44,7 @@ proc get-line {tl title prompt def cmd} {
   }
   toplevel $tl
   wm title $tl $title
-  label $tl.label -text "$prompt: "
+  label $tl.label -text "$prompt:"
   entry $tl.entry; $tl.entry insert 0 $def
   button $tl.ok -text OK -default active \
       -command [list get-line-done $tl $cmd]
@@ -58,6 +58,56 @@ proc entry-on-change {widget what} {
   bind $widget <FocusOut> $what
 }
 
+if {$tk_version >= 8.4} {
+  set entry_readonly readonly
+} else {
+  set entry_readonly disabled
+}
+
+#----- About box ------------------------------------------------------------
+
+proc about-box {} {
+  if {[winfo exists .about]} {
+    # raise .about
+    return
+  }
+  toplevel .about
+  wm title .about "About elite-editor"
+  label .about.rocl -font {helvetica 16 bold} -justify left \
+      -text "Right On Command-Line"
+  label .about.ee -font {helvetica 10 italic} -justify left \
+      -text "elite-editor"
+  label .about.gpl -font {helvetica 8 normal} -justify left -text {
+Copyright (c) 2003 Mark Wooding
+Partly based on code by Ian Bell and Christian Pinder
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  }
+  button .about.dismiss -text "Dismiss" -command { destroy .about }
+  pack .about.rocl -padx 4 -side top -anchor w
+  pack .about.ee -padx 4 -side top -anchor e
+  pack .about.gpl -padx 24 -side top -anchor center -expand 1
+  pack .about.dismiss -side top -padx 4 -pady 4 -anchor e
+}
+
+proc help-menu {m} {
+  menu $m.help
+  $m.help add command -label "About..." -command about-box
+  $m add cascade -label "Help" -menu $m.help
+}
+
 #----- Map editing machinery ------------------------------------------------
 
 tab col red orange yellow green blue magenta violet white
@@ -296,6 +346,7 @@ proc load-path {seq} {
   upvar \#0 map-$seq map
   set tl .map-$seq
   set file [tk_getOpenFile -title "Load path"]
+  if {[string equal $file ""]} { return }
   if {[catch {
     set f [open $file]
     set path {}
@@ -354,7 +405,7 @@ proc show-shortest-path {seq weight} {
 # --- Planet information box ---
 
 proc show-worldinfo {tag p} {
-  global economy government
+  global economy government entry_readonly
   upvar \#0 info-$tag info
   set tl .world-info-$tag
   elite-worldinfo info $p
@@ -374,10 +425,10 @@ proc show-worldinfo {tag p} {
       prod-str "Productivity"
       radius-km        "Radius"
     } {
-      label $tl.l-$item -text "$label: " -justify right
-      entry $tl.$item -textvariable info-${tag}($item) -state disabled
-      grid configure $tl.l-$item -row $r -column 0 -sticky e
-      grid configure $tl.$item -row $r -column 1 -columnspan 2 -sticky we
+      label $tl.l-$item -text "$label:" -justify right
+      entry $tl.$item -textvariable info-${tag}($item) -state $entry_readonly
+      grid configure $tl.l-$item -row $r -column 0 -sticky e -padx 1 -pady 1
+      grid configure $tl.$item -row $r -column 1 -columnspan 2 -sticky we -padx 1 -pady 1
       incr r
     }
     scrollbar $tl.descscr -orient vertical -command [list $tl.desc yview]
@@ -513,6 +564,7 @@ proc info-byname {seq name seed proc} {
 
 proc set-selection {seq p} {
   upvar \#0 map-$seq map
+  set tl .map-$seq
   if {[info exists map(cmdr)]} {
     set p [cmdr-set-world $map(cmdr) $p]
   }
@@ -525,6 +577,9 @@ proc set-selection {seq p} {
   } else {
     set-destination $seq $map(dest)
   }
+  foreach i {5 6 7 8 9} {
+    $tl.menu.path entryconfigure $i -state normal
+  }
 }  
 
 proc do-select {seq x y} {
@@ -648,7 +703,7 @@ proc map-set-fuel {seq qty} {
 # --- Making a new map window ---
 
 proc map-new {ng g} {
-  global seq nwin default
+  global seq nwin default entry_readonly
   incr seq
   incr nwin
   upvar \#0 map-$seq map
@@ -669,18 +724,18 @@ proc map-new {ng g} {
       -yscrollcommand [list $tl.vscr set] \
       -width $vwd -height $vht
   frame $tl.info
-  label $tl.info.lhome -text "Home: "
+  label $tl.info.lhome -text "Home:"
   entry $tl.info.home -textvariable map-${seq}(sel-name)
-  label $tl.info.ldest -text "Destination: "
+  label $tl.info.ldest -text " Destination:"
   entry $tl.info.dest -textvariable map-${seq}(dest-name)
-  label $tl.info.ldist -text "Distance: "
+  label $tl.info.ldist -text " Distance:"
   entry $tl.info.dist -textvariable map-${seq}(distance) \
-      -state disabled -width 6
+      -state $entry_readonly -width 6
   pack \
       $tl.info.lhome $tl.info.home \
       $tl.info.ldest $tl.info.dest \
       $tl.info.ldist $tl.info.dist \
-      -side left
+      -side left -pady 2
   
   scrollbar $tl.hscr -orient horizontal \
       -command [list $tl.map xview]
@@ -734,20 +789,21 @@ proc map-new {ng g} {
   $tl.menu.path add command -label "List path..." -state disabled \
       -command [list list-path $seq]
   $tl.menu.path add separator
-  $tl.menu.path add command -label "Minimize hops" \
+  $tl.menu.path add command -label "Minimize hops" -state disabled \
       -command [list show-shortest-path $seq weight-hops]
-  $tl.menu.path add command -label "Minimize fuel" \
+  $tl.menu.path add command -label "Minimize fuel" -state disabled \
       -command [list show-shortest-path $seq weight-fuel]
-  $tl.menu.path add command -label "Maximize safety" \
+  $tl.menu.path add command -label "Maximize safety" -state disabled \
       -command [list show-shortest-path $seq weight-safety]
-  $tl.menu.path add command -label "Minimize safety" \
+  $tl.menu.path add command -label "Minimize safety" -state disabled \
       -command [list show-shortest-path $seq weight-encounters]
-  $tl.menu.path add command -label "Maximize trading" \
+  $tl.menu.path add command -label "Maximize trading" -state disabled \
       -command [list show-shortest-path $seq weight-trading]
   $tl.menu.path add separator
   $tl.menu.path add command -label "Hide path" -state disabled \
       -command [list hide-path $seq]
   $tl.menu add cascade -label "Path" -menu $tl.menu.path
+  help-menu $tl.menu
   $tl configure -menu $tl.menu
 
   wm protocol $tl WM_DELETE_WINDOW [list map-destroy $seq]
@@ -838,6 +894,7 @@ proc cmdr-set-fluc {seq} {
 }
 
 proc cmdr-cargo {seq} {
+  global entry_readonly
   upvar \#0 cmdr-$seq cmdr
   set tl .cmdr-$seq.cargo-qty
   if {[winfo exists $tl]} {
@@ -848,34 +905,34 @@ proc cmdr-cargo {seq} {
   wm title $tl "Cargo for commander $cmdr(name)"
   global products
   set r 0
-  label $tl.l-fluc -text "Fluctuation: " -justify right
+  label $tl.l-fluc -text "Fluctuation:" -justify right
   entry $tl.fluc -textvariable cmdr-${seq}(market-fluc) -justify right
   cmdr-validate-widget $seq $tl.fluc [list integerp 0 255]
   entry-on-change $tl.fluc [list cmdr-set-fluc $seq]
-  grid configure $tl.l-fluc -row $r -column 0 -sticky e
-  grid configure $tl.fluc -row $r -column 1 -columnspan 3 -sticky we
+  grid configure $tl.l-fluc -row $r -column 0 -sticky e -padx 1 -pady 1
+  grid configure $tl.fluc -row $r -column 1 -columnspan 3 -sticky we -padx 1 -pady 1
   incr r
   label $tl.l-item -text "Item" -justify center
   label $tl.l-price -text "Price" -justify center
   label $tl.l-station -text "Station" -justify center
   label $tl.l-hold -text "Hold" -justify center
-  grid configure $tl.l-item -row $r -column 0 -sticky e
-  grid configure $tl.l-price -row $r -column 1 -sticky we
-  grid configure $tl.l-station -row $r -column 2 -sticky we
-  grid configure $tl.l-hold -row $r -column 3 -sticky we
+  grid configure $tl.l-item -row $r -column 0 -sticky e -padx 1 -pady 1
+  grid configure $tl.l-price -row $r -column 1 -sticky we -padx 1 -pady 1
+  grid configure $tl.l-station -row $r -column 2 -sticky we -padx 1 -pady 1
+  grid configure $tl.l-hold -row $r -column 3 -sticky we -padx 1 -pady 1
   incr r
   foreach {tag label} $products {
-    label $tl.l-$tag -text "$label: " -justify right
+    label $tl.l-$tag -text "$label:" -justify right
     entry $tl.price-$tag -textvariable cmdr-${seq}(price-${tag}) \
-       -justify right -state disabled -width 4
+       -justify right -state $entry_readonly -width 4
     foreach {pre col} {station 2 hold 3} {
       entry $tl.${pre}-${tag} -textvariable cmdr-${seq}(${pre}-${tag}) \
          -justify right -width 4
       cmdr-validate-widget $seq $tl.${pre}-${tag} [list integerp 0 255]
       grid configure $tl.${pre}-${tag} -row $r -column $col -stick we
     }
-    grid configure $tl.l-$tag -row $r -column 0 -sticky e
-    grid configure $tl.price-$tag -row $r -column 1 -sticky we
+    grid configure $tl.l-$tag -row $r -column 0 -sticky e -padx 1 -pady 1
+    grid configure $tl.price-$tag -row $r -column 1 -sticky we -padx 1 -pady 1
     incr r
   }
   grid columnconfigure $tl 1 -weight 1
@@ -896,6 +953,17 @@ proc cmdr-destroy {seq} {
   if {!$nwin} { exit }
 }
 
+proc cmdr-new-map {seq} {
+  upvar \#0 cmdr-$seq cmdr
+  set tl .cmdr-$seq
+  if {$cmdr(std-gal)} {
+    set g $cmdr(gal-number)
+  } else {
+    set g $cmdr(gal-seed)
+  }
+  get-line .new-view "New map..." "Galaxy" $g new-view
+}
+
 proc cmdrdb-set {seq tag value} {
   upvar \#0 cmdr-$seq cmdr
   set tl .cmdr-$seq
@@ -1024,7 +1092,7 @@ proc cmdr-check {seq} {
 
 proc cmdr-open {seq} {
   upvar \#0 cmdr-$seq cmdr
-  global cmdr-$seq
+  global cmdr-$seq entry_readonly
   set tl .cmdr-$seq
   global nwin
   toplevel $tl
@@ -1063,7 +1131,7 @@ proc cmdr-open {seq} {
                                                  "Standard"    1 \
                                                  "Naval"       2 } \
     front-laser                "Front laser"           $laser \
-    rear-laser         "Front laser"           $laser \
+    rear-laser         "Rear laser"            $laser \
     left-laser         "Left laser"            $laser \
     right-laser                "Right laser"           $laser \
     ecm                        "ECM"                   toggle \
@@ -1078,30 +1146,30 @@ proc cmdr-open {seq} {
     switch -exact -- [lindex $kind 0] {
       entry {
        destructure {. wd max} $kind
-       label $tl.l-$tag -text "$label: " -justify right
+       label $tl.l-$tag -text "$label:" -justify right
        entry $tl.$tag -textvariable cmdr-${seq}($tag) \
            -width $wd -justify right
        cmdr-validate-widget $seq $tl.$tag [list integerp 0 $max]
-       grid configure $tl.l-$tag -row $r -column 0 -sticky e
-       grid configure $tl.$tag -row $r -column 1 -columnspan 2 -sticky we
+       grid configure $tl.l-$tag -row $r -column 0 -sticky e -padx 1 -pady 1
+       grid configure $tl.$tag -row $r -column 1 -columnspan 2 -sticky we -padx 1 -pady 1
       }
       tenth {
        destructure {. wd max} $kind
-       label $tl.l-$tag -text "$label: " -justify right
+       label $tl.l-$tag -text "$label:" -justify right
        entry $tl.$tag -textvariable cmdr-${seq}(div-$tag) \
            -width $wd -justify right
        set cmdr(div-$tag) [format "%.1f" [expr {$cmdr($tag) / 10.0}]]
        trace variable cmdr-${seq}(div-$tag) w [list fix-tenth $tag]
        cmdr-validate-widget $seq $tl.$tag [list numericp 0 $max]
-       grid configure $tl.l-$tag -row $r -column 0 -sticky e
-       grid configure $tl.$tag -row $r -column 1 -columnspan 2 -sticky we
+       grid configure $tl.l-$tag -row $r -column 0 -sticky e -padx 1 -pady 1
+       grid configure $tl.$tag -row $r -column 1 -columnspan 2 -sticky we -padx 1 -pady 1
       }
       toggle {
        checkbutton $tl.$tag -text $label -variable cmdr-${seq}($tag)
-       grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky w
+       grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky w -padx 1 -pady 1
       }
       dropbox {
-       label $tl.l-$tag -text "$label: " -justify right
+       label $tl.l-$tag -text "$label:" -justify right
        set menu $tl.m-$tag.menu
        menubutton $tl.m-$tag -textvariable cmdr-${seq}(r-${tag}) \
            -indicatoron 1 -relief raised -menu $menu -width 8 \
@@ -1124,16 +1192,16 @@ proc cmdr-open {seq} {
        $menu add radiobutton -label "Custom" \
            -value "Custom" -variable cmdr-${seq}(r-$tag) \
            -command [list cmdrdb-custom $seq $tag]
-       grid configure $tl.l-$tag -row $r -column 0 -sticky e
-       grid configure $tl.m-$tag -row $r -column 1 -sticky we
-       grid configure $tl.$tag -row $r -column 2 -sticky we
+       grid configure $tl.l-$tag -row $r -column 0 -sticky e -padx 1 -pady 1
+       grid configure $tl.m-$tag -row $r -column 1 -sticky we -padx 1 -pady 1
+       grid configure $tl.$tag -row $r -column 2 -sticky we -padx 1 -pady 1
       }
       cargo {
        button $tl.$tag -text $label -command [list cmdr-cargo $seq]
-       grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky we
+       grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky we -padx 1 -pady 1
       }
       where {
-       label $tl.l-gal-number -text "Galaxy number: " -justify right
+       label $tl.l-gal-number -text "Galaxy number:" -justify right
        entry $tl.gal-number -textvariable cmdr-${seq}(gal-number) \
            -justify right -width 2
        cmdr-validate-widget $seq $tl.gal-number [list integerp 1 8]
@@ -1141,17 +1209,17 @@ proc cmdr-open {seq} {
            -variable cmdr-${seq}(std-gal) -justify left \
            -command [list cmdr-std-gal $seq]     
        entry-on-change $tl.gal-number [list cmdr-set-gal-num $seq]
-       grid configure $tl.l-gal-number -row $r -column 0 -sticky e
-       grid configure $tl.std-gal -row $r -column 1 -sticky w
-       grid configure $tl.gal-number -row $r -column 2 -sticky we
+       grid configure $tl.l-gal-number -row $r -column 0 -sticky e -padx 1 -pady 1
+       grid configure $tl.std-gal -row $r -column 1 -sticky w -padx 1 -pady 1
+       grid configure $tl.gal-number -row $r -column 2 -sticky we -padx 1 -pady 1
        incr r
-       label $tl.l-gal-seed -text "Galaxy seed: " -justify right
+       label $tl.l-gal-seed -text "Galaxy seed:" -justify right
        entry $tl.gal-seed -textvariable cmdr-${seq}(gal-seed) -width 12
        cmdr-validate-widget $seq $tl.gal-seed galaxyp
        entry-on-change $tl.gal-seed [list cmdr-update-world $seq]
-       grid configure $tl.l-gal-seed -row $r -column 0 -sticky e
+       grid configure $tl.l-gal-seed -row $r -column 0 -sticky e -padx 1 -pady 1
        grid configure $tl.gal-seed -row $r \
-           -column 1 -columnspan 2 -sticky we
+           -column 1 -columnspan 2 -sticky we -padx 1 -pady 1
        incr r
        if {[string equal $cmdr(gal-seed) [galaxy $cmdr(gal-number)]]} {
          set cmdr(std-gal) 1
@@ -1159,20 +1227,20 @@ proc cmdr-open {seq} {
        } else {
          set cmdr(std-gal) 0
        }
-       label $tl.l-world-name -text "Planet: " -justify right
+       label $tl.l-world-name -text "Planet:" -justify right
        entry $tl.world-name -textvariable cmdr-${seq}(world-name) \
-           -state disabled -width 10 -justify left
-       grid configure $tl.l-world-name -row $r -column 0 -sticky e
+           -state $entry_readonly -width 10 -justify left
+       grid configure $tl.l-world-name -row $r -column 0 -sticky e -padx 1 -pady 1
        grid configure $tl.world-name -row $r \
-           -column 1 -columnspan 2 -sticky we
+           -column 1 -columnspan 2 -sticky we -padx 1 -pady 1
        incr r
        button $tl.$tag -text "Show galaxy map" \
            -command [list cmdr-show-map $seq]
-       grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky we
+       grid configure $tl.$tag -row $r -column 0 -columnspan 3 -sticky we -padx 1 -pady 1
       }
       default {
        label $tl.l-$tag -text "($label)" -justify left
-       grid configure $tl.l-$tag -row $r -column 0 -sticky w
+       grid configure $tl.l-$tag -row $r -column 0 -sticky w -padx 1 -pady 1
       }
     }
     incr r
@@ -1188,9 +1256,13 @@ proc cmdr-open {seq} {
   $tl.menu.file add command -label "Save as..." \
       -command [list cmdr-saveas $seq]
   $tl.menu.file add separator
+  $tl.menu.file add command -label "New map..." \
+      -command [list cmdr-new-map $seq]
+  $tl.menu.file add separator
   $tl.menu.file add command -label "Close" -command [list cmdr-destroy $seq]
   $tl.menu.file add command -label "Quit" -command { exit }
   $tl.menu add cascade -label "File" -menu $tl.menu.file
+  help-menu $tl.menu
   $tl configure -menu $tl.menu
   grid columnconfigure $tl 2 -weight 1
   wm protocol $tl WM_DELETE_WINDOW [list cmdr-destroy $seq]