[rocl] / elite.tcl

#! /usr/bin/tclsh
#
# $Id$

package require "elite-bits" "1.0.1"

set galaxy1 "4a5a480253b7"		;# Seed for standard galaxy 1

# --- 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 {
    set a($i) $v
    incr i
  }
}

# --- Various standard tables ---

tab government \
    "anarchy" "feudal" "multi-government" "dictatorship" \
    "communist" "confederacy" "democracy" "corporate state"

tab economy \
    "rich industrial" "average industrial" "poor industrial" \
    "mainly industrial" "mainly agricultural" "rich agricultural" \
    "average agricultural" "poor agricultural"

tab gov \
    anarchy feudal multi-gov dictator \
    communist confed democracy corp-state

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

set products {
  food		"Food"
  textiles	"Textiles"
  radioactives	"Radioactives"
  slaves	"Slaves"
  liquor-wines	"Liquor & wines"
  luxuries	"Luxuries"
  narcotics	"Narcotics"
  computers	"Computers"
  machinery	"Machinery"
  alloys	"Alloys"
  firearms	"Firearms"
  furs		"Furs"
  minerals	"Minerals"
  gold		"Gold"
  platinum	"Platinum"
  gem-stones	"Gem-stones"
  alien-items	"Alien items"
}

foreach p $products { set unit($p) t }
foreach p {gold platinum} { set unit($p) kg }
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.

proc galaxy [list n [list g $galaxy1]] {
  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} {
  upvar 1 $p pp
  for {set i 0} {$i < 256} {incr i; set g [elite-nextworld $g]} {
    elite-worldinfo pp $g
    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} {
  set l {}
  foreach-world $g p {
    if {[string match -nocase $pat $p(name)]} {
      lappend l $p(seed)
    }
  }
  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} {
  if {![string compare $pp "."]} {
    return
  } elseif {[llength $pp] == 0} {
    return
  } elseif {[llength $pp] == 1} {
    upvar 1 $pp p
    set p $xx
  } else {
    foreach p $pp x $xx {
      uplevel 1 [list destructure $p $x]
    }
  }
}

# --- 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
}

# --- 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} {
  set min 10000
  foreach {ss xx yy} $ww {
    set dx [expr {abs($x - $xx)/4}]
    set dy [expr {abs($y - $yy)/2}]
    if {$dx > $dy} {
      set d [expr {($dx * 2 + $dy)/2}]
    } else {
      set d [expr {($dx + $dy * 2)/2}]
    }
    if {$d < $min} {
      set p $ss
      set min $d
    }
  }
  return $p
}

# --- worldname W ---
#
# Returns the name of the world with seed W.

proc worldname {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} {
  upvar 1 $adjvar adj
  if {[string equal $from $to]} { return [list $to 0] }
  set l($from) 0
  set p($from) $from
  set c $from
  while 1 {
    foreach {n x y} $adj($c) {
      if {[info exists l($n)]} {
	continue
      }
      set w [expr {$l($c) + [uplevel 1 $weight [list $c $n]]}]
      if {![info exists ll($n)] || $w < $ll($n)} {
	set ll($n) $w
	set p($n) [concat $p($c) [list $n]]
      }
    }
    set s [array startsearch ll]
    if {![array anymore ll $s]} {
      return {{} 0}
    }
    set c [array nextelement ll $s]
    set w $ll($c)
    while {[array anymore ll $s]} {
      set n [array nextelement ll $s]
      if {$ll($n) < $w} {
	set c $n
	set w $ll($n)
      }
    }
    if {[string equal $c $to]} { return [list $p($to) $ll($to)] }
    set l($c) $ll($c)
    unset ll($c)
  }
}

# --- weight-hops A B ---
#
# shortest-path weight function giving each hop the same weight.

proc weight-hops {from to} {
  return 1
}

# --- weight-fuel A B ---
#
# shortest-path weight function measuring the distance between FROM and TO.

