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

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