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