3 ### Common Elite hacking functions
5 ### (c) 2003 Mark Wooding
8 ###----- Licensing notice ---------------------------------------------------
10 ### This program is free software; you can redistribute it and/or modify
11 ### it under the terms of the GNU General Public License as published by
12 ### the Free Software Foundation; either version 2 of the License, or
13 ### (at your option) any later version.
15 ### This program is distributed in the hope that it will be useful,
16 ### but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ### GNU General Public License for more details.
20 ### You should have received a copy of the GNU General Public License
21 ### along with this program; if not, write to the Free Software Foundation,
22 ### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
24 package require
"elite-bits" "1.0.1"
26 ###--------------------------------------------------------------------------
27 ### Internal utilities.
29 proc _tab
{arr args
} {
30 ## _tab ARR NAME NAME ... ---
32 ## Construct an array mapping integers 0, 1, ... to the given NAMEs, in
43 ###--------------------------------------------------------------------------
44 ### Magic constants and tables.
46 set galaxy1
"4a5a480253b7" ;# Seed for standard galaxy 1
50 "anarchy" "feudal" "multi-government" "dictatorship" \
51 "communist" "confederacy" "democracy" "corporate state"
55 "rich industrial" "average industrial" "poor industrial" \
56 "mainly industrial" "mainly agricultural" "rich agricultural" \
57 "average agricultural" "poor agricultural"
59 ## Abbreviated government types.
61 anarchy feudal multi-gov dictator
\
62 communist confed democracy corp-state
64 ## Abbreviated economy types.
66 rich-ind avg-ind poor-ind mainly-ind
\
67 mainly-agri rich-agri avg-agri poor-agri
69 ## Two-letter government and economy types.
70 _tab gv Ay Fl MG Dp Ct Cy Dy CS
71 _tab ec RI AI PI MI MA RA AA PA
73 ## Products for trading.
77 radioactives
"Radioactives"
79 liquor-wines
"Liquor & wines"
90 gem-stones
"Gem-stones"
91 alien-items
"Alien items"
94 foreach p
$products { set unit
($p) t
}
95 foreach p
{gold platinum
} { set unit
($p) kg
}
96 set unit
(gem-stones
) g
99 ###--------------------------------------------------------------------------
100 ### External functions.
102 proc galaxy
[list n
[list g
$galaxy1]] {
103 ## Compute the seed of the Nth galaxy, if G is the seed of galaxy 1. By
104 ## default, G is the standard galaxy 1 seed.
106 for {set i
1} {$i < $n} {incr i
} {
107 set g
[elite-nextgalaxy
$g]
112 proc foreach-world
{g p act
} {
113 ## For each world in galaxy G (a seed), set P to the world information and
114 ## evaluate ACT. The usual loop control commands can be used in ACT.
116 for {set i
0} {$i < 256} {incr i
; set g
[elite-nextworld
$g]} {
117 elite-worldinfo pp
$g
122 proc find-world
{g pat
} {
123 ## Return a list of seeds for the worlds in galaxy G (a seed) whose names
124 ## match the glob pattern PAT.
128 if {[string match
-nocase $pat $p(name
)]} {
135 proc destructure
{pp xx
} {
136 ## Destrcture an object XX according to the pattern PP. If PP is a single
137 ## name, set the variable PP to XX; otherwise, if PP is a list, each of its
138 ## elements must correspond to an element of the list XX, so recursively
139 ## destructure the corresponding elements of each. It is not an error if
140 ## the PP list is shorter than XX. The special variable name `.' indicates
141 ## that no assignment is to be made.
143 if {![string compare
$pp "."]} {
145 } elseif
{[llength $pp] == 0} {
147 } elseif
{[llength $pp] == 1} {
151 foreach p
$pp x
$xx {
152 uplevel 1 [list destructure
$p $x]
157 proc write-file
{name contents
{trans
binary}} {
158 ## Write file NAME, storing CONTENTS translated according to TRANS (default
159 ## `binary'. The write is safe against errors -- we don't destroy the old
160 ## data until the file is written.
162 if {[file exists
$name]} {
163 if {[set rc
[catch { file copy
-force $name "$name.old" } err
]]} {
164 return -code $rc $err
169 fconfigure $f -translation $trans
170 puts -nonewline $f $contents
174 catch { file rename -force "$name.old" $name }
175 return -code $rc $err
180 proc read-file
{name
{trans
binary}} {
181 ## Read the contents of the file NAME, translating it according to TRANS
182 ## (default `binary').
185 fconfigure $f -translation $trans
191 proc nearest-planet
{ww x y
} {
192 ## Returns the seed of the `nearest' planet given in the worldinfo list WW
193 ## to the point X Y (in decilightyears).
196 foreach {ss xx yy
} $ww {
197 set dx
[expr {abs
($x - $xx)/4}]
198 set dy
[expr {abs
($y - $yy)/2}]
200 set d
[expr {($dx * 2 + $dy)/2}]
202 set d
[expr {($dx + $dy * 2)/2}]
213 ## Returns the name of the world with seed W.
219 proc shortest-path
{adjvar from to weight
} {
220 ## Computes the shortest path and shortest distance between the worlds wose
221 ## seeds are FROM and TO respectively. ADJVAR must be the name of a
222 ## variable holding an adjacency table for the galaxy containing FROM and
223 ## TO. WEIGHT is a command such that WEIGHT A B returns the `distance' for
224 ## the simple path between A and B. The return value is a list P D, where
225 ## D is the weight of the path found, and P is a simple list of seeds for
226 ## the worlds on the path. P starts with FROM and ends with TO.
229 if {[string equal
$from $to]} { return [list $to 0] }
234 foreach {n x y
} $adj($c) {
235 if {[info exists l
($n)]} {
238 set w
[expr {$l($c) + [uplevel 1 $weight [list $c $n]]}]
239 if {![info exists ll
($n)] ||
$w < $ll($n)} {
241 set p
($n) [concat $p($c) [list $n]]
244 set s
[array startsearch ll
]
245 if {![array anymore ll
$s]} {
248 set c
[array nextelement ll
$s]
250 while {[array anymore ll
$s]} {
251 set n
[array nextelement ll
$s]
257 if {[string equal
$c $to]} { return [list $p($to) $ll($to)] }
263 proc weight-hops
{from to
} {
264 ## shortest-path weight function giving each hop the same weight.
268 proc weight-fuel
{from to
} {
269 ## shortest-path weight function measuring the distance between FROM and
272 elite-worldinfo f
$from
273 elite-worldinfo t
$to
274 return [elite-distance
$f(x
) $f(y
) $t(x
) $t(y
)]
277 proc weight-safety
{from to
} {
278 ## shortest-path weight function attempting to maximize safety of the
279 ## journey by giving high weight (square-law) to worlds with unstable
282 elite-worldinfo t
$to
283 set w
[expr {8 - $t(government
)}]
284 return [expr {$w * $w}]
287 proc weight-encounters
{from to
} {
288 ## shortest-path weight function attempting to maximize encounters on the
289 ## journey by giving high weight (square law) to worlds with stable
292 elite-worldinfo f
$from
293 elite-worldinfo t
$to
294 set w
[expr {1 + $t(government
)}]
295 return [expr {$w * $w}]
298 proc weight-trading
{from to
} {
299 ## shortest-path weight function attempting to maximize trading
300 ## opportunities along the journey by giving high weight (square law) to
301 ## pairs of worlds with small differences between their economic statuses.
303 elite-worldinfo f
$from
304 elite-worldinfo t
$to
305 set w
[expr {8 - abs
($f(economy
) - $t(economy
))}]
306 return [expr {$w * $w}]
309 proc parse-galaxy-spec
{g
} {
310 ## Parses a galaxy spec and returns a list containing a description of the
311 ## galaxy and the corresponding galaxy seed. A galaxy spec is one of:
313 ## * a number between 1 and 8, corresponding to one of the standard
316 ## * a 12-digit hex string, which is a galaxy seed (and is returned
319 ## * a string of the form S:N where S is a 12-hex-digit seed and N is a
320 ## galaxy number, corresponding to the Nth galaxy starting with S as
323 ## If the string is unrecognized, an empty list is returned.
325 switch -regexp -- $g {
326 {^
[1-8]$} { return [list $g [galaxy
$g]] }
327 {^
[0-9a-fA-F
]{12}$} { return [list $g $g] }
329 if {[regexp {^
([0-9a-fA-F
]{12}):([1-8])$} $g . b n
]} {
330 return [list $g [galaxy
$n $b]]
337 proc parse-planet-spec
{g p
} {
338 ## Parses a planet spec and returns the planet seed. The planet spec P is
339 ## interpreted relative to galaxy G. A planet spec is one of:
341 ## * a simple integer, corresponding to a planet number;
343 ## * a 12-hex-digit seed, which is returned unchanged;
345 ## * a pair of integers separated by commas, corresponding to the nearest
346 ## planet to those coordinates;
348 ## * a glob pattern, corresponding to the lowest-numbered planet in the
349 ## galaxy whose name matches the pattern case-insensitively; or
351 ## * a string of the form G.P where G is a galaxy spec and P is a planet
352 ## spec, corresponding to the planet specified by P relative to galaxy
355 ## If the string is unrecognized, an empty string is returned.
357 if {[regexp {^
[0-9a-fA-F
]{12}$} $p]} { return $p }
358 if {[regexp {^
(.
+)\.
(.
+)$} $p . g p
]} {
359 set g
[parse-galaxy-spec
$g]
360 if {[string equal
$g ""]} { return {} }
362 return [parse-planet-spec
$g $p]
364 if {[regexp {^
(0x
[0-9a-fA-F
]+|
[0-9]+)$} $p]} {
365 for {set s
$g; set i
0} {$i < $p} {incr i
; set s
[elite-nextworld
$s]} {}
368 if {[regexp {^
(0x
[0-9a-fA-F
]+|
[0-9]+),\s
*(0x
[0-9a-fA-F
]+|
[0-9]+)$} \
370 return [nearest-planet
[elite-galaxylist
$g] $x $y]
372 if {[regexp {^
([^
/]*)(?
:/([1-9]\d
*))?
$} $p . p i
]} {
373 if {[string equal
$i ""]} { set i
1 }
374 set l
[find-world
$g $p]
375 if {$i <= [llength $l]} { return [lindex $l [expr {$i - 1}]] }
380 proc in-galaxy-p
{g pp
} {
381 ## Returns nonzero if the planets (seeds) listed in PP are in galaxy G.
382 ## Doesn't mind if the planet seeds are invalid.
384 foreach-world
$g i
{ set x
($i(seed
)) 1 }
385 foreach p
$pp { if {![info exists x
($p)]} { return 0 } }
389 proc world-summary
{s
{ind
0} {spc
0}} {
390 ## Return a one-line summary string for planet S. IND and SPC are numbers
391 ## of additional spaces to insert at the start of the line and after the
392 ## planet name, respectively.
396 set is
[string repeat
" " $ind]
397 set ss
[string repeat
" " $spc]
398 return [format "%s%-8s%s %4d %4d %-11s %-10s %2d %s" \
399 $is $p(name
) $ss $p(x
) $p(y
) \
400 $eco($p(economy
)) $gov($p(government
)) $p(techlevel
) $p(seed
)]
403 proc world-brief
{s
} {
404 ## Return a very brief summary string for planet S.
408 return [format "%-8s (%s, %s, %2d)" \
409 $p(name
) $ec($p(economy
)) $gv($p(government
)) $p(techlevel
)]
413 ## Fill ARR with the information about commander JAMESON.
415 global galaxy1 products
432 set cmdr
(gal-seed
) $galaxy1
434 ecm fuel-scoop energy-bomb energy-unit docking-computer
435 gal-hyperdrive escape-pod
437 elite-worldinfo lave
[find-world
$galaxy1 "Lave"]
438 set cmdr
(world-x
) [expr {$lave(x
)/4}]
439 set cmdr
(world-y
) [expr {$lave(y
)/2}]
440 elite-market mkt
$lave(seed
) 0
441 foreach {t n
} $products {
442 destructure
[list . cmdr
(station-
$t)] $mkt($t)
445 set cmdr
(station-alien-items
) 0
448 ###----- That's all, folks --------------------------------------------------
450 package provide
"elite" "1.0.1"