3 # $Id: elite.tcl,v 1.2 2003/02/25 00:25:38 mdw Exp $
5 package require "elite-bits" "1.0.0"
7 set galaxy1 "4a5a480253b7" ;# Seed for standard galaxy 1
9 # --- tab ARR NAME NAME ... ---
11 # Construct an array mapping integers 0, 1, ... to the given NAMEs, in order.
22 # --- Various standard tables ---
25 "anarchy" "feudal" "multi-government" "dictatorship" \
26 "communist" "confederacy" "democracy" "corporate state"
29 "rich industrial" "average industrial" "poor industrial" \
30 "mainly industrial" "mainly agricultural" "rich agricultural" \
31 "average agricultural" "poor agricultural"
34 anarchy feudal multi-gov dictator \
35 communist confed democracy corp-state
38 rich-ind ave-ind poor-ind mainly-ind \
39 mainly-agri rich-agri ave-agri poor-agri
44 radioactives "Radioactives"
46 liquor-wines "Liquor & wines"
57 gem-stones "Gem-stones"
58 alien-items "Alien items"
61 foreach p $products { set unit($p) t }
62 foreach p {gold platinum} { set unit($p) kg }
63 set unit(gem-stones) g
66 # --- galaxy N [GAL] ---
68 # Compute the seed of the Nth galaxy, if GAL is the seed of galaxy 1. By
69 # default, GAL is the standard galaxy 1 seed.
71 proc galaxy [list n [list g $galaxy1]] {
72 for {set i 1} {$i < $n} {incr i} {
73 set g [elite-nextgalaxy $g]
78 # --- foreach-world GAL ARR SCRIPT ---
80 # For each world in galaxy GAL (a seed), set ARR to the world information
81 # and evaluate SCRIPT. The usual loop control commands can be used in
84 proc foreach-world {g p act} {
86 for {set i 0} {$i < 256} {incr i; set g [elite-nextworld $g]} {
92 # --- find-world GAL PAT ---
94 # Return a list of seeds for the worlds in galaxy GAL (a seed) whose names
95 # match the glob pattern PAT.
97 proc find-world {g pat} {
100 if {[string match -nocase $pat $p(name)]} {
107 # --- destructure PAT LIST ---
109 # Destrcture LIST according to PAT. If PAT is a single name, set the
110 # variable PAT to LIST; otherwise, if PAT is a list, each of its elements
111 # must correspond to an element of LIST, so recursively destructure the
112 # corresponding elements of each. It is not an error if the PAT list is
113 # shorter than LIST. The special variable name `.' indicates that no
114 # assignment is to be made.
116 proc destructure {pp xx} {
117 if {![string compare $pp "."]} {
119 } elseif {[llength $pp] == 0} {
121 } elseif {[llength $pp] == 1} {
125 foreach p $pp x $xx {
126 uplevel 1 [list destructure $p $x]
131 # --- worldinfo GAL ---
133 # Return a list describing the worlds in galaxy GAL (a seed). The list
134 # contains a group of three elements for each world: the seed, x and y
135 # coordinates (in decilightyears).
139 lappend i $p(seed) $p(x) $p(y)
144 # --- world-distance X Y XX YY ---
146 # Computes the correct game distance in decilightyears between two worlds,
147 # one at X, Y and the other at XX, YY.
149 proc world-distance {x y xx yy} {
150 set dx [expr {abs($x - $xx)/4}]
151 set dy [expr {abs($y - $yy)/4}]
152 return [expr {4 * floor(sqrt($dx * $dx + $dy * $dy))}]
155 # --- nearest-planet WW X Y ---
157 # Returns the seed of the `nearest' planet given in the worldinfo list WW to
158 # the point X Y (in decilightyears).
160 proc nearest-planet {ww x y} {
162 foreach {ss xx yy} $ww {
163 set dx [expr {abs($x - $xx)/4}]
164 set dy [expr {abs($y - $yy)/2}]
166 set d [expr {($dx * 2 + $dy)/2}]
168 set d [expr {($dx + $dy * 2)/2}]
178 # --- adjacency WW ADJ [D] ---
180 # Fill in the array ADJ with the adjacency table for the worlds listed in the
181 # worldinfo list WW. That is, for each world seed S, ADJ(S) is set to a
182 # worldinfo list containing the worlds within D (default 70) decilightyears
185 proc adjacency {p adj {d 70}} {
191 foreach {ss xx yy} $p {
192 if {[info exists done($ss)]} { continue }
193 if {abs($x - $xx) > $d + 10 || abs($y - $yy) > $d + 10 ||
194 [world-distance $x $y $xx $yy] > $d} { continue }
195 lappend a($s) $ss $xx $yy
196 lappend a($ss) $s $x $y
201 # --- worldname W ---
203 # Returns the name of the world with seed W.
210 # --- shortest-path ADJ FROM TO WEIGHT ---
212 # Computes the shortest path and shortest distance between the worlds wose
213 # seeds are FROM and TO respectively. ADJ must be an adjacency table for the
214 # galaxy containing FROM and TO. WEIGHT is a command such that WEIGHT A B
215 # returns the `distance' for the simple path between A and B. The return
216 # value is a list P D, where D is the weight of the path found, and P is a
217 # simple list of seeds for the worlds on the path. P starts with FROM and
220 proc shortest-path {adjvar from to weight} {
222 if {[string equal $from $to]} { return [list $to 0] }
227 foreach {n x y} $adj($c) {
228 if {[info exists l($n)]} {
231 set w [expr {$l($c) + [uplevel 1 $weight [list $c $n]]}]
232 if {![info exists ll($n)] || $w < $ll($n)} {
234 set p($n) [concat $p($c) [list $n]]
237 set s [array startsearch ll]
238 if {![array anymore ll $s]} {
241 set c [array nextelement ll $s]
243 while {[array anymore ll $s]} {
244 set n [array nextelement ll $s]
250 if {[string equal $c $to]} { return [list $p($to) $ll($to)] }
256 # --- weight-hops A B ---
258 # shortest-path weight function giving each hop the same weight.
260 proc weight-hops {from to} {
264 # --- weight-fuel A B ---
266 # shortest-path weight function measuring the distance between FROM and TO.
268 proc weight-fuel {from to} {
269 elite-worldinfo f $from
270 elite-worldinfo t $to
271 return [world-distance $f(x) $f(y) $t(x) $t(y)]
274 # --- weight-safety A B ---
276 # shortest-path weight function attempting to maximize safety of the journey
277 # by giving high weight (square-law) to worlds with unstable governments.
279 proc weight-safety {from to} {
280 elite-worldinfo t $to
281 set w [expr {8 - $t(government)}]
282 return [expr {$w * $w}]
285 # --- weight-encounters A B ---
287 # shortest-path weight function attempting to maximize encounters on the
288 # journey by giving high weight (square law) to worlds with stable
291 proc weight-encounters {from to} {
292 elite-worldinfo f $from
293 elite-worldinfo t $to
294 set w [expr {1 + $t(government)}]
295 return [expr {$w * $w}]
298 # --- weight-trading A B ---
300 # shortest-path weight function attempting to maximize trading opportunities
301 # along the journey by giving high weight (square law) to pairs of worlds
302 # with small differences between their economic statuses.
304 proc weight-trading {from to} {
305 elite-worldinfo f $from
306 elite-worldinfo t $to
307 set w [expr {8 - abs($f(economy) - $t(economy))}]
308 return [expr {$w * $w}]
311 # --- parse-galaxy-spec G ---
313 # Parses a galaxy spec and returns a list containing a description of the
314 # galaxy and the corresponding galaxy seed. A galaxy spec is one of:
316 # * a number between 1 and 8, corresponding to one of the standard
319 # * a 12-digit hex string, which is a galaxy seed (and is returned
322 # * a string of the form S:N where S is a 12-hex-digit seed and N is a
323 # galaxy number, corresponding to the Nth galaxy starting with S as
326 # If the string is unrecognized, an empty list is returned.
328 proc parse-galaxy-spec {g} {
329 switch -regexp -- $g {
330 {^[1-8]$} { return [list $g [galaxy $g]] }
331 {^[0-9a-fA-F]{12}$} { return [list $g $g] }
333 if {[regexp {^([0-9a-fA-F]{12}):([1-8])$} $g . b n]} {
334 return [list $g [galaxy $n $b]]
341 # --- parse-planet-spec G P ---
343 # Parses a planet spec and returns the planet seed. The planet spec P is
344 # interpreted relative to galaxy G. A planet spec is one of:
346 # * a simple integer, corresponding to a planet number;
348 # * a 12-hex-digit seed, which is returned unchanged;
350 # * a pair of integers separated by commas, corresponding to the nearest
351 # planet to those coordinates;
353 # * a glob pattern, corresponding to the lowest-numbered planet in the
354 # galaxy whose name matches the pattern case-insensitively; or
356 # * a string of the form G.P where G is a galaxy spec and P is a planet
357 # spec, corresponding to the planet specified by P relative to galaxy G.
359 # If the string is unrecognized, an empty string is returned.
361 proc parse-planet-spec {g p} {
362 if {[regexp {^[0-9a-fA-F]{12}$} $p]} { return $p }
363 if {[regexp {^(.+)\.(.+)$} $p . g p]} {
364 set g [parse-galaxy-spec $g]
365 if {[string equal $g ""]} { return {} }
367 return [parse-planet-spec $g $p]
369 if {[regexp {^(0x[0-9a-fA-F]+|[0-9]+)$} $p]} {
370 for {set s $g; set i 0} {$i < $p} {incr i; set s [elite-nextworld $s]} {}
373 if {[regexp {^(0x[0-9a-fA-F]+|[0-9]+),\s*(0x[0-9a-fA-F]+|[0-9]+)$} \
375 return [nearest-planet [worldinfo $g] $x $y]
377 set l [find-world $g $p]
378 if {[llength $l]} { return [lindex $l 0] }
382 # --- in-galaxy-p G PP ---
384 # Returns nonzero if the planets (seeds) listed in PP are in galaxy G.
385 # Doesn't mind if the planet seeds are invalid.
387 proc in-galaxy-p {g pp} {
388 foreach-world $g i { set x($i(seed)) 1 }
389 foreach p $pp { if {![info exists x($p)]} { return 0 } }
393 # --- world-summary PLANET ---
395 # Return a one-line summary string for PLANET.
397 proc world-summary {s} {
400 return [format "%-12s %4d %4d %-11s %-10s %2d %s" \
401 $p(name) $p(x) $p(y) \
402 $eco($p(economy)) $gov($p(government)) $p(techlevel) $p(seed)]
405 #----- That's all, folks ----------------------------------------------------
407 package provide "elite" "1.0.0"