From: mdw <mdw>
Date: Sat, 1 Mar 2003 17:47:07 +0000 (+0000)
Subject: New elite-cmdr tool.
X-Git-Tag: 1.0.2~5
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/rocl/commitdiff_plain/1ded87baa037e0d9a72ae58b86bdf34244464f01

New elite-cmdr tool.
---

diff --git a/Makefile b/Makefile
index e166e6a..90d0ca0 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
 # Makefile for RIGHT ON COMMAND-LINE
 #
-# $Id: Makefile,v 1.3 2003/02/26 01:07:39 mdw Exp $
+# $Id: Makefile,v 1.4 2003/03/01 17:47:07 mdw Exp $
 
 #----- Configuration stuff --------------------------------------------------
 
@@ -32,7 +32,7 @@ VERSION = 1.0.1
 
 TCLSCRIPTS = \
 	elite-editor elite-pairs elite-path elite-find elite-map \
-	elite-prices elite-describe elite-reach
+	elite-prices elite-describe elite-reach elite-cmdr
 
 all: elite.so pkgIndex.tcl
 
diff --git a/README b/README
index 8d09408..14659d3 100644
--- a/README
+++ b/README
@@ -226,6 +226,120 @@ RIGHT ON COMMAND-LINE
 			as the variables described above.
 
 
+  elite-cmdr [FILE] [-OPTION | ATTR | ATTR=VALUE | FILE] ...
+
+	A command-line Elite commander editor and viewer.  With a single
+	argument, reads a commander file and displays its contents as a
+	human readable table.  The arguments may be special options,
+	attribute names, attribute assignments, or filenames.
+
+	The special options are:
+
+	-show		Write the commander data to standard output as a
+			human-readable table.  This is the default if no
+			other output action is requested.
+
+	-load FILE	Read the commander file named FILE.
+
+	-save FILE	Write the modified commander data to FILE.
+
+	-reset		Reset the commander to the default `JAMESON'
+			settings.
+
+	-dump		Write the commander data to standard output in
+			the form of a script which can be read back by
+			the `-read' option.
+
+	-read FILE	Read attribute/value pairs from FILE, and modify
+			the commander accordingly.
+
+	An attribute name on its own is a request to print the current
+	value of that attribute.  An assignment ATTR=VALUE makes ATTR
+	have the requested VALUE.
+
+	The attributes, their meanings, and the acceptable values are as
+	follows:
+
+	mission		The commander's current mission.  (0 is no
+			mission; 1 is searching for the Constrictor; 2
+			is killed the Constrictor; 3 is waiting for the
+			second mission; 4 is heading for Ceerdi; 5 is
+			heading for Birera; and 6 is all missions
+			completed.)  Must be an integer between 0 and
+			255.
+
+	score		Current number of kills.  Must be an integer
+			between 0 a 65535, or one of the strings
+			`harmless', `mostly-harmless', `poor',
+			`average', `above-average', `competent',
+			`dangerous', `deadly', or `elite'.
+
+	credits		Number of credits.  Must be between 0 and
+			429496729.5.
+
+	cargo		Size of cargo bay.  Must be between 4 and 255.
+
+	gal-number	Number of the current galaxy.  Note that this
+			doesn't affect which galaxy the commander is
+			actually in -- set gal-seed for that.  Must be
+			between 1 and 8.
+
+	gal-seed	Which galaxy the commander is in.  May be any
+			galaxy-spec.
+
+	world		Which world the commander is docked at.  May be
+			any planet-spec describing a world in the
+			correct galaxy.  (Note that, since the commander
+			file actually stores the location as an x, y
+			pair and chooses the closest world to those
+			coordinates, and there are coincident pairs of
+			worlds, it is not possible to have a commander
+			start at some worlds.)
+
+	market-fluc	The market fluctuation byte.  Affects prices at
+			the space station.  Must be an integer between 0
+			and 255.
+
+	fuel		Amount of fuel.  Must be between 0 and 25.5.
+
+	energy-unit	Strength of the ship's energy unit.  May be an
+			integer between 0 (none) and 255 (scary cheat)
+			or one of the strings `none', `standard', or
+			`naval'.
+
+	front-laser, rear-laser, left-laser, light-laser
+			Strength of appropriate laser.  May be an
+			integer between 0 (none) and 255 (scary cheat)
+			or one of the strings `none', `pulse', `beam',
+			`mining', or `military'.
+
+	ecm, fuel-scroop, enery-bomb, escape-pod,
+	docking-computer, gal-hyperdrive
+			Whether the ship has various bits of equipment.
+			One of `yes', `true', or `on' for yes, or `no',
+			`false' or `off' for no.
+
+	missiles	Number of missiles carried.  Must be an integer
+			between 0 and 255.
+
+	hold-ITEM, station-ITEM
+			Quantity of some item in the ship's hold, or at
+			the station.  Must be an integer between 0 and
+			255.  ITEM must be one of `food', `textiles',
+			`radioactives', `slaves', `liquor-wines',
+			`luxuries', `narcotics', `computers',
+			`machinery', `alloys', `firearms', `furs',
+			`minerals', `gold', `platinum', `gem-stones', or
+			`alien-items'.
+
+	#		A special attribute which is never printed.  Its
+			value is ignored.  This may be used to insert
+			comments in script files.
+
+	Anything else is assumed to be a filename, and loaded as for the
+	`-load' option.
+
+
   elite-prices [-g GALAXY] [-s SORT] [FROM TO]
 
 	Shows minimum, average and maximum profit (in that order, in
@@ -336,7 +450,7 @@ RIGHT ON COMMAND-LINE
 	unrewarding) or pirates (risky and tedious), and start trading
 	food and other cheap items.
 
