| | 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 -------------------------------------------------- |
~mdw / rocl / blame_incremental