X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/rocl/blobdiff_plain/83b4563be47499817006894bf56ac5aeedd98c36..82b418fa94b2e7ac3cd55712f3a8e36058bd123f:/elite.tcl

diff --git a/elite.tcl b/elite.tcl
index 4f63e0c..127d72c 100644
--- a/elite.tcl
+++ b/elite.tcl
@@ -1,8 +1,8 @@
 #! /usr/bin/tclsh
 #
-# $Id: elite.tcl,v 1.3 2003/02/26 01:13:22 mdw Exp $
+# $Id: elite.tcl,v 1.6 2003/03/07 00:44:57 mdw Exp $
 
-package require "elite-bits" "1.0.0"
+package require "elite-bits" "1.0.1"
 
 set galaxy1 "4a5a480253b7"		;# Seed for standard galaxy 1
 
@@ -128,28 +128,42 @@ proc destructure {pp xx} {
   }
 }
 
-# --- worldinfo GAL ---
+# --- write-file NAME CONTENTS [TRANS] ---
 #
-# Return a list describing the worlds in galaxy GAL (a seed).  The list
-# contains a group of three elements for each world: the seed, x and y
-# coordinates (in decilightyears).
-
-proc worldinfo {g} {
-  foreach-world $g p {
-    lappend i $p(seed) $p(x) $p(y)
+# 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 $i
+  return ""
 }
 
-# --- world-distance X Y XX YY ---
+# --- read-file NAME [TRANS] ---
 #
-# Computes the correct game distance in decilightyears between two worlds,
-# one at X, Y and the other at XX, YY.
-
-proc world-distance {x y xx yy} {
-  set dx [expr {abs($x - $xx)/4}]
-  set dy [expr {abs($y - $yy)/4}]
-  return [expr {4 * floor(sqrt($dx * $dx + $dy * $dy))}]
+# 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
 }
 
 # --- nearest-planet WW X Y ---
@@ -175,29 +189,6 @@ proc nearest-planet {ww x y} {
   return $p
 }
 
-# --- adjacency WW ADJ [D] ---
-#
-# Fill in the array ADJ with the adjacency table for the worlds listed in the
-# worldinfo list WW.  That is, for each world seed S, ADJ(S) is set to a
-# worldinfo list containing the worlds within D (default 70) decilightyears
-# of S.
-
-proc adjacency {p adj {d 70}} {
-  upvar 1 $adj a
-  array set a {}
-  foreach {s x y} $p {
-    set done($s) 1
-    lappend a($s)
-    foreach {ss xx yy} $p {
-      if {[info exists done($ss)]} { continue }
-      if {abs($x - $xx) > $d + 10 || abs($y - $yy) > $d + 10 ||
-          [world-distance $x $y $xx $yy] > $d} { continue }
-      lappend a($s) $ss $xx $yy
-      lappend a($ss) $s $x $y
-    }
-  }
-}
-
 # --- worldname W ---
 #
 # Returns the name of the world with seed W.
@@ -268,7 +259,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 [elite-distance $f(x) $f(y) $t(x) $t(y)]
 }
 
 # --- weight-safety A B ---
@@ -372,10 +363,13 @@ proc parse-planet-spec {g p} {
   }
   if {[regexp {^(0x[0-9a-fA-F]+|[0-9]+),\s*(0x[0-9a-fA-F]+|[0-9]+)$} \
       $p . x y]} {
-    return [nearest-planet [worldinfo $g] $x $y]
+    return [nearest-planet [elite-galaxylist $g] $x $y]
+  }
+  if {[regexp {^([^/]*)(?:/([1-9]\d*))?$} $p . p i]} {
+    if {[string equal $i ""]} { set i 1 }
+    set l [find-world $g $p]
+    if {$i <= [llength $l]} { return [lindex $l [expr {$i - 1}]] }
   }
-  set l [find-world $g $p]
-  if {[llength $l]} { return [lindex $l 0] }
   return {}
 }
 
@@ -394,14 +388,54 @@ proc in-galaxy-p {g pp} {
 #
 # Return a one-line summary string for PLANET.
 
-proc world-summary {s} {
+proc world-summary {s {ind 0} {spc 0}} {
   global eco gov
   elite-worldinfo p $s
-  return [format "%-12s %4d %4d %-11s %-10s %2d %s" \
-      $p(name) $p(x) $p(y) \
+  set is [string repeat " " $ind]
+  set ss [string repeat " " $spc]
+  return [format "%s%-8s%s %4d %4d %-11s %-10s %2d %s" \
+      $is $p(name) $ss $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"
+package provide "elite" "1.0.1"