X-Git-Url: https://git.distorted.org.uk/~mdw/rocl/blobdiff_plain/8bdcaa8bc4ec2847020075cfc3f6cf03fb9a798f..refs/heads/master:/elite-cmdr

diff --git a/elite-cmdr b/elite-cmdr
index d94b04b..b0d500c 100755
--- a/elite-cmdr
+++ b/elite-cmdr
@@ -1,45 +1,82 @@
 #! /usr/bin/tclsh
+###
+### Commander file inspector
+###
+### (c) 2003 Mark Wooding
+###
 
-package require "elite" "1.0.0"
+###----- Licensing notice ---------------------------------------------------
+###
+### 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.
 
-if {[llength $argv] < 1} {
-  puts stderr "usage: $argv0 \[-OPTION | ATTR | ATTR=VALUE\] ..."
-  exit 1
+package require "elite" "1.0.1"
+
+###--------------------------------------------------------------------------
+### Various type handlers.
+###
+### We associate a named type and some optional (type-specific) parameters
+### with each attribute in the commander file format.  For each TYPE, there
+### are Tcl procedures:
+###
+### get/TYPE [PARAM ...] A -- return presentation form of the attribute A
+### dump/TYPE [PARAM ...] A -- return an external form of the attribute A
+### set/TYPE [PARAM ...] A V -- convert V from presentation form and store
+###	as the attribute A
+
+proc dump-like-get {type} {
+  ## Define dump/TYPE as a synonym for get/TYPE.
+
+  proc dump/$type {args} [list uplevel 1 get/$type \$args]
 }
-jameson cmdr
 
+## string -- just a plain unconverted string.
 proc get/string {a} { global cmdr; return $cmdr($a) }
-proc dump/string {a} { global cmdr; return $cmdr($a) }
+dump-like-get string
 proc set/string {a v} { global cmdr; set cmdr($a) $v }
 
+## int MIN MAX -- an integer constrained to lie between the stated
+##	(inclusive) bounds.
 proc get/int {min max a} {
   global cmdr
   return [format "%d" [expr {$cmdr($a) + 0}]]
 }
-proc dump/int {min max a} {
-  global cmdr
-  return [format "%d" [expr {$cmdr($a) + 0}]]
-}
+dump-like-get int
 proc set/int {min max a v} {
   global cmdr
   if {$v < $min || $v > $max} { error "value out of range" }
   set cmdr($a) $v
 }
 
+## tenth MIN MAX -- a numerical value constrained to lie between the stated
+## inclusive bounds; the internal format is an integer containing ten times
+## the presentation value.
 proc get/tenth {min max a} {
   global cmdr
   return [format "%.1f" [expr {$cmdr($a)/10.0}]]
 }
-proc dump/tenth {min max a} {
-  global cmdr
-  return [format "%.1f" [expr {$cmdr($a)/10.0}]]
-}
+dump-like-get tenth
 proc set/tenth {min max a v} {
   global cmdr
   if {$v < $min || $v > $max} { error "value out of range" }
   set cmdr($a) [expr {int($v * 10)}]
 }
 
+## choice MIN MAX L -- the presentation form is either an integer between the
+##	given inclusive bounds, or a token matching one of the items in the
+##	list L; the internal form is the integer, or the index of the token
+##	in the list.
 proc get/choice {min max l a} {
   global cmdr
   set x "custom"
@@ -65,8 +102,10 @@ proc set/choice {min max l a v} {
   set cmdr($a) $v
 }
 
+## seed -- a galaxy seed; any valid galaxy spec is permitted as the
+##	presentation form.
 proc get/seed {a} { global cmdr; return $cmdr($a) }
-proc dump/seed {a} { global cmdr; return $cmdr($a) }
+dump-like-get seed
 proc set/seed {a v} {
   global cmdr
   set s [parse-galaxy-spec $v]
@@ -74,9 +113,12 @@ proc set/seed {a v} {
   destructure [list . cmdr($a)] $s
 }
 
+## world -- a planet identifier; on input, any planet spec is permitted
+##	(relative to the commander's established galaxy), and on output a
+##	summary description is produced.
 proc get/world {a} {
   global cmdr gov eco
-  set ww [worldinfo $cmdr(gal-seed)]
+  set ww [elite-galaxylist $cmdr(gal-seed)]
   set s [nearest-planet $ww \
       [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]]
   elite-worldinfo p $s
@@ -90,7 +132,7 @@ proc dump/world {a} {
 }
 proc set/world {a v} {
   global cmdr
-  set ww [worldinfo $cmdr(gal-seed)]
+  set ww [elite-galaxylist $cmdr(gal-seed)]
   set s [parse-planet-spec $cmdr(gal-seed) $v]
   if {[string equal $s ""]} { error "bad planet spec `$v'" }
   if {![in-galaxy-p $cmdr(gal-seed) $s]} {
@@ -107,27 +149,36 @@ proc set/world {a v} {
   set cmdr(world-y) [expr {$p(y)/2}]
 }
 
+## bool DFL -- internal form is either zero or DFL; external form is one of a
+##	number of standard boolean tokens.
 proc get/bool {dfl a} {
   global cmdr
   if {$cmdr($a)} { return "yes" } else { return "no" }
 }
-proc dump/bool {dfl a} {
-  global cmdr
-  if {$cmdr($a)} { return "yes" } else { return "no" }
-}  
+dump-like-get bool
 proc set/bool {dfl a v} {
   global cmdr
   switch -- [string tolower $v] {
-    "y" - "yes" - "true" - "on" { set v 1 }
-    "n" - "no" - "false" - "off" { set v 0 }
+    "y" - "yes" - "true" - "on" - "t" { set v 1 }
+    "n" - "no" - "false" - "off" - "nil" { set v 0 }
   }
   if {$v} { set cmdr($a) $dfl } else { set cmdr($a) 0 }
 }
 
+## comment -- a pseudo-type for discarding commnts in input files.
 proc set/comment {a v} { }
 
+###--------------------------------------------------------------------------
+### Attribute table.
+
+### The `attr' array maps commander attribute names to TYPE [PARAM ...]
+### lists; the `attrs' list contains the names in a canonical order.
 set attrs {}
+
+## Comment magic.
 set attr(\#) { comment }
+
+## Basic attributes.
 foreach {a type} {
   mission		{ int 0 255 }
   score			{ choice 0 65535 {
@@ -136,6 +187,8 @@ foreach {a type} {
     "elite" 6400
   } }
   credits		{ tenth 0 429496729.5 }
+  legal-status		{ choice 0 255
+			  { "clean" 0 "offender" 1 "fugitive" 50 } }
   cargo			{ int 4 255 }
   gal-number		{ int 1 8 }
   gal-seed		{ seed }
@@ -148,6 +201,8 @@ foreach {a type} {
   set attr($a) $type
   lappend attrs $a
 }
+
+## Lasers.
 foreach l {front rear left right} {
   set attr($l-laser) {
     choice 0 255
@@ -155,12 +210,16 @@ foreach l {front rear left right} {
   }
   lappend attrs $l-laser
 }
+
+## Standard boolean properties.
 foreach i {
   ecm fuel-scoop energy-bomb escape-pod docking-computer gal-hyperdrive
 } {
   set attr($i) { bool 255 }
   lappend attrs $i
 }
+
+## Station and hold produce.
 foreach l {station hold} {
   foreach {t p} $products {
     set attr($l-$t) { int 0 255 }
@@ -168,27 +227,72 @@ foreach l {station hold} {
   }
 }
 
+###--------------------------------------------------------------------------
+### Main program.
+
+jameson cmdr
+
+## Parse the command-line.
+if {[llength $argv] < 1} {
+  puts stderr "usage: $argv0 \[-OPTION | ATTR | ATTR=VALUE\] ..."
+  exit 1
+}
+
+proc show-attrs {pat} {
+  ## Show the attributes whose names match the glob pattern PAT.  Return the
+  ## number of matches.
+
+  global attr attrs
+  set n 0
+  foreach a $attrs {
+    if {[string match $pat $a]} {
+      puts [format "%-20s %s" $a [eval \
+	  get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
+      incr n
+    }
+  }
+  return $n
+}
+
+proc load-file {file} {
+  ## Load FILE as a commander.
+
+  global argv0 cmdr
+  if {[catch { elite-unpackcmdr cmdr [read-file $file] } err]} {
+    puts stderr "$argv0: couldn't read `$file': $err"
+    exit 1
+  }
+}
+
 set acted 0
 for {set i 0} {$i < [llength $argv]} {incr i} {
   set a [lindex $argv $i]
   switch -regexp -- $a {
-    "^-reset$" { jameson cmdr }
+
+    "^-reset$" {
+      ## Reset the commander back to Jameson.
+
+      jameson cmdr
+    }
+
     "^-show$" {
-      foreach a $attrs {
-	puts [format "%-20s %s" $a [eval \
-	    get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
-      }
+      ## Produce a human-readable description of the commander.
+
+      show-attrs "*"
       set acted 1
     }
+
     "^-load$" {
+      ## Load a commander file.
+
       incr i
       set a [lindex $argv $i]
-      if {[catch { elite-unpackcmdr cmdr [read-file $a] } err]} {
-	puts stderr "$argv0: couldn't read `$a': $err"
-	exit 1
-      }
+      load-file $a
     }
+
     "^-save$" {
+      ## Write the commander to a file.
+
       incr i
       set a [lindex $argv $i]
       if {[catch { write-file $a [elite-packcmdr cmdr] } err]} {
@@ -197,7 +301,10 @@ for {set i 0} {$i < [llength $argv]} {incr i} {
       }
       set acted 1
     }
+
     "^-dump$" {
+      ## Dump a machine-readable textual description of the commander.
+
       puts "# {Elite commander dump}"
       puts ""
       foreach a $attrs {
@@ -206,7 +313,10 @@ for {set i 0} {$i < [llength $argv]} {incr i} {
       }
       set acted 1
     }
+
     "^-read$" {
+      ## Read back a description produced by `-dump'.
+
       incr i
       set a [lindex $argv $i]
       if {[catch {
@@ -221,11 +331,17 @@ for {set i 0} {$i < [llength $argv]} {incr i} {
 	exit 1
       }
     }
+
     "^-" {
+      ## An unknown option.
+
       puts stderr "$argv0: unknown option `$a'"
       exit 1
     }
+
     "^[a-z][a-z-]*=" {
+      ## An assignment ATTR=VALUE.
+
       regexp {^([a-z][a-z-]*)=(.*)$} $a . a v
       if {![info exists attr($a)]} {
 	puts stderr "$argv0: no such attribute `$a'"
@@ -238,26 +354,23 @@ for {set i 0} {$i < [llength $argv]} {incr i} {
 	exit 1
       }
     }
-    "^[a-z][a-z-]*$" {
-      if {![info exists attr($a)]} {
-	puts stderr "$argv0: no such attribute `$a'"
-	exit 1
-      }
-      puts [format "%-20s %s" $a [eval \
-	  get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
-      set acted 1
-    }
+
     default {
-      if {[catch { elite-unpackcmdr cmdr [read-file $a] } err]} {
-	puts stderr "$argv0: couldn't read `$a': $err"
-	exit 1
+      ## If the argument matches any attribute names, then print the matching
+      ## attributes; otherwise load the named file.
+
+      if {[show-attrs $a]} {
+	set acted 1
+      } else {
+	load-file $a
       }
     }
   }
 }
+
+## If we didn't do anything, write out a description of the file.
 if {!$acted} {
-  foreach a $attrs {
-    puts [format "%-20s %s" $a [eval \
-	get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
-  }
+  show-attrs "*"
 }
+
+###----- That's all, folks --------------------------------------------------