chiark - git - mdw - rocl/blob - elite-reach

   1 #! /usr/bin/tclsh
   2 #
   3 # $Id: elite-reach,v 1.3 2003/03/07 00:41:46 mdw Exp $
   4
   5 package require "elite" "1.0.1"
   6
   7 proc reach {dist seed} {
   8   set ww [elite-galaxylist $seed]
   9   elite-adjacency a $ww $dist
  10   foreach {s x w} $ww { set p($s) 1 }
  11   set pp {}
  12   while 1 {
  13     set ps [array startsearch p]
  14     if {![array anymore p $ps]} { array donesearch p $ps; break }
  15     set cc [array nextelement p $ps]
  16     array donesearch p $ps
  17     unset p($cc)
  18     set go 1
  19     while {$go} {
  20       set go 0
  21       foreach c $cc {
  22         foreach w $a($c) {
  23           if {[info exists p($w)]} {
  24             unset p($w)
  25             lappend cc $w
  26             set go 1
  27           }
  28         }
  29       }
  30     }
  31     lappend pp $cc
  32   }
  33   foreach cc $pp {
  34     set de 1
  35     set l {}
  36     foreach c $cc {
  37       elite-worldinfo i $c
  38       if {$i(techlevel) >= 10} {
  39         set de 0
  40       }
  41       lappend l [world-summary $i(seed)]
  42     }
  43     foreach n $l {
  44       if {$de} { append n " *" }
  45       puts $n
  46     }
  47     puts ""
  48   }
  49 }
  50
  51 if {[llength $argv] == 0} {
  52   set argv {1 2 3 4 5 6 7 8}
  53 }
  54 set gg {}
  55 set d 70
  56 for {set i 0} {$i < [llength $argv]} {incr i} {
  57   set a [lindex $argv $i]
  58   switch -glob -- $a {
  59     "-d" {
  60       incr i
  61       set d [expr {int([lindex $argv $i] * 10)}]
  62     }
  63     "-*" {
  64       puts stderr "usage: $argv0 \[-d DIST\] \[GALAXY ...\]"
  65       exit 1
  66     }
  67     default {
  68       set g [parse-galaxy-spec $a]
  69       if {[string equal $g ""]} {
  70         puts stderr "$argv0: bad galaxy spec `$a'"
  71         exit 1
  72       }
  73       destructure {ng g} $g
  74       lappend gg $d $ng $g
  75     }
  76   }
  77 }
  78 foreach {d ng g} $gg {
  79   puts "*** GALAXY $ng ***"
  80   reach $d $g
  81 }