Improve elite-prices a lot.

[rocl] / elite-reach

#! /usr/bin/tclsh
#
# $Id: elite-reach,v 1.3 2003/03/07 00:41:46 mdw Exp $

package require "elite" "1.0.1"

proc reach {dist seed} {
  set ww [elite-galaxylist $seed]
  elite-adjacency a $ww $dist
  foreach {s x w} $ww { set p($s) 1 }
  set pp {}
  while 1 {
    set ps [array startsearch p]
    if {![array anymore p $ps]} { array donesearch p $ps; break }
    set cc [array nextelement p $ps]
    array donesearch p $ps
    unset p($cc)
    set go 1
    while {$go} {
      set go 0
      foreach c $cc {
	foreach w $a($c) {
	  if {[info exists p($w)]} {
	    unset p($w)
	    lappend cc $w
	    set go 1
	  }
	}
      }
    }
    lappend pp $cc
  }
  foreach cc $pp {
    set de 1
    set l {}
    foreach c $cc {
      elite-worldinfo i $c
      if {$i(techlevel) >= 10} {
	set de 0
      }
      lappend l [world-summary $i(seed)]
    }
    foreach n $l {
      if {$de} { append n " *" }
      puts $n
    }
    puts ""
  }
}

if {[llength $argv] == 0} {
  set argv {1 2 3 4 5 6 7 8}
}
set gg {}
set d 70
for {set i 0} {$i < [llength $argv]} {incr i} {
  set a [lindex $argv $i]
  switch -glob -- $a {
    "-d" {
      incr i
      set d [expr {int([lindex $argv $i] * 10)}]
    }
    "-*" {
      puts stderr "usage: $argv0 \[-d DIST\] \[GALAXY ...\]"
      exit 1
    }
    default {
      set g [parse-galaxy-spec $a]
      if {[string equal $g ""]} {
	puts stderr "$argv0: bad galaxy spec `$a'"
	exit 1
      }
      destructure {ng g} $g
      lappend gg $d $ng $g
    }
  }
}
foreach {d ng g} $gg {
  puts "*** GALAXY $ng ***"
  reach $d $g
}