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

   1 #! /usr/bin/tclsh
   2 #
   3 # $Id: elite-path,v 1.3 2003/03/04 10:26:18 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 set acc distance
  11 for {set i 0} {$i < [llength $argv]} {incr i} {
  12   set a [lindex $argv $i]
  13   switch -glob -- $a {
  14     "-g" {
  15       incr i
  16       set a [lindex $argv $i]
  17       set g [parse-galaxy-spec $a]
  18       if {[string equal $g ""]} {
  19         puts stderr "$argv0: bad galaxy string `$a'"
  20         exit 1
  21       }
  22       destructure {ng g} $g
  23     }
  24     "-w" {
  25       incr i
  26       set a [lindex $argv $i]
  27       set weight "weight-$a"
  28       if {[lsearch -exact [info commands "weight-*"] $weight] == -1} {
  29         puts stderr "$argv0: unknown weight function `$a'"
  30         puts stderr "$argv0: I know [info commands weight-*]"
  31         exit 1
  32       }
  33     }
  34     "-a" {
  35       incr i
  36       set a [lindex $argv $i]
  37       switch -exact -- $a {
  38         "none" - "distance" - "weight" { set acc $a }
  39         default {
  40           puts stderr "$argv0: unknown accumulation `$a'"
  41           puts stderr "$argv0: I know `none', `distance' and `weight'"
  42         }
  43       }
  44     }
  45     "--" {
  46       incr i
  47       break
  48     }
  49     "-*" {
  50       puts stderr "unknown switch `$a'"
  51       exit 1
  52     }
  53     default {
  54       break
  55     }
  56   }
  57 }
  58
  59 set r {}
  60 set ww [worldinfo $g]
  61 foreach-world $g ii {
  62   set px($ii(seed)) 1
  63 }
  64 foreach a [lrange $argv $i end] {
  65   set s [parse-planet-spec $g $a]
  66   if {[string equal $s ""]} {
  67     puts stderr "$argv0: unknown planet `$a'"
  68     exit 1
  69   }
  70   if {![info exists px($s)]} {
  71     puts stderr "$argv0: planet `$a' doesn't exist in galaxy $ng"
  72     exit 1
  73   }
  74   lappend r $s
  75 }
  76 if {[llength $r] < 2} {
  77   puts stderr "usage: $argv0 \[-g GALAXY\] \[-w WEIGHT\] \[-a ACC\] PLANET PLANET ..."
  78   exit 1
  79 }
  80 puts -nonewline stderr "\[computing adjacency table..."
  81 adjacency $ww adj
  82 puts stderr " done\]"
  83 set home [lindex $r 0]
  84 set start $home
  85 set rt {}
  86 set tm 0
  87 foreach w [lrange $r 1 end] {
  88   destructure {p m} [shortest-path adj $home $w $weight]
  89   if {![llength $p]} {
  90     puts -stderr "$argv0: no route from [worldinfo $home] to [worldinfo $w]"
  91     exit 1
  92   }
  93   set tm [expr {$tm + $m}]
  94   eval lappend rt $p
  95   set home $w
  96 }
  97 puts [format "  1 %s" [world-summary $start]]
  98 set last $start
  99 unset p
 100 elite-worldinfo p $start
 101 destructure {x y} [list $p(x) $p(y)]
 102 set h 1
 103 set td 0
 104 set tw 0
 105 foreach s $rt {
 106   if {![string equal $s $last]} {
 107     elite-worldinfo p $s
 108     set d [expr {[world-distance $x $y $p(x) $p(y)]/10.0}]
 109     incr h
 110     set td [expr {$td + $d}]
 111     set summ [format "%3d %s" $h [world-summary $s]]
 112     set w [eval $weight [list $last $s]]
 113     set tw [expr {$tw + $w}]
 114     switch -- $acc {
 115       "none" { }
 116       "distance" {
 117         append summ [format " (+ %.1f = %.1f LY)" $d $td]
 118       }
 119       "weight" {
 120         append summ [format " (+ %s = %s)" $w $tw]
 121       }
 122     }
 123     puts $summ
 124     destructure {x y} [list $p(x) $p(y)]
 125     set last $s
 126   }
 127 }
 128 if {$tw != $tm} { error "inconsistent metric ($tw != $tm)" }
 129 set summ "("
 130 set sep ""
 131 if {![string equal $acc "distance"]} {
 132   append summ [format "%stotal distance = %.1f LY" $sep $td]
 133   set sep "; "
 134 }
 135 if {![string equal $weight "weight-hops"] && \
 136     ![string equal $weight "weight-fuel"] && \
 137     ![string equal $acc "weight"]} {
 138   append summ [format "%stotal metric = %s" $sep $tm]
 139 }
 140 append summ ")"
 141 if {![string equal $summ "()"]} { puts $summ }