X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/rocl/blobdiff_plain/b130b8f56dda8528a9cc18e86f825f1f4283cfbc..7f50b5a80358ff9544ad3b965ed88dcf41d252a4:/elite.tcl diff --git a/elite.tcl b/elite.tcl index 6375d83..e652eff 100644 --- 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"