y in decilightyears from galaxy top
government as integer: 0 .. 7 are anarchy .. corp-state
economy as integer: 0 .. 7 are rich-ind .. poor-agri
- techlevel the tech level,
+ techlevel the tech level
population in 100 million
productivity in M Cr
radius in km
mission mission status code
world-x in dly from left
world-y in dly from top
- gal-seed
+ gal-seed
credits in tenths of a credit
fuel in tenths of a lightyear
gal-number 1 .. 8 seem sensible
station-PRODUCT quantity of product at station
ecm just true or false
- fuel-scoop
+ fuel-scoop
energy-bomb
energy-unit
docking-computer
escape-pod
missiles number; 0 .. 4 are usual
- legal-status 0 = clean; 1 .. 49 = offender;
+ legal-status 0 = clean; 1 .. 49 = offender;
50+ = fugitive
score number
-cool FACTOR Cooling factor. [1.001]
-dead COUNT Give up after COUNT cycles. [200]
-inner COUNT Do COUNT loops for each cooling cycle.
- [10000]
+ [10000]
-temp TEMP Start at this temperature. [unhelpful]
# --- Compiling and linking ---
CC = gcc
-INCLUDES =
+INCLUDES =
CFLAGS = \
-O2 -g -pedantic -Wall -funroll-loops -fomit-frame-pointer \
$(INCLUDES)
#----- Main machinery -------------------------------------------------------
#
-# Shouldn't need to fiddle with thiis stuff.
+# Shouldn't need to fiddle with this stuff.
PACKAGE = rocl
VERSION = 1.1.5
$(LD) $(LDFLAGS) elite.o -o elite.so
vec.so: vec.o
$(LD) $(LDFLAGS) vec.o -o vec.so
-graph.so: graph.o
- $(LD) $(LDFLAGS) graph.o -o graph.so
+graph.so: graph.o vec.so
+ $(LD) $(LDFLAGS) -Wl,-rpath,$(pkglibdir) graph.o vec.so -o graph.so
graph.o vec.o: vec.h
.SUFFIXES: .c .o
.c.o:; $(CC) -c $(CFLAGS) -o $@ $<
pkgIndex.tcl: $(PKGFILES)
- echo "pkg_mkIndex -verbose -direct -load Vec . $(PKGFILES) " | tclsh
+ LD_LIBRARY_PATH=$$(pwd) \
+ echo "pkg_mkIndex -verbose -direct -load Vec . $(PKGFILES) " | \
+ tclsh
install: all
$(INSTALL) -d $(INST)$(bindir) $(INST)$(pkglibdir)
vec.dll vec.dll.a: vec.o vec.def
$(LD) $(LDFLAGS) vec.o vec.def $(LIBS) \
-o vec.dll -Wl,--out-implib,vec.dll.a
-graph.dll: graph.o graph.def vec.dll.a
+graph.dll: graph.o graph.def vec.dll.a
$(LD) $(LDFLAGS) graph.o graph.def $(LIBS) vec.dll.a -o graph.dll
graph.o vec.o: vec.h
A `galaxy-spec' is
* a number, between 1 and 8, for one of the standard eight
- galaxies;
+ galaxies;
* a `galaxy seed' of 12 hex digits (a 48-bit value), for any
arbitrary galaxy; or
program slower) and where the shortest path is more than RATIO
times the distance in each GALAXY specified -- by default the
eight standard ones.
-
+
3. The graphical editor
rocl (1.1.5) experimental; urgency=low
* Add elite-tantalus.
-
+
-- Mark Wooding <mdw@nsict.org> Wed, 22 Sep 2004 23:43:29 +0100
rocl (1.1.4) experimental; urgency=low
some C extensions, for analysing the Elite universe and editing
original BBC version commander files, as also used by Elite: The New
Kind by Christian Pinder.
-
d=`pwd`; cd ..; dpkg-source -i -b $$d/=inst=/=deb=/*
rm -rf =inst=
-.PHONY: binary binary-arch binary-indep clean install source
+.PHONY: binary binary-arch binary-indep clean install source
#! /usr/bin/tclsh
+###
+### Commander file inspector
+###
+### (c) 2003 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This program is free software; you can redistribute it and/or modify
+### it under the terms of the GNU General Public License as published by
+### the Free Software Foundation; either version 2 of the License, or
+### (at your option) any later version.
+###
+### This program is distributed in the hope that it will be useful,
+### but WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+### GNU General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package require "elite" "1.0.1"
-if {[llength $argv] < 1} {
- puts stderr "usage: $argv0 \[-OPTION | ATTR | ATTR=VALUE\] ..."
- exit 1
+###--------------------------------------------------------------------------
+### Various type handlers.
+###
+### We associate a named type and some optional (type-specific) parameters
+### with each attribute in the commander file format. For each TYPE, there
+### are Tcl procedures:
+###
+### get/TYPE [PARAM ...] A -- return presentation form of the attribute A
+### dump/TYPE [PARAM ...] A -- return an external form of the attribute A
+### set/TYPE [PARAM ...] A V -- convert V from presentation form and store
+### as the attribute A
+
+proc dump-like-get {type} {
+ ## Define dump/TYPE as a synonym for get/TYPE.
+
+ proc dump/$type {args} [list uplevel 1 get/$type \$args]
}
-jameson cmdr
+## string -- just a plain unconverted string.
proc get/string {a} { global cmdr; return $cmdr($a) }
-proc dump/string {a} { global cmdr; return $cmdr($a) }
+dump-like-get string
proc set/string {a v} { global cmdr; set cmdr($a) $v }
+## int MIN MAX -- an integer constrained to lie between the stated
+## (inclusive) bounds.
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}]]
-}
+dump-like-get int
proc set/int {min max a v} {
global cmdr
if {$v < $min || $v > $max} { error "value out of range" }
set cmdr($a) $v
}
+## tenth MIN MAX -- a numerical value constrained to lie between the stated
+## inclusive bounds; the internal format is an integer containing ten times
+## the presentation value.
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}]]
-}
+dump-like-get tenth
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)}]
}
+## choice MIN MAX L -- the presentation form is either an integer between the
+## given inclusive bounds, or a token matching one of the items in the
+## list L; the internal form is the integer, or the index of the token
+## in the list.
proc get/choice {min max l a} {
global cmdr
set x "custom"
set cmdr($a) $v
}
+## seed -- a galaxy seed; any valid galaxy spec is permitted as the
+## presentation form.
proc get/seed {a} { global cmdr; return $cmdr($a) }
-proc dump/seed {a} { global cmdr; return $cmdr($a) }
+dump-like-get seed
proc set/seed {a v} {
global cmdr
set s [parse-galaxy-spec $v]
destructure [list . cmdr($a)] $s
}
+## world -- a planet identifier; on input, any planet spec is permitted
+## (relative to the commander's established galaxy), and on output a
+## summary description is produced.
proc get/world {a} {
global cmdr gov eco
set ww [elite-galaxylist $cmdr(gal-seed)]
set cmdr(world-y) [expr {$p(y)/2}]
}
+## bool DFL -- internal form is either zero or DFL; external form is one of a
+## number of standard boolean tokens.
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" }
-}
+dump-like-get bool
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 }
+ "y" - "yes" - "true" - "on" - "t" { set v 1 }
+ "n" - "no" - "false" - "off" - "nil" { set v 0 }
}
if {$v} { set cmdr($a) $dfl } else { set cmdr($a) 0 }
}
+## comment -- a pseudo-type for discarding commnts in input files.
proc set/comment {a v} { }
+###--------------------------------------------------------------------------
+### Attribute table.
+
+### The `attr' array maps commander attribute names to TYPE [PARAM ...]
+### lists; the `attrs' list contains the names in a canonical order.
set attrs {}
+
+## Comment magic.
set attr(\#) { comment }
+
+## Basic attributes.
foreach {a type} {
mission { int 0 255 }
score { choice 0 65535 {
set attr($a) $type
lappend attrs $a
}
+
+## Lasers.
foreach l {front rear left right} {
set attr($l-laser) {
choice 0 255
}
lappend attrs $l-laser
}
+
+## Standard boolean properties.
foreach i {
ecm fuel-scoop energy-bomb escape-pod docking-computer gal-hyperdrive
} {
set attr($i) { bool 255 }
lappend attrs $i
}
+
+## Station and hold produce.
foreach l {station hold} {
foreach {t p} $products {
set attr($l-$t) { int 0 255 }
}
}
+###--------------------------------------------------------------------------
+### Main program.
+
+jameson cmdr
+
+## Parse the command-line.
+if {[llength $argv] < 1} {
+ puts stderr "usage: $argv0 \[-OPTION | ATTR | ATTR=VALUE\] ..."
+ exit 1
+}
+
+proc show-attrs {pat} {
+ ## Show the attributes whose names match the glob pattern PAT. Return the
+ ## number of matches.
+
+ global attr attrs
+ set n 0
+ foreach a $attrs {
+ if {[string match $pat $a]} {
+ puts [format "%-20s %s" $a [eval \
+ get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
+ incr n
+ }
+ }
+ return $n
+}
+
+proc load-file {file} {
+ ## Load FILE as a commander.
+
+ global argv0 cmdr
+ if {[catch { elite-unpackcmdr cmdr [read-file $file] } err]} {
+ puts stderr "$argv0: couldn't read `$file': $err"
+ exit 1
+ }
+}
+
set acted 0
for {set i 0} {$i < [llength $argv]} {incr i} {
set a [lindex $argv $i]
switch -regexp -- $a {
- "^-reset$" { jameson cmdr }
+
+ "^-reset$" {
+ ## Reset the commander back to Jameson.
+
+ jameson cmdr
+ }
+
"^-show$" {
- foreach a $attrs {
- puts [format "%-20s %s" $a [eval \
- get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
- }
+ ## Produce a human-readable description of the commander.
+
+ show-attrs "*"
set acted 1
}
+
"^-load$" {
+ ## Load a commander file.
+
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
- }
+ load-file $a
}
+
"^-save$" {
+ ## Write the commander to a file.
+
incr i
set a [lindex $argv $i]
if {[catch { write-file $a [elite-packcmdr cmdr] } err]} {
}
set acted 1
}
+
"^-dump$" {
+ ## Dump a machine-readable textual description of the commander.
+
puts "# {Elite commander dump}"
puts ""
foreach a $attrs {
}
set acted 1
}
+
"^-read$" {
+ ## Read back a description produced by `-dump'.
+
incr i
set a [lindex $argv $i]
if {[catch {
exit 1
}
}
+
"^-" {
+ ## An unknown option.
+
puts stderr "$argv0: unknown option `$a'"
exit 1
}
+
"^[a-z][a-z-]*=" {
+ ## An assignment ATTR=VALUE.
+
regexp {^([a-z][a-z-]*)=(.*)$} $a . a v
if {![info exists attr($a)]} {
puts stderr "$argv0: no such attribute `$a'"
exit 1
}
}
+
default {
- set n 0
- foreach aa $attrs {
- if {[string match $a $aa]} {
- incr n
- puts [format "%-20s %s" $aa [eval \
- get/[lindex $attr($aa) 0] \
- [lrange $attr($aa) 1 end] [list $aa]]]
- }
- }
- if {$n} {
+ ## If the argument matches any attribute names, then print the matching
+ ## attributes; otherwise load the named file.
+
+ if {[show-attrs $a]} {
set acted 1
} else {
- if {[catch { elite-unpackcmdr cmdr [read-file $a] } err]} {
- puts stderr "$argv0: couldn't read `$a': $err"
- exit 1
- }
+ load-file $a
}
}
}
}
+
+## If we didn't do anything, write out a description of the file.
if {!$acted} {
- foreach a $attrs {
- puts [format "%-20s %s" $a [eval \
- get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
- }
+ show-attrs "*"
}
+
+###----- That's all, folks --------------------------------------------------
#! /usr/bin/tclsh
-#
-# $Id: elite-describe,v 1.4 2003/03/10 23:38:18 mdw Exp $
+###
+### Describe a particular world
+###
+### (c) 2003 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This program is free software; you can redistribute it and/or modify
+### it under the terms of the GNU General Public License as published by
+### the Free Software Foundation; either version 2 of the License, or
+### (at your option) any later version.
+###
+### This program is distributed in the hope that it will be useful,
+### but WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+### GNU General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package require "elite" "1.0.1"
+###--------------------------------------------------------------------------
+### Support functions.
+
proc describe n {
+ ## Describe the world with seed N.
+
global economy government
+
+ ## Fetch the necessary information.
elite-worldinfo p $n
+
+ ## Format most of the data.
puts "Name: $p(name)"
puts "Seed: $p(seed)"
puts "Position: $p(x), $p(y) LY"
[expr {$p(population)/10.0}] $p(inhabitants)]
puts "Gross productivity: $p(productivity) M Cr"
puts "Radius: $p(radius) km"
+
+ ## Format the world description, word-wrapping as necessary.
puts ""
set ll {}
set l 0
puts $ll
}
+###--------------------------------------------------------------------------
+### Main program.
+
+## Parse the command line and describe the planets indicated.
if {[llength $argv] < 1} {
puts stderr "usage: $argv0 \[-g GALAXY\] PLANET ..."
exit 1
}
}
}
+
+###----- That's all, folks --------------------------------------------------
set tl .map-$seq
global col
switch -exact -- $map(colourby) {
- off {
+ off {
foreach-world $map(galaxy) p {
$tl.map itemconfigure $p(seed) -fill white -outline white
}
}
}
-proc path-to-text {seq} {
+proc path-to-text {seq} {
upvar \#0 map-$seq map
set t {}
foreach n $map(path) {
$tl.text delete 1.0 end
$tl.text insert end [path-to-text $seq]
$tl.text configure -state disabled
-}
+}
proc load-path {seq} {
upvar \#0 map-$seq map
$tl.menu.path entryconfigure $i -state normal
}
show-path $seq
-}
+}
proc show-shortest-path {seq weight} {
upvar \#0 map-$seq map
foreach i {5 6 7 8 9} {
$tl.menu.path entryconfigure $i -state normal
}
-}
+}
proc do-select {seq x y} {
set-selection $seq [find-click $seq $x $y]
}
proc map-set-galaxy {seq ng g} {
- upvar \#0 map-$seq map
+ upvar \#0 map-$seq map
if {[string equal $g $map(galaxy)]} { return }
set map(galaxy-num) $ng
map-set-title $seq
$tl.info.ldest $tl.info.dest \
$tl.info.ldist $tl.info.dist \
-side left -pady 2
-
+
scrollbar $tl.hscr -orient horizontal \
-command [list $tl.map xview]
scrollbar $tl.vscr -orient vertical \
$tl.menu.path add command -label "Load path..." \
-command [list load-path $seq]
$tl.menu.path add command -label "Save path..." -state disabled \
- -command [list save-path $seq]
+ -command [list save-path $seq]
$tl.menu.path add command -label "List path..." -state disabled \
-command [list list-path $seq]
$tl.menu.path add separator
proc galaxyp {s} {
if {![regexp {^[0-9a-fA-F]{12}$} $s]} { return 0 }
return 1
-}
+}
proc cmdr-do-validate {seq widget check value} {
upvar \#0 cmdr-$seq cmdr
foreach {tag label kind} [list \
mission "Mission" { entry 2 255 } \
score "Rating" { dropbox 65535 \
- "Harmless" 0 \
- "Mostly harmless" 8 \
+ "Harmless" 0 \
+ "Mostly harmless" 8 \
"Poor" 16 \
- "Average" 32 \
+ "Average" 32 \
"Above average" 64 \
- "Competent" 128 \
- "Dangerous" 512 \
- "Deadly" 2560 \
- "Elite" 6400 } \
+ "Competent" 128 \
+ "Dangerous" 512 \
+ "Deadly" 2560 \
+ "Elite" 6400 } \
legal-status "Legal status" { dropbox 255 \
"Clean" 0 \
"Offender" 1 \
fuel "Fuel" { tenth 4 25.5 } \
missiles "Missiles" { entry 4 255 } \
energy-unit "Energy unit" { dropbox 255 \
- "None" 0 \
+ "None" 0 \
"Standard" 1 \
"Naval" 2 } \
front-laser "Front laser" $laser \
cmdr-validate-widget $seq $tl.gal-number [list integerp 1 8]
checkbutton $tl.std-gal -text "Standard galaxy" \
-variable cmdr-${seq}(std-gal) -justify left \
- -command [list cmdr-std-gal $seq]
+ -command [list cmdr-std-gal $seq]
entry-on-change $tl.gal-number [list cmdr-set-gal-num $seq]
grid configure $tl.l-gal-number -row $r -column 0 -sticky e -padx 1 -pady 1
grid configure $tl.std-gal -row $r -column 1 -sticky w -padx 1 -pady 1
}
default {
break
- }
+ }
}
}
}
}
}
-
-
-
\ No newline at end of file
}
default {
break
- }
+ }
}
}
if {$i != [llength $argv] - 2} {
foreach {t p} $products {
set a($t) [loavghi $l($t)]
}
-}
+}
set g $galaxy1
set sortcol 0
#! /usr/bin/tclsh
-#
-# $Id: elite-reach,v 1.3 2003/03/07 00:41:46 mdw Exp $
+###
+### Determine the connected components of the various galaxies
+###
+### (c) 2003 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This program is free software; you can redistribute it and/or modify
+### it under the terms of the GNU General Public License as published by
+### the Free Software Foundation; either version 2 of the License, or
+### (at your option) any later version.
+###
+### This program is distributed in the hope that it will be useful,
+### but WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+### GNU General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package require "elite" "1.0.1"
+###--------------------------------------------------------------------------
+### Support functions.
+
proc reach {dist seed} {
+ ## Given a hyperspace range DIST and a galaxy SEED, determine and print the
+ ## connected components of the reachability graph.
+
+ ## Determine the graph. Throughout, we use world seeds as indices: a(W)
+ ## maintains a list of worlds adjacent to W. p(W) is set (to an
+ ## uninteresting value) if it's awaiting tracing. The algorithm is simple:
+ ## repeatedly pick a world awaiting tracing, do a depth-first search of
+ ## graph starting from the chosen world adding each one encountered to the
+ ## current component and removing it from the waiting list.
set ww [elite-galaxylist $seed]
elite-adjacency a $ww $dist
foreach {s x w} $ww { set p($s) 1 }
+
+ ## Initially there are no components.
set pp {}
+
+ ## Iterate over the untraced worlds.
while 1 {
+
+ ## Find an untraced world. If there are none left then we're done.
set ps [array startsearch p]
if {![array anymore p $ps]} { array donesearch p $ps; break }
set cc [array nextelement p $ps]
array donesearch p $ps
+
+ ## Now we do the depth-first search. For each world in $trace,
+ ## accumulate the untraced worlds reachable from it, and add them to the
+ ## component. Do this until we stop tracing new worlds.
+ set trace $cc
unset p($cc)
- set go 1
- while {$go} {
- set go 0
- foreach c $cc {
+ while {[llength $trace]} {
+ set tt $trace; set trace {}
+ foreach c $tt {
foreach w $a($c) {
if {[info exists p($w)]} {
unset p($w)
- lappend cc $w
- set go 1
+ lappend trace $w
}
}
}
+ set cc [concat $cc $trace]
}
+
+ ## We've finished the component. Add it to the list.
lappend pp $cc
}
+
+ ## Output the components.
foreach cc $pp {
+
+ ## Firstly, accumulate the summary data for all the worlds in the
+ ## component. Also, do dead-end analysis: if there's no world in the
+ ## component with tech level 10 or higher then the component as a whole
+ ## is a `dead end', and can't be escaped by buying a galactic hyperdrive
+ ## (and you can't have one of those already, because you must have used
+ ## it to reach the component in the first pace).
set de 1
set l {}
foreach c $cc {
elite-worldinfo i $c
- if {$i(techlevel) >= 10} {
- set de 0
- }
+ if {$i(techlevel) >= 10} { set de 0 }
lappend l [world-summary $i(seed)]
}
+
+ ## Secondly, output the component information. Separate components using
+ ## blank lines.
foreach n $l {
if {$de} { append n " *" }
puts $n
}
}
+###--------------------------------------------------------------------------
+### Main program.
+
+## Parse the command line. The default will be to scan all of the standard
+## galaxies.
if {[llength $argv] == 0} {
set argv {1 2 3 4 5 6 7 8}
}
}
}
}
+
+## Analyse the requested galaxies.
foreach {d ng g} $gg {
puts "*** GALAXY $ng ***"
reach $d $g
}
+
+###----- That's all, folks --------------------------------------------------
}
default {
break
- }
+ }
}
}
/* -*-c-*-
- *
- * $Id$
*
* Elite planet data
*
* (c) 2003 Mark Wooding
*/
-/*----- Licensing notice --------------------------------------------------*
+/*----- Licensing notice --------------------------------------------------*
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
- *
+ *
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
- *
+ *
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software Foundation,
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
o->bytes = p;
o->length = 12;
for (i = 0; i < 6; i++, p += 2)
- sprintf(p, "%02x", w->x[i]);
+ sprintf(p, "%02x", w->x[i]);
}
static void world_dir(Tcl_Obj *o, Tcl_Obj *oo)
p++;
j = mangle(w);
goatsoup(d, pn, w, desc[i][(j >= 0x33) + (j >= 0x66) +
- (j >= 0x99) + (j >= 0xcc)]);
+ (j >= 0x99) + (j >= 0xcc)]);
break;
case '%':
p++;
world ww;
/* --- Check arguments --- */
-
+
if (objc != 3)
return (err(ti, "usage: elite-worldinfo ARR SEED"));
if ((w = world_get(ti, objv[2])) == 0)
TCL_LEAVE_ERR_MSG) ||
!Tcl_SetVar2Ex(ti, arr, "y", Tcl_NewIntObj(wi.y * 2),
TCL_LEAVE_ERR_MSG) ||
- !Tcl_SetVar2Ex(ti, arr, "government", Tcl_NewIntObj(wi.gov),
+ !Tcl_SetVar2Ex(ti, arr, "government", Tcl_NewIntObj(wi.gov),
TCL_LEAVE_ERR_MSG) ||
!Tcl_SetVar2Ex(ti, arr, "economy", Tcl_NewIntObj(wi.eco),
TCL_LEAVE_ERR_MSG) ||
- !Tcl_SetVar2Ex(ti, arr, "techlevel", Tcl_NewIntObj(wi.tech),
+ !Tcl_SetVar2Ex(ti, arr, "techlevel", Tcl_NewIntObj(wi.tech),
TCL_LEAVE_ERR_MSG) ||
- !Tcl_SetVar2Ex(ti, arr, "population", Tcl_NewIntObj(wi.pop),
+ !Tcl_SetVar2Ex(ti, arr, "population", Tcl_NewIntObj(wi.pop),
TCL_LEAVE_ERR_MSG) ||
- !Tcl_SetVar2Ex(ti, arr, "productivity", Tcl_NewIntObj(wi.prod),
+ !Tcl_SetVar2Ex(ti, arr, "productivity", Tcl_NewIntObj(wi.prod),
TCL_LEAVE_ERR_MSG) ||
!Tcl_SetVar2Ex(ti, arr, "radius", Tcl_NewIntObj(wi.rad),
TCL_LEAVE_ERR_MSG) ||
return (-1);
*p++ = ii;
}
- return (0);
+ return (0);
}
static struct cmddata cmdtab[] = {
goto done;
}
for (i = 0; i < oc; i += 3) {
- s = Tcl_GetString(ov[i]);
+ s = Tcl_GetString(ov[i]);
Tcl_CreateHashEntry(&done, s, &dummy);
if (Tcl_GetLongFromObj(ti, ov[i + 1], &x) != TCL_OK ||
Tcl_GetLongFromObj(ti, ov[i + 2], &y) != TCL_OK)
} cmds[] = {
{ "elite-nextworld", cmd_nextworld },
{ "elite-nextgalaxy", cmd_nextgalaxy },
- { "elite-worldinfo", cmd_worldinfo },
+ { "elite-worldinfo", cmd_worldinfo },
{ "elite-market", cmd_market },
{ "elite-unpackcmdr", cmd_unpackcmdr },
{ "elite-packcmdr", cmd_packcmdr },
-#! /usr/bin/tclsh
-#
-# $Id$
+### -*-tcl-*-
+###
+### Common Elite hacking functions
+###
+### (c) 2003 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This program is free software; you can redistribute it and/or modify
+### it under the terms of the GNU General Public License as published by
+### the Free Software Foundation; either version 2 of the License, or
+### (at your option) any later version.
+###
+### This program is distributed in the hope that it will be useful,
+### but WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+### GNU General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package require "elite-bits" "1.0.1"
-set galaxy1 "4a5a480253b7" ;# Seed for standard galaxy 1
+###--------------------------------------------------------------------------
+### Internal utilities.
-# --- tab ARR NAME NAME ... ---
-#
-# Construct an array mapping integers 0, 1, ... to the given NAMEs, in order.
+proc _tab {arr args} {
+ ## tab ARR NAME NAME ... ---
+ ##
+ ## Construct an array mapping integers 0, 1, ... to the given NAMEs, in
+ ## order.
-proc tab {arr args} {
upvar 1 $arr a
set i 0
foreach v $args {
}
}
-# --- Various standard tables ---
+###--------------------------------------------------------------------------
+### Magic constants and tables.
+
+set galaxy1 "4a5a480253b7" ;# Seed for standard galaxy 1
-tab government \
+## Government types.
+_tab government \
"anarchy" "feudal" "multi-government" "dictatorship" \
"communist" "confederacy" "democracy" "corporate state"
-tab economy \
+## Economy types.
+_tab economy \
"rich industrial" "average industrial" "poor industrial" \
"mainly industrial" "mainly agricultural" "rich agricultural" \
"average agricultural" "poor agricultural"
-tab gov \
+## Abbreviated government types.
+_tab gov \
anarchy feudal multi-gov dictator \
communist confed democracy corp-state
-tab eco \
+## Abbreviated economy types.
+_tab eco \
rich-ind avg-ind poor-ind mainly-ind \
mainly-agri rich-agri avg-agri poor-agri
-tab gv Ay Fl MG Dp Ct Cy Dy CS
-tab ec RI AI PI MI MA RA AA PA
+## Two-letter government and economy types.
+_tab gv Ay Fl MG Dp Ct Cy Dy CS
+_tab ec RI AI PI MI MA RA AA PA
+## Products for trading.
set products {
food "Food"
textiles "Textiles"
set unit(gem-stones) g
unset p
-# --- galaxy N [GAL] ---
-#
-# Compute the seed of the Nth galaxy, if GAL is the seed of galaxy 1. By
-# default, GAL is the standard galaxy 1 seed.
+###--------------------------------------------------------------------------
+### External functions.
proc galaxy [list n [list g $galaxy1]] {
+ ## Compute the seed of the Nth galaxy, if G is the seed of galaxy 1. By
+ ## default, G is the standard galaxy 1 seed.
+
for {set i 1} {$i < $n} {incr i} {
set g [elite-nextgalaxy $g]
}
return $g
}
-# --- foreach-world GAL ARR SCRIPT ---
-#
-# For each world in galaxy GAL (a seed), set ARR to the world information
-# and evaluate SCRIPT. The usual loop control commands can be used in
-# SCRIPT.
-
proc foreach-world {g p act} {
+ ## For each world in galaxy G (a seed), set P to the world information and
+ ## evaluate ACT. The usual loop control commands can be used in ACT.
upvar 1 $p pp
for {set i 0} {$i < 256} {incr i; set g [elite-nextworld $g]} {
elite-worldinfo pp $g
- uplevel 1 $act
+ uplevel 1 $act
}
}
-# --- find-world GAL PAT ---
-#
-# Return a list of seeds for the worlds in galaxy GAL (a seed) whose names
-# match the glob pattern PAT.
-
proc find-world {g pat} {
+ ## Return a list of seeds for the worlds in galaxy G (a seed) whose names
+ ## match the glob pattern PAT.
+
set l {}
foreach-world $g p {
if {[string match -nocase $pat $p(name)]} {
return $l
}
-# --- destructure PAT LIST ---
-#
-# Destrcture LIST according to PAT. If PAT is a single name, set the
-# variable PAT to LIST; otherwise, if PAT is a list, each of its elements
-# must correspond to an element of LIST, so recursively destructure the
-# corresponding elements of each. It is not an error if the PAT list is
-# shorter than LIST. The special variable name `.' indicates that no
-# assignment is to be made.
-
proc destructure {pp xx} {
+ ## Destrcture an object XX according to the pattern PP. If PP is a single
+ ## name, set the variable PP to XX; otherwise, if PP is a list, each of its
+ ## elements must correspond to an element of the list XX, so recursively
+ ## destructure the corresponding elements of each. It is not an error if
+ ## the PP list is shorter than XX. The special variable name `.' indicates
+ ## that no assignment is to be made.
+
if {![string compare $pp "."]} {
return
} elseif {[llength $pp] == 0} {
}
}
-# --- 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}} {
+ ## 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.
+
if {[file exists $name]} {
if {[set rc [catch { file copy -force $name "$name.old" } err]]} {
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}} {
+ ## Read the contents of the file NAME, translating it according to TRANS
+ ## (default `binary').
+
set f [open $name]
fconfigure $f -translation $trans
set c [read $f]
return $c
}
-# --- nearest-planet WW X Y ---
-#
-# Returns the seed of the `nearest' planet given in the worldinfo list WW to
-# the point X Y (in decilightyears).
-
proc nearest-planet {ww x y} {
+ ## Returns the seed of the `nearest' planet given in the worldinfo list WW
+ ## to the point X Y (in decilightyears).
+
set min 10000
foreach {ss xx yy} $ww {
set dx [expr {abs($x - $xx)/4}]
return $p
}
-# --- worldname W ---
-#
-# Returns the name of the world with seed W.
-
proc worldname {w} {
+ ## Returns the name of the world with seed W.
+
elite-worldinfo p $w
return $p(name)
}
-# --- shortest-path ADJ FROM TO WEIGHT ---
-#
-# Computes the shortest path and shortest distance between the worlds wose
-# seeds are FROM and TO respectively. ADJ must be an adjacency table for the
-# galaxy containing FROM and TO. WEIGHT is a command such that WEIGHT A B
-# returns the `distance' for the simple path between A and B. The return
-# value is a list P D, where D is the weight of the path found, and P is a
-# simple list of seeds for the worlds on the path. P starts with FROM and
-# ends with TO.
-
proc shortest-path {adjvar from to weight} {
+ ## Computes the shortest path and shortest distance between the worlds wose
+ ## seeds are FROM and TO respectively. ADJVAR must be the name of a
+ ## variable holding an adjacency table for the galaxy containing FROM and
+ ## TO. WEIGHT is a command such that WEIGHT A B returns the `distance' for
+ ## the simple path between A and B. The return value is a list P D, where
+ ## D is the weight of the path found, and P is a simple list of seeds for
+ ## the worlds on the path. P starts with FROM and ends with TO.
+
upvar 1 $adjvar adj
if {[string equal $from $to]} { return [list $to 0] }
set l($from) 0
}
}
-# --- weight-hops A B ---
-#
-# shortest-path weight function giving each hop the same weight.
-
proc weight-hops {from to} {
+ ## shortest-path weight function giving each hop the same weight.
return 1
}
-# --- weight-fuel A B ---
-#
-# shortest-path weight function measuring the distance between FROM and TO.
-
proc weight-fuel {from to} {
+ ## shortest-path weight function measuring the distance between FROM and
+ ## TO.
+
elite-worldinfo f $from
elite-worldinfo t $to
return [elite-distance $f(x) $f(y) $t(x) $t(y)]
}
-# --- weight-safety A B ---
-#
-# shortest-path weight function attempting to maximize safety of the journey
-# by giving high weight (square-law) to worlds with unstable governments.
-
proc weight-safety {from to} {
+ ## shortest-path weight function attempting to maximize safety of the
+ ## journey by giving high weight (square-law) to worlds with unstable
+ ## governments.
+
elite-worldinfo t $to
set w [expr {8 - $t(government)}]
return [expr {$w * $w}]
}
-# --- weight-encounters A B ---
-#
-# shortest-path weight function attempting to maximize encounters on the
-# journey by giving high weight (square law) to worlds with stable
-# governments.
-
proc weight-encounters {from to} {
+ ## shortest-path weight function attempting to maximize encounters on the
+ ## journey by giving high weight (square law) to worlds with stable
+ ## governments.
+
elite-worldinfo f $from
elite-worldinfo t $to
set w [expr {1 + $t(government)}]
return [expr {$w * $w}]
}
-# --- weight-trading A B ---
-#
-# shortest-path weight function attempting to maximize trading opportunities
-# along the journey by giving high weight (square law) to pairs of worlds
-# with small differences between their economic statuses.
-
proc weight-trading {from to} {
+ ## shortest-path weight function attempting to maximize trading
+ ## opportunities along the journey by giving high weight (square law) to
+ ## pairs of worlds with small differences between their economic statuses.
+
elite-worldinfo f $from
elite-worldinfo t $to
set w [expr {8 - abs($f(economy) - $t(economy))}]
return [expr {$w * $w}]
}
-# --- parse-galaxy-spec G ---
-#
-# Parses a galaxy spec and returns a list containing a description of the
-# galaxy and the corresponding galaxy seed. A galaxy spec is one of:
-#
-# * a number between 1 and 8, corresponding to one of the standard
-# galaxies;
-#
-# * a 12-digit hex string, which is a galaxy seed (and is returned
-# unchanged); or
-#
-# * a string of the form S:N where S is a 12-hex-digit seed and N is a
-# galaxy number, corresponding to the Nth galaxy starting with S as
-# galaxy 1.
-#
-# If the string is unrecognized, an empty list is returned.
-
proc parse-galaxy-spec {g} {
+ ## Parses a galaxy spec and returns a list containing a description of the
+ ## galaxy and the corresponding galaxy seed. A galaxy spec is one of:
+ ##
+ ## * a number between 1 and 8, corresponding to one of the standard
+ ## galaxies;
+ ##
+ ## * a 12-digit hex string, which is a galaxy seed (and is returned
+ ## unchanged); or
+ ##
+ ## * a string of the form S:N where S is a 12-hex-digit seed and N is a
+ ## galaxy number, corresponding to the Nth galaxy starting with S as
+ ## galaxy 1.
+ ##
+ ## If the string is unrecognized, an empty list is returned.
+
switch -regexp -- $g {
{^[1-8]$} { return [list $g [galaxy $g]] }
{^[0-9a-fA-F]{12}$} { return [list $g $g] }
return {}
}
-# --- parse-planet-spec G P ---
-#
-# Parses a planet spec and returns the planet seed. The planet spec P is
-# interpreted relative to galaxy G. A planet spec is one of:
-#
-# * a simple integer, corresponding to a planet number;
-#
-# * a 12-hex-digit seed, which is returned unchanged;
-#
-# * a pair of integers separated by commas, corresponding to the nearest
-# planet to those coordinates;
-#
-# * a glob pattern, corresponding to the lowest-numbered planet in the
-# galaxy whose name matches the pattern case-insensitively; or
-#
-# * a string of the form G.P where G is a galaxy spec and P is a planet
-# spec, corresponding to the planet specified by P relative to galaxy G.
-#
-# If the string is unrecognized, an empty string is returned.
-
proc parse-planet-spec {g p} {
+ ## Parses a planet spec and returns the planet seed. The planet spec P is
+ ## interpreted relative to galaxy G. A planet spec is one of:
+ ##
+ ## * a simple integer, corresponding to a planet number;
+ ##
+ ## * a 12-hex-digit seed, which is returned unchanged;
+ ##
+ ## * a pair of integers separated by commas, corresponding to the nearest
+ ## planet to those coordinates;
+ ##
+ ## * a glob pattern, corresponding to the lowest-numbered planet in the
+ ## galaxy whose name matches the pattern case-insensitively; or
+ ##
+ ## * a string of the form G.P where G is a galaxy spec and P is a planet
+ ## spec, corresponding to the planet specified by P relative to galaxy
+ ## G.
+ ##
+ ## If the string is unrecognized, an empty string is returned.
+
if {[regexp {^[0-9a-fA-F]{12}$} $p]} { return $p }
if {[regexp {^(.+)\.(.+)$} $p . g p]} {
set g [parse-galaxy-spec $g]
return {}
}
-# --- in-galaxy-p G PP ---
-#
-# Returns nonzero if the planets (seeds) listed in PP are in galaxy G.
-# Doesn't mind if the planet seeds are invalid.
-
proc in-galaxy-p {g pp} {
+ ## Returns nonzero if the planets (seeds) listed in PP are in galaxy G.
+ ## Doesn't mind if the planet seeds are invalid.
+
foreach-world $g i { set x($i(seed)) 1 }
foreach p $pp { if {![info exists x($p)]} { return 0 } }
return 1
}
-# --- world-summary PLANET ---
-#
-# Return a one-line summary string for PLANET.
-
proc world-summary {s {ind 0} {spc 0}} {
+ ## Return a one-line summary string for planet S. IND and SPC are numbers
+ ## of additional spaces to insert at the start of the line and after the
+ ## planet name, respectively.
+
global eco gov
elite-worldinfo p $s
set is [string repeat " " $ind]
$eco($p(economy)) $gov($p(government)) $p(techlevel) $p(seed)]
}
-# --- world-brief PLANET ---
-#
-# Return a very brief summary string for PLANET.
-
proc world-brief {s} {
+ ## Return a very brief summary string for planet S.
+
global gv ec
elite-worldinfo p $s
return [format "%-8s (%s, %s, %2d)" \
$p(name) $ec($p(economy)) $gv($p(government)) $p(techlevel)]
}
-# --- jameson ARR ---
-#
-# Fill ARR with the information about commander JAMESON.
-
proc jameson {arr} {
+ ## Fill ARR with the information about commander JAMESON.
+
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
+ 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
+ score 0
+ market-fluc 0
}
set cmdr(gal-seed) $galaxy1
foreach i {
set cmdr(station-alien-items) 0
}
-#----- That's all, folks ----------------------------------------------------
+###----- That's all, folks --------------------------------------------------
package provide "elite" "1.0.1"
/* -*-c-*-
- *
- * $Id$
*
* Graph theory stuff
*
* (c) 2003 Mark Wooding
*/
-/*----- Licensing notice --------------------------------------------------*
+/*----- Licensing notice --------------------------------------------------*
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
- *
+ *
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
- *
+ *
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software Foundation,
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
t = r[i]; r[i] = r[j]; r[j] = t;
if (c_curr < c_best) {
c_best = c_curr;
-/* printf("*** new best = %lu\n", c_best); */
+/* printf("*** new best = %lu\n", c_best); */
memcpy(r_best, r, nn * sizeof(*r));
}
}
/* -*-c-*-
- *
- * $Id$
*
* Vectors and arrays in Tcl
*
* (c) 2003 Mark Wooding
*/
-/*----- Licensing notice --------------------------------------------------*
+/*----- Licensing notice --------------------------------------------------*
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
- *
+ *
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
- *
+ *
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software Foundation,
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
/* -*-c-*-
- *
- * $Id$
*
* Vectors and arrays in Tcl
*
* (c) 2003 Mark Wooding
*/
-/*----- Licensing notice --------------------------------------------------*
+/*----- Licensing notice --------------------------------------------------*
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
- *
+ *
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
- *
+ *
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software Foundation,
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
~mdw / rocl / commitdiff