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

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