[rocl] / elite.tcl

#! /usr/bin/tclsh
#
# $Id: elite.tcl,v 1.6 2003/03/07 00:44:57 mdw Exp $

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

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)]
}

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