chiark / gitweb /
Ignore distribution files better.
[rocl] / elite-path
1 #! /usr/bin/tclsh
2 #
3 # $Id: elite-path,v 1.2 2003/02/25 00:25:38 mdw Exp $
4
5 package require "elite" "1.0.0"
6
7 set g $galaxy1
8 set ng 1
9 set weight weight-hops
10 for {set i 0} {$i < [llength $argv]} {incr i} {
11   set a [lindex $argv $i]
12   switch -glob -- $a {
13     "-g" {
14       incr i
15       set a [lindex $argv $i]
16       set g [parse-galaxy-spec $a]
17       if {[string equal $g ""]} {
18         puts stderr "$argv0: bad galaxy string `$a'"
19         exit 1
20       }
21       destructure {ng g} $g
22     }
23     "-w" {
24       incr i
25       set a [lindex $argv $i]
26       set weight "weight-$a"
27       if {[lsearch -exact [info commands "weight-*"] $weight] == -1} {
28         puts stderr "$argv0: unknown weight function `$a'"
29         puts stderr "$argv0: I know [info commands weight-*]"
30         exit 1
31       }
32     }
33     "--" {
34       incr i
35       break
36     }
37     "-*" {
38       puts stderr "unknown switch `$a'"
39       exit 1
40     }
41     default {
42       break
43     }
44   }
45 }
46
47 set r {}
48 set ww [worldinfo $g]
49 foreach-world $g ii {
50   set px($ii(seed)) 1
51 }
52 foreach a [lrange $argv $i end] {
53   set s [parse-planet-spec $g $a]
54   if {[string equal $s ""]} {
55     puts stderr "$argv0: unknown planet `$a'"
56     exit 1
57   }
58   if {![info exists px($s)]} {
59     puts stderr "$argv0: planet `$a' doesn't exist in galaxy $ng"
60     exit 1
61   }
62   lappend r $s
63 }
64 if {[llength $r] < 2} {
65   puts stderr "usage: $argv0 \[-g GALAXY\] \[-w WEIGHT\] PLANET PLANET ..."
66   exit 1
67 }
68 puts -nonewline stderr "\[computing adjacency table..."
69 adjacency $ww adj
70 puts stderr " done\]"
71 set home [lindex $r 0]
72 set rt {}
73 foreach w [lrange $r 1 end] {
74   destructure {p .} [shortest-path adj $home $w $weight]
75   if {![llength $p]} {
76     puts -stderr "$argv0: no route from [worldinfo $home] to [worldinfo $w]"
77     exit 1
78   }
79   eval lappend rt $p
80   set home $w
81 }
82 set last x
83 foreach s $rt {
84   if {![string equal $s $last]} {
85     puts [world-summary $s]
86     set last $s
87   }
88 }