3 package require
"elite-bits" "1.0.0"
5 set galaxy1
"4a5a480253b7" ;# Seed for standard galaxy 1
7 # --- tab ARR NAME NAME ... ---
9 # Construct an array mapping integers 0, 1, ... to the given NAMEs, in order.
20 # --- Various standard tables ---
23 "anarchy" "feudal" "multi-government" "dictatorship" \
24 "communist" "confederacy" "democracy" "corporate state"
27 "rich industrial" "average industrial" "poor industrial" \
28 "mainly industrial" "mainly agricultural" "rich agricultural" \
29 "average agricultural" "poor agricultural"
32 anarchy feudal multi-gov dictator
\
33 communist confed democracy corp-state
36 rich-ind ave-ind poor-ind mainly-ind
\
37 mainly-agri rich-agri ave-agri poor-agri
42 radioactives
"Radioactives"
44 liquor-wines
"Liquor & wines"
55 gem-stones
"Gem-stones"
56 alien-items
"Alien items"
59 foreach p
$products { set unit
($p) t
}
60 foreach p
{gold platinum
} { set unit
($p) kg
}
61 set unit
(gem-stones
) g
64 # --- galaxy N [GAL] ---
66 # Compute the seed of the Nth galaxy, if GAL is the seed of galaxy 1. By
67 # default, GAL is the standard galaxy 1 seed.
69 proc galaxy
[list n
[list g
$galaxy1]] {
70 for {set i
1} {$i < $n} {incr i
} {
71 set g
[elite-nextgalaxy
$g]
76 # --- foreach-world GAL ARR SCRIPT ---
78 # For each world in galaxy GAL (a seed), set ARR to the world information
79 # and evaluate SCRIPT. The usual loop control commands can be used in
82 proc foreach-world
{g p act
} {
84 for {set i
0} {$i < 256} {incr i
; set g
[elite-nextworld
$g]} {
90 # --- find-world GAL PAT ---
92 # Return a list of seeds for the worlds in galaxy GAL (a seed) whose names
93 # match the glob pattern PAT.
95 proc find-world
{g pat
} {
98 if {[string match
-nocase $pat $p(name
)]} {
105 # --- destructure PAT LIST ---
107 # Destrcture LIST according to PAT. If PAT is a single name, set the
108 # variable PAT to LIST; otherwise, if PAT is a list, each of its elements
109 # must correspond to an element of LIST, so recursively destructure the
110 # corresponding elements of each. It is not an error if the PAT list is
111 # shorter than LIST. The special variable name `.' indicates that no
112 # assignment is to be made.
114 proc destructure
{pp xx
} {
115 if {![string compare
$pp "."]} {
117 } elseif
{[llength $pp] == 0} {
119 } elseif
{[llength $pp] == 1} {
123 foreach p
$pp x
$xx {
124 uplevel 1 [list destructure
$p $x]
129 # --- worldinfo GAL ---
131 # Return a list describing the worlds in galaxy GAL (a seed). The list
132 # contains a group of three elements for each world: the seed, x and y
133 # coordinates (in decilightyears).
137 lappend i
$p(seed
) $p(x
) $p(y
)
142 # --- world-distance X Y XX YY ---
144 # Computes the correct game distance in decilightyears between two worlds,
145 # one at X, Y and the other at XX, YY.
147 proc world-distance
{x y xx yy
} {
148 set dx
[expr {abs
($x - $xx)/4}]
149 set dy
[expr {abs
($y - $yy)/4}]
150 return [expr {4 * floor
(sqrt
($dx * $dx + $dy * $dy))}]
153 # --- nearest-planet WW X Y ---
155 # Returns the seed of the `nearest' planet given in the worldinfo list WW to
156 # the point X Y (in decilightyears).
158 proc nearest-planet
{ww x y
} {
160 foreach {ss xx yy
} $ww {
161 set dx
[expr {abs
($x - $xx)/4}]
162 set dy
[expr {abs
($y - $yy)/2}]
164 set d
[expr {($dx * 2 + $dy)/2}]
166 set d
[expr {($dx + $dy * 2)/2}]
176 # --- adjacency WW ADJ [D] ---
178 # Fill in the array ADJ with the adjacency table for the worlds listed in the
179 # worldinfo list WW. That is, for each world seed S, ADJ(S) is set to a
180 # worldinfo list containing the worlds within D (default 70) decilightyears
183 proc adjacency
{p adj
{d
70}} {
189 foreach {ss xx yy
} $p {
190 if {[info exists done
($ss)]} { continue }
191 if {abs
($x - $xx) > $d + 10 || abs
($y - $yy) > $d + 10 ||
192 [world-distance
$x $y $xx $yy] > $d} { continue }
193 lappend a
($s) $ss $xx $yy
194 lappend a
($ss) $s $x $y
199 # --- worldname W ---
201 # Returns the name of the world with seed W.
208 # --- shortest-path ADJ FROM TO WEIGHT ---
210 # Computes the shortest path and shortest distance between the worlds wose
211 # seeds are FROM and TO respectively. ADJ must be an adjacency table for the
212 # galaxy containing FROM and TO. WEIGHT is a command such that WEIGHT A B
213 # returns the `distance' for the simple path between A and B. The return
214 # value is a list P D, where D is the weight of the path found, and P is a
215 # simple list of seeds for the worlds on the path. P starts with FROM and
218 proc shortest-path
{adjvar from to weight
} {
220 if {[string equal
$from $to]} { return [list $to 0] }
225 foreach {n x y
} $adj($c) {
226 if {[info exists l
($n)]} {
229 set w
[expr {$l($c) + [uplevel 1 $weight [list $c $n]]}]
230 if {![info exists ll
($n)] ||
$w < $ll($n)} {
232 set p
($n) [concat $p($c) [list $n]]
235 set s
[array startsearch ll
]
236 if {![array anymore ll
$s]} {
239 set c
[array nextelement ll
$s]
241 while {[array anymore ll
$s]} {
242 set n
[array nextelement ll
$s]
248 if {[string equal
$c $to]} { return [list $p($to) $ll($to)] }
254 # --- weight-hops A B ---
256 # shortest-path weight function giving each hop the same weight.
258 proc weight-hops
{from to
} {
262 # --- weight-fuel A B ---
264 # shortest-path weight function measuring the distance between FROM and TO.
266 proc weight-fuel
{from to
} {
267 elite-worldinfo f
$from
268 elite-worldinfo t
$to
269 return [world-distance
$f(x
) $f(y
) $t(x
) $t(y
)]
272 # --- weight-safety A B ---
274 # shortest-path weight function attempting to maximize safety of the journey
275 # by giving high weight (square-law) to worlds with unstable governments.
277 proc weight-safety
{from to
} {
278 elite-worldinfo t
$to
279 set w
[expr {8 - $t(government
)}]
280 return [expr {$w * $w}]
283 # --- weight-encounters A B ---
285 # shortest-path weight function attempting to maximize encounters on the
286 # journey by giving high weight (square law) to worlds with stable
289 proc weight-encounters
{from to
} {
290 elite-worldinfo f
$from
291 elite-worldinfo t
$to
292 set w
[expr {1 + $t(government
)}]
293 return [expr {$w * $w}]
296 # --- weight-trading A B ---
298 # shortest-path weight function attempting to maximize trading opportunities
299 # along the journey by giving high weight (square law) to pairs of worlds
300 # with small differences between their economic statuses.
302 proc weight-trading
{from to
} {
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 # --- parse-galaxy-spec G ---
311 # Parses a galaxy spec and returns a list containing a description of the
312 # galaxy and the corresponding galaxy seed. A galaxy spec is one of:
314 # * a number between 1 and 8, corresponding to one of the standard
317 # * a 12-digit hex string, which is a galaxy seed (and is returned
320 # * a string of the form S:N where S is a 12-hex-digit seed and N is a
321 # galaxy number, corresponding to the Nth galaxy starting with S as
324 # If the string is unrecognized, an empty list is returned.
326 proc parse-galaxy-spec
{g
} {
327 switch -regexp -- $g {
328 {^
[1-8]$} { return [list $g [galaxy
$g]] }
329 {^
[0-9a-fA-F
]{12}$} { return [list $g $g] }
331 if {[regexp {^
([0-9a-fA-F
]{12}):([1-8])$} $g . b n
]} {
332 return [list $g [galaxy
$n $b]]
339 # --- parse-planet-spec G P ---
341 # Parses a planet spec and returns the planet seed. The planet spec P is
342 # interpreted relative to galaxy G. A planet spec is one of:
344 # * a simple integer, corresponding to a planet number;
346 # * a 12-hex-digit seed, which is returned unchanged;
348 # * a pair of integers separated by commas, corresponding to the nearest
349 # planet to those coordinates;
351 # * a glob pattern, corresponding to the lowest-numbered planet in the
352 # galaxy whose name matches the pattern case-insensitively; or
354 # * a string of the form G.P where G is a galaxy spec and P is a planet
355 # spec, corresponding to the planet specified by P relative to galaxy G.
357 # If the string is unrecognized, an empty string is returned.
359 proc parse-planet-spec
{g p
} {
360 if {[regexp {^
[0-9a-fA-F
]{12}$} $p]} { return $p }
361 if {[regexp {^
(.
+)\.
(.
+)$} $p . g p
]} {
362 set g
[parse-galaxy-spec
$g]
363 if {[string equal
$g ""]} { return {} }
365 return [parse-planet-spec
$g $p]
367 if {[regexp {^
(0x
[0-9a-fA-F
]+|
[0-9]+)$} $p]} {
368 for {set s
$g; set i
0} {$i < $p} {incr i
; set s
[elite-nextworld
$s]} {}
371 if {[regexp {^
(0x
[0-9a-fA-F
]+|
[0-9]+),\s
*(0x
[0-9a-fA-F
]+|
[0-9]+)$} \
373 return [nearest-planet
[worldinfo
$g] $x $y]
375 set l
[find-world
$g $p]
376 if {[llength $l]} { return [lindex $l 0] }
380 # --- in-galaxy-p G PP ---
382 # Returns nonzero if the planets (seeds) listed in PP are in galaxy G.
383 # Doesn't mind if the planet seeds are invalid.
385 proc in-galaxy-p
{g pp
} {
386 foreach-world
$g i
{ set x
($i(seed
)) 1 }
387 foreach p
$pp { if {![info exists x
($p)]} { return 0 } }
391 # --- world-summary PLANET ---
393 # Return a one-line summary string for PLANET.
395 proc world-summary
{s
} {
398 return [format "%-12s %4d %4d %-11s %-10s %2d %s" \
399 $p(name
) $p(x
) $p(y
) \
400 $eco($p(economy
)) $gov($p(government
)) $p(techlevel
) $p(seed
)]
403 #----- That's all, folks ----------------------------------------------------
405 package provide
"elite" "1.0.0"