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

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