proc weight-fuel {from 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} {
  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} {
  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} {
  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} {
  switch -regexp -- $g {
    {^[1-8]$} { return [list $g [galaxy $g]] }
    {^[0-9a-fA-F]{12}$} { return [list $g $g] }
    default {
      if {[regexp {^([0-9a-fA-F]{12}):([1-8])$} $g . b n]} {
	return [list $g [galaxy $n $b]]
      }
    }
  }
  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} {
  if {[regexp {^[0-9a-fA-F]{12}$} $p]} { return $p }
  if {[regexp {^(.+)\.(.+)$} $p . g p]} {
    set g [parse-galaxy-spec $g]
    if {[string equal $g ""]} { return {} }
    destructure {. g} $g
    return [parse-planet-spec $g $p]
  }
  if {[regexp {^(0x[0-9a-fA-F]+|[0-9]+)$} $p]} {
    for {set s $g; set i 0} {$i < $p} {incr i; set s [elite-nextworld $s]} {}
    return $s
  }
  if {[regexp {^(0x[0-9a-fA-F]+|[0-9]+),\s*(0x[0-9a-fA-F]+|[0-9]+)$} \
      $p . x y]} {
    return [nearest-planet [elite-galaxylist $g] $x $y]
  }
  if {[regexp {^([^/]*)(?:/([1-9]\d*))?$} $p . p i]} {
    if {[string equal $i ""]} { set i 1 }
    set l [find-world $g $p]
    if {$i <= [llength $l]} { return [lindex $l [expr {$i - 1}]] }
  }
  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} {
  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}} {
  global eco gov
  elite-worldinfo p $s
  set is [string repeat " " $ind]
  set ss [string repeat " " $spc]
  return [format "%s%-8s%s %4d %4d %-11s %-10s %2d %s" \
      $is $p(name) $ss $p(x) $p(y) \
      $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} {
  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} {
  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.1"
Commit	Line	Data
1304202a	1	#! /usr/bin/tclsh
b130b8f5	2	#
6b8df360	3	# $Id$
1304202a	4
7da7c511	5	package require "elite-bits" "1.0.1"
1304202a	6
	7	set galaxy1 "4a5a480253b7" ;# Seed for standard galaxy 1
	8
	9	# --- tab ARR NAME NAME ... ---
	10	#
	11	# Construct an array mapping integers 0, 1, ... to the given NAMEs, in order.
	12
	13	proc tab {arr args} {
	14	upvar 1 $arr a
	15	set i 0
	16	foreach v $args {
	17	set a($i) $v
	18	incr i
	19	}
	20	}
	21
	22	# --- Various standard tables ---
	23
	24	tab government \
	25	"anarchy" "feudal" "multi-government" "dictatorship" \
	26	"communist" "confederacy" "democracy" "corporate state"
	27
	28	tab economy \
	29	"rich industrial" "average industrial" "poor industrial" \
	30	"mainly industrial" "mainly agricultural" "rich agricultural" \
	31	"average agricultural" "poor agricultural"
	32
	33	tab gov \
	34	anarchy feudal multi-gov dictator \
	35	communist confed democracy corp-state
	36
	37	tab eco \
83b4563b	38	rich-ind avg-ind poor-ind mainly-ind \
83b4563b	39	mainly-agri rich-agri avg-agri poor-agri
1304202a	40
6b8df360	41	tab gv Ay Fl MG Dp Ct Cy Dy CS
	42	tab ec RI AI PI MI MA RA AA PA
	43
1304202a	44	set products {
	45	food "Food"
	46	textiles "Textiles"
	47	radioactives "Radioactives"
	48	slaves "Slaves"
	49	liquor-wines "Liquor & wines"
	50	luxuries "Luxuries"
	51	narcotics "Narcotics"
	52	computers "Computers"
	53	machinery "Machinery"
	54	alloys "Alloys"
	55	firearms "Firearms"
	56	furs "Furs"
	57	minerals "Minerals"
	58	gold "Gold"
	59	platinum "Platinum"
	60	gem-stones "Gem-stones"
	61	alien-items "Alien items"
	62	}
	63
	64	foreach p $products { set unit($p) t }
	65	foreach p {gold platinum} { set unit($p) kg }
	66	set unit(gem-stones) g
	67	unset p
	68
	69	# --- galaxy N [GAL] ---
	70	#
	71	# Compute the seed of the Nth galaxy, if GAL is the seed of galaxy 1. By
	72	# default, GAL is the standard galaxy 1 seed.
	73
	74	proc galaxy [list n [list g $galaxy1]] {
	75	for {set i 1} {$i < $n} {incr i} {
	76	set g [elite-nextgalaxy $g]
	77	}
	78	return $g
	79	}
	80
	81	# --- foreach-world GAL ARR SCRIPT ---
	82	#
	83	# For each world in galaxy GAL (a seed), set ARR to the world information
	84	# and evaluate SCRIPT. The usual loop control commands can be used in
	85	# SCRIPT.
	86
	87	proc foreach-world {g p act} {
	88	upvar 1 $p pp
	89	for {set i 0} {$i < 256} {incr i; set g [elite-nextworld $g]} {
	90	elite-worldinfo pp $g
	91	uplevel 1 $act
	92	}
	93	}
	94
	95	# --- find-world GAL PAT ---
	96	#
	97	# Return a list of seeds for the worlds in galaxy GAL (a seed) whose names
	98	# match the glob pattern PAT.
	99
	100	proc find-world {g pat} {
	101	set l {}
	102	foreach-world $g p {
	103	if {[string match -nocase $pat $p(name)]} {
	104	lappend l $p(seed)
	105	}
	106	}
	107	return $l
108	}
109
110	# --- destructure PAT LIST ---
111	#
112	# Destrcture LIST according to PAT. If PAT is a single name, set the
113	# variable PAT to LIST; otherwise, if PAT is a list, each of its elements
114	# must correspond to an element of LIST, so recursively destructure the
115	# corresponding elements of each. It is not an error if the PAT list is
116	# shorter than LIST. The special variable name `.' indicates that no
117	# assignment is to be made.
118
119	proc destructure {pp xx} {
120	if {![string compare $pp "."]} {
121	return
122	} elseif {[llength $pp] == 0} {
123	return
124	} elseif {[llength $pp] == 1} {
125	upvar 1 $pp p
126	set p $xx
127	} else {
128	foreach p $pp x $xx {
129	uplevel 1 [list destructure $p $x]
130	}
131	}
132	}
133
1ded87ba	134	# --- write-file NAME CONTENTS [TRANS] ---
	135	#
	136	# Write file NAME, storing CONTENTS translated according to TRANS (default
	137	# `binary'. The write is safe against errors -- we don't destroy the old
	138	# data until the file is written.
	139
	140	proc write-file {name contents {trans binary}} {
	141	if {[file exists $name]} {
	142	if {[set rc [catch { file copy -force $name "$name.old" } err]]} {
	143	return -code $rc $err
	144	}
	145	}
	146	if {[set rc [catch {
	147	set f [open $name w]
	148	fconfigure $f -translation $trans
	149	puts -nonewline $f $contents
	150	close $f
	151	} err]]} {
	152	catch { close $f }
	153	catch { file rename -force "$name.old" $name }
	154	return -code $rc $err
	155	}
	156	return ""
	157	}
	158
	159	# --- read-file NAME [TRANS] ---
	160	#
	161	# Read the contents of the file NAME, translating it according to TRANS
	162	# (default `binary').
	163
	164	proc read-file {name {trans binary}} {
	165	set f [open $name]
	166	fconfigure $f -translation $trans
	167	set c [read $f]
	168	close $f
	169	return $c
	170	}
	171
1304202a	172	# --- nearest-planet WW X Y ---
	173	#
	174	# Returns the seed of the `nearest' planet given in the worldinfo list WW to
	175	# the point X Y (in decilightyears).
	176
	177	proc nearest-planet {ww x y} {
	178	set min 10000
	179	foreach {ss xx yy} $ww {
	180	set dx [expr {abs($x - $xx)/4}]
	181	set dy [expr {abs($y - $yy)/2}]
	182	if {$dx > $dy} {
	183	set d [expr {($dx * 2 + $dy)/2}]
	184	} else {
	185	set d [expr {($dx + $dy * 2)/2}]
	186	}
	187	if {$d < $min} {
	188	set p $ss
	189	set min $d
	190	}
	191	}
	192	return $p
	193	}
	194
1304202a	195	# --- worldname W ---
	196	#
	197	# Returns the name of the world with seed W.
	198
	199	proc worldname {w} {
	200	elite-worldinfo p $w
	201	return $p(name)
	202	}
	203
	204	# --- shortest-path ADJ FROM TO WEIGHT ---
	205	#
	206	# Computes the shortest path and shortest distance between the worlds wose
	207	# seeds are FROM and TO respectively. ADJ must be an adjacency table for the
	208	# galaxy containing FROM and TO. WEIGHT is a command such that WEIGHT A B
	209	# returns the `distance' for the simple path between A and B. The return
	210	# value is a list P D, where D is the weight of the path found, and P is a
	211	# simple list of seeds for the worlds on the path. P starts with FROM and
	212	# ends with TO.
	213
	214	proc shortest-path {adjvar from to weight} {
	215	upvar 1 $adjvar adj
	216	if {[string equal $from $to]} { return [list $to 0] }
	217	set l($from) 0
	218	set p($from) $from
	219	set c $from
	220	while 1 {
	221	foreach {n x y} $adj($c) {
	222	if {[info exists l($n)]} {
	223	continue
	224	}
	225	set w [expr {$l($c) + [uplevel 1 $weight [list $c $n]]}]
	226	if {![info exists ll($n)] \|\| $w < $ll($n)} {
	227	set ll($n) $w
	228	set p($n) [concat $p($c) [list $n]]
	229	}
	230	}
	231	set s [array startsearch ll]
	232	if {![array anymore ll $s]} {
	233	return {{} 0}
	234	}
	235	set c [array nextelement ll $s]
	236	set w $ll($c)
	237	while {[array anymore ll $s]} {
	238	set n [array nextelement ll $s]
	239	if {$ll($n) < $w} {
	240	set c $n
	241	set w $ll($n)
	242	}
	243	}
	244	if {[string equal $c $to]} { return [list $p($to) $ll($to)] }
	245	set l($c) $ll($c)
	246	unset ll($c)
	247	}
	248	}
	249
	250	# --- weight-hops A B ---
	251	#
	252	# shortest-path weight function giving each hop the same weight.
	253
	254	proc weight-hops {from to} {
	255	return 1
	256	}
	257
	258	# --- weight-fuel A B ---
259	#
260	# shortest-path weight function measuring the distance between FROM and TO.
261
262	proc weight-fuel {from to} {
263	elite-worldinfo f $from
264	elite-worldinfo t $to
7da7c511	265	return [elite-distance $f(x) $f(y) $t(x) $t(y)]
1304202a	266	}
	267
	268	# --- weight-safety A B ---
	269	#
	270	# shortest-path weight function attempting to maximize safety of the journey
	271	# by giving high weight (square-law) to worlds with unstable governments.
	272
	273	proc weight-safety {from to} {
	274	elite-worldinfo t $to
	275	set w [expr {8 - $t(government)}]
	276	return [expr {$w * $w}]
	277	}
	278
	279	# --- weight-encounters A B ---
	280	#
	281	# shortest-path weight function attempting to maximize encounters on the
	282	# journey by giving high weight (square law) to worlds with stable
	283	# governments.
	284
	285	proc weight-encounters {from to} {
	286	elite-worldinfo f $from
	287	elite-worldinfo t $to
	288	set w [expr {1 + $t(government)}]
	289	return [expr {$w * $w}]
	290	}
	291
	292	# --- weight-trading A B ---
	293	#
	294	# shortest-path weight function attempting to maximize trading opportunities
	295	# along the journey by giving high weight (square law) to pairs of worlds
	296	# with small differences between their economic statuses.
	297
	298	proc weight-trading {from to} {
	299	elite-worldinfo f $from
	300	elite-worldinfo t $to
	301	set w [expr {8 - abs($f(economy) - $t(economy))}]
	302	return [expr {$w * $w}]
	303	}
	304
	305	# --- parse-galaxy-spec G ---
	306	#
	307	# Parses a galaxy spec and returns a list containing a description of the
	308	# galaxy and the corresponding galaxy seed. A galaxy spec is one of:
	309	#
	310	# * a number between 1 and 8, corresponding to one of the standard
	311	# galaxies;
	312	#
	313	# * a 12-digit hex string, which is a galaxy seed (and is returned
	314	# unchanged); or
	315	#
	316	# * a string of the form S:N where S is a 12-hex-digit seed and N is a
	317	# galaxy number, corresponding to the Nth galaxy starting with S as
	318	# galaxy 1.
	319	#
	320	# If the string is unrecognized, an empty list is returned.
	321
	322	proc parse-galaxy-spec {g} {
	323	switch -regexp -- $g {
	324	{^[1-8]$} { return [list $g [galaxy $g]] }
	325	{^[0-9a-fA-F]{12}$} { return [list $g $g] }
	326	default {
	327	if {[regexp {^([0-9a-fA-F]{12}):([1-8])$} $g . b n]} {
	328	return [list $g [galaxy $n $b]]
	329	}
330	}
331	}
332	return {}
333	}
334
335	# --- parse-planet-spec G P ---
336	#
337	# Parses a planet spec and returns the planet seed. The planet spec P is
338	# interpreted relative to galaxy G. A planet spec is one of:
339	#
340	# * a simple integer, corresponding to a planet number;
341	#
342	# * a 12-hex-digit seed, which is returned unchanged;
343	#
344	# * a pair of integers separated by commas, corresponding to the nearest
345	# planet to those coordinates;
346	#
347	# * a glob pattern, corresponding to the lowest-numbered planet in the
348	# galaxy whose name matches the pattern case-insensitively; or
349	#
350	# * a string of the form G.P where G is a galaxy spec and P is a planet
351	# spec, corresponding to the planet specified by P relative to galaxy G.
352	#
353	# If the string is unrecognized, an empty string is returned.
354
355	proc parse-planet-spec {g p} {
356	if {[regexp {^[0-9a-fA-F]{12}$} $p]} { return $p }
357	if {[regexp {^(.+)\.(.+)$} $p . g p]} {
358	set g [parse-galaxy-spec $g]
359	if {[string equal $g ""]} { return {} }
360	destructure {. g} $g
361	return [parse-planet-spec $g $p]
362	}
363	if {[regexp {^(0x[0-9a-fA-F]+\|[0-9]+)$} $p]} {
364	for {set s $g; set i 0} {$i < $p} {incr i; set s [elite-nextworld $s]} {}
365	return $s
366	}
367	if {[regexp {^(0x[0-9a-fA-F]+\|[0-9]+),\s*(0x[0-9a-fA-F]+\|[0-9]+)$} \
368	$p . x y]} {
7da7c511	369	return [nearest-planet [elite-galaxylist $g] $x $y]
	370	}
	371	if {[regexp {^([^/])(?:/([1-9]\d))?$} $p . p i]} {
	372	if {[string equal $i ""]} { set i 1 }
	373	set l [find-world $g $p]
	374	if {$i <= [llength $l]} { return [lindex $l [expr {$i - 1}]] }
1304202a	375	}
1304202a	376	return {}
	377	}
	378
	379	# --- in-galaxy-p G PP ---
	380	#
	381	# Returns nonzero if the planets (seeds) listed in PP are in galaxy G.
	382	# Doesn't mind if the planet seeds are invalid.
	383
	384	proc in-galaxy-p {g pp} {
	385	foreach-world $g i { set x($i(seed)) 1 }
	386	foreach p $pp { if {![info exists x($p)]} { return 0 } }
	387	return 1
	388	}
	389
	390	# --- world-summary PLANET ---
	391	#
	392	# Return a one-line summary string for PLANET.
	393
7da7c511	394	proc world-summary {s {ind 0} {spc 0}} {
1304202a	395	global eco gov
1304202a	396	elite-worldinfo p $s
7da7c511	397	set is [string repeat " " $ind]
	398	set ss [string repeat " " $spc]
	399	return [format "%s%-8s%s %4d %4d %-11s %-10s %2d %s" \
	400	$is $p(name) $ss $p(x) $p(y) \
1304202a	401	$eco($p(economy)) $gov($p(government)) $p(techlevel) $p(seed)]
	402	}
	403
6b8df360	404	# --- world-brief PLANET ---
	405	#
	406	# Return a very brief summary string for PLANET.
	407
	408	proc world-brief {s} {
	409	global gv ec
	410	elite-worldinfo p $s
	411	return [format "%-8s (%s, %s, %2d)" \
	412	$p(name) $ec($p(economy)) $gv($p(government)) $p(techlevel)]
	413	}
	414
1ded87ba	415	# --- jameson ARR ---
	416	#
	417	# Fill ARR with the information about commander JAMESON.
	418
	419	proc jameson {arr} {
	420	global galaxy1 products
	421	upvar 1 $arr cmdr
	422	array set cmdr {
	423	mission 0
	424	credits 1000
	425	fuel 70
	426	gal-number 1
	427	front-laser 0x0f
	428	rear-laser 0
	429	left-laser 0
	430	right-laser 0
	431	cargo 20
	432	missiles 3
	433	legal-status 0
	434	score 0
	435	market-fluc 0
	436	}
	437	set cmdr(gal-seed) $galaxy1
	438	foreach i {
	439	ecm fuel-scoop energy-bomb energy-unit docking-computer
	440	gal-hyperdrive escape-pod
	441	} { set cmdr($i) 0 }
	442	elite-worldinfo lave [find-world $galaxy1 "Lave"]
	443	set cmdr(world-x) [expr {$lave(x)/4}]
	444	set cmdr(world-y) [expr {$lave(y)/2}]
	445	elite-market mkt $lave(seed) 0
	446	foreach {t n} $products {
	447	destructure [list . cmdr(station-$t)] $mkt($t)
	448	set cmdr(hold-$t) 0
	449	}
	450	set cmdr(station-alien-items) 0
	451	}
	452
1304202a	453	#----- That's all, folks ----------------------------------------------------
1304202a	454
7da7c511	455	package provide "elite" "1.0.1"