-$Id: README,v 1.3 2003/02/26 01:12:30 mdw Exp $
+$Id: README,v 1.4 2003/03/01 17:47:07 mdw Exp $
 
 Local variables:
 mode: text
diff --git a/elite-cmdr b/elite-cmdr
new file mode 100755
index 0000000..4c101df
--- /dev/null
+++ b/elite-cmdr
@@ -0,0 +1,255 @@
+#! /usr/bin/tclsh
+
+package require "elite" "1.0.0"
+
+if {[llength $argv] < 1} {
+  puts stderr "usage: $argv0 \[-OPTION | ATTR | ATTR=VALUE\] ..."
+  exit 1
+}
+jameson cmdr
+
+proc get/string {a} { global cmdr; return $cmdr($a) }
+proc dump/string {a} { global cmdr; return $cmdr($a) }
+proc set/string {a v} { global cmdr; set cmdr($a) $v }
+
+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}]]
+}
+proc set/int {min max a v} {
+  global cmdr
+  if {$v < $min || $v > $max} { error "value out of range" }
+  set cmdr($a) $v
+}
+
+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}]]
+}
+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)}]
+}
+
+proc get/choice {min max l a} {
+  global cmdr
+  set x "custom"
+  foreach {t v} $l { if {$cmdr($a) >= $v} { set x $t } }
+  return [format "%d (%s)" [expr {$cmdr($a) + 0}] $x]
+}
+proc dump/choice {min max l a} {
+  global cmdr
+  return [format "%d" [expr {$cmdr($a) + 0}]]
+}
+proc set/choice {min max l a v} {
+  global cmdr
+  if {[regexp {^\d+$} $v]} {
+    if {$v < $min || $v > $max} { error "value out of range" }
+  } else {
+    set x $v
+    set v -1
+    foreach {t vv} $l {
+      if {[string equal -nocase $x $t]} { set v $vv; break }
+    }
+    if {$v == -1} { error "unknown tag `$x'" }
+  }
+  set cmdr($a) $v
+}
+
+proc get/seed {a} { global cmdr; return $cmdr($a) }
+proc dump/seed {a} { global cmdr; return $cmdr($a) }
+proc set/seed {a v} {
+  global cmdr
+  set s [parse-galaxy-spec $v]
+  if {[string equal $s ""]} { error "bad galaxy spec `$v'" }
+  destructure [list . cmdr($a)] $s
+}
+
+proc get/world {a} {
+  global cmdr gov eco
+  set ww [worldinfo $cmdr(gal-seed)]
+  set s [nearest-planet $ww \
+      [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]]
+  elite-worldinfo p $s
+  return [list $p(name) $p(x) $p(y) $eco($p(economy)) $gov($p(government)) \
+      $p(techlevel)]
+}
+proc dump/world {a} {
+  global cmdr
+  return [format "%d, %d" \
+      [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]]
+}
+proc set/world {a v} {
+  global cmdr
+  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]} {
+    error "planet `[worldname $s]' not in galaxy $cmdr(gal-seed)"
+  }
+  elite-worldinfo p $s
+  set cmdr(world-x) [expr {$p(x)/4}]
+  set cmdr(world-y) [expr {$p(y)/2}]
+}
+
+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" }
+}  
+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 }
+  }
+  if {$v} { set cmdr($a) $dfl } else { set cmdr($a) 0 }
+}
+
+proc set/comment {a v} { }
+
+set attrs {}
+set attr(\#) { comment }
+foreach {a type} {
+  mission		{ int 0 255 }
+  score			{ choice 0 65535 {
+    "harmless" 0 "mostly-harmless" 8 "poor" 16 "average" 32
+    "above-average" 64 "competent" 128 "dangerous" 512 "deadly" 2560
+    "elite" 6400
+  } }
+  credits		{ tenth 0 429496729.5 }
+  cargo			{ int 4 255 }
+  gal-number		{ int 1 8 }
+  gal-seed		{ seed }
+  world			{ world }
+  market-fluc		{ int 0 255 }
+  missiles		{ int 0 255 }
+  fuel			{ tenth 0 25.5 }
+  energy-unit		{ choice 0 255 { "none" 0 "standard" 1 "naval" 2 } }
+} {
+  set attr($a) $type
+  lappend attrs $a
+}
+foreach l {front rear left right} {
+  set attr($l-laser) {
+    choice 0 255
+    { "none" 0 "pulse" 0x0f "mining" 0x32 "beam" 0x8f "military" 0x97 }
+  }
+  lappend attrs $l-laser
+}
+foreach i {
+  ecm fuel-scoop energy-bomb escape-pod docking-computer gal-hyperdrive
+} {
+  set attr($i) { bool 255 }
+  lappend attrs $i
+}
+foreach l {station hold} {
+  foreach {t p} $products {
+    set attr($l-$t) { int 0 255 }
+    lappend attrs $l-$t
+  }
+}
+
+set acted 0
+for {set i 0} {$i < [llength $argv]} {incr i} {
+  set a [lindex $argv $i]
+  switch -regexp -- $a {
+    "^-reset$" { jameson cmdr }
+    "^-show$" {
+      foreach a $attrs {
+	puts [format "%-20s %s" $a [eval \
+	    get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
+      }
+      set acted 1
+    }
+    "^-load$" {
+      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
+      }
+    }
+    "^-save$" {
+      incr i
+      set a [lindex $argv $i]
+      if {[catch { write-file $a [elite-packcmdr cmdr] } err]} {
+	puts stderr "$argv0: couldn't write `$a': $err"
+	exit 1
+      }
+      set acted 1
+    }
+    "^-dump$" {
+      puts "# {Elite commander dump}"
+      puts ""
+      foreach a $attrs {
+	puts [list $a [eval \
+	    dump/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
+      }
+      set acted 1
+    }
+    "^-read$" {
+      incr i
+      set a [lindex $argv $i]
+      if {[catch {
+	foreach {a v} [read-file $a auto] {
+	  if {![info exists attr($a)]} {
+	    error "no such attribute `$a'"
+	  }
+	  eval set/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a $v]
+	}
+      } err]} {
+	puts stderr "$argv0: error in script: $err"
+	exit 1
+      }
+    }
+    "^-" {
+      puts stderr "$argv0: unknown option `$a'"
+      exit 1
+    }
+    "^[a-z][a-z-]*=" {
+      regexp {^([a-z][a-z-]*)=(.*)$} $a . a v
+      if {![info exists attr($a)]} {
+	puts stderr "$argv0: no such attribute `$a'"
+	exit 1
+      }
+      if {[catch {
+	eval set/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a $v]
+      } err]} {
+	puts stderr "$argv0: error setting `$a': $err"
+	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]]]
+    }
+    default {
+      if {[catch { elite-unpackcmdr cmdr [read-file $a] } err]} {
+	puts stderr "$argv0: couldn't read `$a': $err"
+	exit 1
+      }
+    }
+  }
+}
+if {!$acted} {
+  foreach a $attrs {
+    puts [format "%-20s %s" $a [eval \
+	get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
+  }
+}
diff --git a/elite-editor b/elite-editor
index 8777e13..631e30d 100755
--- a/elite-editor
+++ b/elite-editor
@@ -1,6 +1,6 @@
 #! /usr/bin/wish
 #
-# $Id: elite-editor,v 1.4 2003/02/26 00:02:15 mdw Exp $
+# $Id: elite-editor,v 1.5 2003/03/01 17:47:07 mdw Exp $
 
 package require "elite" "1.0.0"
 
@@ -31,33 +31,6 @@ proc debug-array {name} {
   array donesearch a $s
 }
 
-proc write-file {name contents {trans binary}} {
-  if {[file exists $name]} {
-    if {[set rc [catch { file copy -force $name "$name.old" } err]]} {
-      return -code $rc $err
-    }
-  }
-  if {[set rc [catch {
-    set f [open $name w]
-    fconfigure $f -translation $trans
-    puts -nonewline $f $contents
-    close $f
-  } err]]} {
-    catch { close $f }
-    catch { file rename -force "$name.old" $name }
-    return -code $rc $err
-  }
-  return ""
-}
-
-proc read-file {name {trans binary}} {
-  set f [open $name]
-  fconfigure $f -translation $trans
-  set c [read $f]
-  close $f
-  return $c
-}
-
 proc get-line-done {tl cmd} {
   if {![uplevel \#0 [concat $cmd [$tl.entry get]]]} {
     destroy $tl
@@ -956,7 +929,7 @@ proc cmdr-open {seq} {
     score		"Rating"		{ dropbox 65535\
     						  "Harmless"		0 \
 						  "Mostly harmless"     8 \
-						  "Poor"		6 \
+						  "Poor"	       16 \
 						  "Average"            32 \
 						  "Above average"      64 \
 						  "Competent"         128 \
@@ -1180,38 +1153,10 @@ proc cmdr-save {seq} {
 }
 
 proc cmdr-new {} {
-  global seq galaxy1 products
+  global seq
   incr seq
   upvar \#0 cmdr-$seq cmdr
-  array set cmdr {
-    mission           0
-    credits        1000
-    fuel             70
-    gal-number        1
-    front-laser    0x0f
-    rear-laser        0
-    left-laser        0
-    right-laser       0
-    cargo            20
-    missiles          3
-    legal-status      0
-    score             0
-    market-fluc       0
-  }
-  set cmdr(gal-seed) $galaxy1
-  foreach i {
-    ecm fuel-scoop energy-bomb energy-unit docking-computer
-    gal-hyperdrive escape-pod
-  } { set cmdr($i) 0 }
-  elite-worldinfo lave [find-world $galaxy1 "Lave"]
-  set cmdr(world-x) [expr {$lave(x)/4}]
-  set cmdr(world-y) [expr {$lave(y)/2}]
-  elite-market mkt $lave(seed) 0
-  foreach {t n} $products {
-    destructure [list . cmdr(station-$t)] $mkt($t)
-    set cmdr(hold-$t) 0
-  }
-  set cmdr(station-alien-items) 0
+  jameson cmdr
   cmdr-open $seq
 }
 
diff --git a/elite.tcl b/elite.tcl
index 4f63e0c..e652eff 100644
--- a/elite.tcl
+++ b/elite.tcl
@@ -1,6 +1,6 @@
 #! /usr/bin/tclsh
 #
-# $Id: elite.tcl,v 1.3 2003/02/26 01:13:22 mdw Exp $
+# $Id: elite.tcl,v 1.4 2003/03/01 17:47:07 mdw Exp $
 
 package require "elite-bits" "1.0.0"
 
@@ -128,6 +128,44 @@ proc destructure {pp xx} {
   }
 }
 
+# --- write-file NAME CONTENTS [TRANS] ---
+#
+# Write file NAME, storing CONTENTS translated according to TRANS (default
+# `binary'.  The write is safe against errors -- we don't destroy the old
+# data until the file is written.
+
+proc write-file {name contents {trans binary}} {
+  if {[file exists $name]} {
+    if {[set rc [catch { file copy -force $name "$name.old" } err]]} {
+      return -code $rc $err
+    }
+  }
+  if {[set rc [catch {
+    set f [open $name w]
+    fconfigure $f -translation $trans
+    puts -nonewline $f $contents
+    close $f
+  } err]]} {
+    catch { close $f }
+    catch { file rename -force "$name.old" $name }
+    return -code $rc $err
+  }
+  return ""
+}
+
+# --- read-file NAME [TRANS] ---
+#
+# Read the contents of the file NAME, translating it according to TRANS
+# (default `binary').
+
+proc read-file {name {trans binary}} {
+  set f [open $name]
+  fconfigure $f -translation $trans
+  set c [read $f]
+  close $f
+  return $c
+}
+
 # --- worldinfo GAL ---
 #
 # Return a list describing the worlds in galaxy GAL (a seed).  The list
@@ -402,6 +440,44 @@ proc world-summary {s} {
       $eco($p(economy)) $gov($p(government)) $p(techlevel) $p(seed)]
 }
 
+# --- jameson ARR ---
+#
+# Fill ARR with the information about commander JAMESON.
+
+proc jameson {arr} {
+  global galaxy1 products
+  upvar 1 $arr cmdr
+  array set cmdr {
+    mission           0
+    credits        1000
+    fuel             70
+    gal-number        1
+    front-laser    0x0f
+    rear-laser        0
+    left-laser        0
+    right-laser       0
+    cargo            20
+    missiles          3
+    legal-status      0
+    score             0
+    market-fluc       0
+  }
+  set cmdr(gal-seed) $galaxy1
+  foreach i {
+    ecm fuel-scoop energy-bomb energy-unit docking-computer
+    gal-hyperdrive escape-pod
+  } { set cmdr($i) 0 }
+  elite-worldinfo lave [find-world $galaxy1 "Lave"]
+  set cmdr(world-x) [expr {$lave(x)/4}]
+  set cmdr(world-y) [expr {$lave(y)/2}]
+  elite-market mkt $lave(seed) 0
+  foreach {t n} $products {
+    destructure [list . cmdr(station-$t)] $mkt($t)
+    set cmdr(hold-$t) 0
+  }
+  set cmdr(station-alien-items) 0
+}
+
 #----- That's all, folks ----------------------------------------------------
 
 package provide "elite" "1.0.0"