mdw@git.distorted.org.uk Git - rocl/blob - elite-path

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