Whoops.

[rocl] / elite.tcl

diff --git a/elite.tcl b/elite.tcl
index 6375d83746a75374e5b2397bb02b2863d2973a1e..e652eff272cb085f9954a7bb183929b8b1458398 100644 (file)
--- a/elite.tcl
+++ b/elite.tcl
@@ -1,6 +1,6 @@
 #! /usr/bin/tclsh
 #
-# $Id: elite.tcl,v 1.2 2003/02/25 00:25:38 mdw Exp $
+# $Id: elite.tcl,v 1.4 2003/03/01 17:47:07 mdw Exp $
 
 package require "elite-bits" "1.0.0"
 
@@ -35,8 +35,8 @@ tab gov \
     communist confed democracy corp-state
 
 tab eco \
-    rich-ind ave-ind poor-ind mainly-ind \
-    mainly-agri rich-agri ave-agri poor-agri
+    rich-ind avg-ind poor-ind mainly-ind \
+    mainly-agri rich-agri avg-agri poor-agri
 
 set products {
   food         "Food"
@@ -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"