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

   1 #! /usr/bin/tclsh
   2 ###
   3 ### Determine the connected components of the various galaxies
   4 ###
   5 ### (c) 2003 Mark Wooding
   6 ###
   7
   8 ###----- Licensing notice ---------------------------------------------------
   9 ###
  10 ### This program is free software; you can redistribute it and/or modify
  11 ### it under the terms of the GNU General Public License as published by
  12 ### the Free Software Foundation; either version 2 of the License, or
  13 ### (at your option) any later version.
  14 ###
  15 ### This program is distributed in the hope that it will be useful,
  16 ### but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ### GNU General Public License for more details.
  19 ###
  20 ### You should have received a copy of the GNU General Public License
  21 ### along with this program; if not, write to the Free Software Foundation,
  22 ### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23
  24 package require "elite" "1.0.1"
  25
  26 ###--------------------------------------------------------------------------
  27 ### Support functions.
  28
  29 proc reach {dist seed} {
  30   ## Given a hyperspace range DIST and a galaxy SEED, determine and print the
  31   ## connected components of the reachability graph.
  32
  33   ## Determine the graph.  Throughout, we use world seeds as indices: a(W)
  34   ## maintains a list of worlds adjacent to W.  p(W) is set (to an
  35   ## uninteresting value) if it's awaiting tracing.  The algorithm is simple:
  36   ## repeatedly pick a world awaiting tracing, do a depth-first search of
  37   ## graph starting from the chosen world adding each one encountered to the
  38   ## current component and removing it from the waiting list.
  39   set ww [elite-galaxylist $seed]
  40   elite-adjacency a $ww $dist
  41   foreach {s x w} $ww { set p($s) 1 }
  42
  43   ## Initially there are no components.
  44   set pp {}
  45
  46   ## Iterate over the untraced worlds.
  47   while 1 {
  48
  49     ## Find an untraced world.  If there are none left then we're done.
  50     set ps [array startsearch p]
  51     if {![array anymore p $ps]} { array donesearch p $ps; break }
  52     set cc [array nextelement p $ps]
  53     array donesearch p $ps
  54
  55     ## Now we do the depth-first search.  For each world in $trace,
  56     ## accumulate the untraced worlds reachable from it, and add them to the
  57     ## component.  Do this until we stop tracing new worlds.
  58     set trace $cc
  59     unset p($cc)
  60     while {[llength $trace]} {
  61       set tt $trace; set trace {}
  62       foreach c $tt {
  63         foreach w $a($c) {
  64           if {[info exists p($w)]} {
  65             unset p($w)
  66             lappend trace $w
  67           }
  68         }
  69       }
  70       set cc [concat $cc $trace]
  71     }
  72
  73     ## We've finished the component.  Add it to the list.
  74     lappend pp $cc
  75   }
  76
  77   ## Output the components.
  78   foreach cc $pp {
  79
  80     ## Firstly, accumulate the summary data for all the worlds in the
  81     ## component.  Also, do dead-end analysis: if there's no world in the
  82     ## component with tech level 10 or higher then the component as a whole
  83     ## is a `dead end', and can't be escaped by buying a galactic hyperdrive
  84     ## (and you can't have one of those already, because you must have used
  85     ## it to reach the component in the first pace).
  86     set de 1
  87     set l {}
  88     foreach c $cc {
  89       elite-worldinfo i $c
  90       if {$i(techlevel) >= 10} { set de 0 }
  91       lappend l [world-summary $i(seed)]
  92     }
  93
  94     ## Secondly, output the component information.  Separate components using
  95     ## blank lines.
  96     foreach n $l {
  97       if {$de} { append n " *" }
  98       puts $n
  99     }
 100     puts ""
 101   }
 102 }
 103
 104 ###--------------------------------------------------------------------------
 105 ### Main program.
 106
 107 ## Parse the command line.  The default will be to scan all of the standard
 108 ## galaxies.
 109 if {[llength $argv] == 0} {
 110   set argv {1 2 3 4 5 6 7 8}
 111 }
 112 set gg {}
 113 set d 70
 114 for {set i 0} {$i < [llength $argv]} {incr i} {
 115   set a [lindex $argv $i]
 116   switch -glob -- $a {
 117     "-d" {
 118       incr i
 119       set d [expr {int([lindex $argv $i] * 10)}]
 120     }
 121     "-*" {
 122       puts stderr "usage: $argv0 \[-d DIST\] \[GALAXY ...\]"
 123       exit 1
 124     }
 125     default {
 126       set g [parse-galaxy-spec $a]
 127       if {[string equal $g ""]} {
 128         puts stderr "$argv0: bad galaxy spec `$a'"
 129         exit 1
 130       }
 131       destructure {ng g} $g
 132       lappend gg $d $ng $g
 133     }
 134   }
 135 }
 136
 137 ## Analyse the requested galaxies.
 138 foreach {d ng g} $gg {
 139   puts "*** GALAXY $ng ***"
 140   reach $d $g
 141 }
 142
 143 ###----- That's all, folks --------------------------------------------------