X-Git-Url: https://git.distorted.org.uk/~mdw/rocl/blobdiff_plain/1304202ad2001c85d3eae3a37c51e001794c24c8..e93bc0bd3227e7274d5e16cb97b1df04d41acf40:/elite.tcl

diff --git a/elite.tcl b/elite.tcl
index f353a8b..fa81e4c 100644
--- a/elite.tcl
+++ b/elite.tcl
@@ -1,4 +1,6 @@
 #! /usr/bin/tclsh
+#
+# $Id: elite.tcl,v 1.5 2003/03/04 10:26:47 mdw Exp $
 
 package require "elite-bits" "1.0.0"
 
@@ -33,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"
@@ -126,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
@@ -266,7 +306,7 @@ proc weight-hops {from to} {
 proc weight-fuel {from to} {
   elite-worldinfo f $from
   elite-worldinfo t $to
-  return [world-distance $f(x) $f(y) $t(x) $t(y)]
+  return [expr {[world-distance $f(x) $f(y) $t(x) $t(y)]/10.0}]
 }
 
 # --- weight-safety A B ---
@@ -395,11 +435,49 @@ proc in-galaxy-p {g pp} {
 proc world-summary {s} {
   global eco gov
   elite-worldinfo p $s
-  return [format "%-12s %4d %4d %-11s %-10s %2d %s" \
+  return [format "%-8s %4d %4d %-11s %-10s %2d %s" \
       $p(name) $p(x) $p(y) \
       $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"