Commit | Line | Data |
---|---|---|
1304202a | 1 | #! /usr/bin/tclsh |
5a74fac2 MW |
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. | |
1304202a | 23 | |
161e6ada | 24 | package require "elite" "1.0.1" |
1304202a | 25 | |
5a74fac2 MW |
26 | ###-------------------------------------------------------------------------- |
27 | ### Support functions. | |
28 | ||
1304202a | 29 | proc reach {dist seed} { |
5a74fac2 MW |
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. | |
161e6ada | 39 | set ww [elite-galaxylist $seed] |
40 | elite-adjacency a $ww $dist | |
1304202a | 41 | foreach {s x w} $ww { set p($s) 1 } |
5a74fac2 MW |
42 | |
43 | ## Initially there are no components. | |
1304202a | 44 | set pp {} |
5a74fac2 MW |
45 | |
46 | ## Iterate over the untraced worlds. | |
1304202a | 47 | while 1 { |
5a74fac2 MW |
48 | |
49 | ## Find an untraced world. If there are none left then we're done. | |
1304202a | 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 | |
5a74fac2 MW |
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 | |
1304202a | 59 | unset p($cc) |
5a74fac2 MW |
60 | while {[llength $trace]} { |
61 | set tt $trace; set trace {} | |
62 | foreach c $tt { | |
1304202a | 63 | foreach w $a($c) { |
64 | if {[info exists p($w)]} { | |
65 | unset p($w) | |
5a74fac2 | 66 | lappend trace $w |
1304202a | 67 | } |
68 | } | |
69 | } | |
5a74fac2 | 70 | set cc [concat $cc $trace] |
1304202a | 71 | } |
5a74fac2 MW |
72 | |
73 | ## We've finished the component. Add it to the list. | |
1304202a | 74 | lappend pp $cc |
75 | } | |
5a74fac2 MW |
76 | |
77 | ## Output the components. | |
1304202a | 78 | foreach cc $pp { |
5a74fac2 MW |
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). | |
1304202a | 86 | set de 1 |
87 | set l {} | |
88 | foreach c $cc { | |
89 | elite-worldinfo i $c | |
5a74fac2 | 90 | if {$i(techlevel) >= 10} { set de 0 } |
1304202a | 91 | lappend l [world-summary $i(seed)] |
92 | } | |
5a74fac2 MW |
93 | |
94 | ## Secondly, output the component information. Separate components using | |
95 | ## blank lines. | |
1304202a | 96 | foreach n $l { |
97 | if {$de} { append n " *" } | |
98 | puts $n | |
99 | } | |
100 | puts "" | |
101 | } | |
102 | } | |
103 | ||
5a74fac2 MW |
104 | ###-------------------------------------------------------------------------- |
105 | ### Main program. | |
106 | ||
107 | ## Parse the command line. The default will be to scan all of the standard | |
108 | ## galaxies. | |
1304202a | 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 | |
161e6ada | 119 | set d [expr {int([lindex $argv $i] * 10)}] |
1304202a | 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 | } | |
5a74fac2 MW |
136 | |
137 | ## Analyse the requested galaxies. | |
1304202a | 138 | foreach {d ng g} $gg { |
139 | puts "*** GALAXY $ng ***" | |
140 | reach $d $g | |
141 | } | |
5a74fac2 MW |
142 | |
143 | ###----- That's all, folks -------------------------------------------------- |