debian: Fix maintainer address.

[rocl] / elite-path

#! /usr/bin/tclsh
#
# $Id: elite-path,v 1.4 2003/03/07 00:42:10 mdw Exp $

package require "elite" "1.0.1"

set g $galaxy1
set ng 1
set weight weight-hops
set d 70
set acc distance
for {set i 0} {$i < [llength $argv]} {incr i} {
  set a [lindex $argv $i]
  switch -glob -- $a {
    "-g" {
      incr i
      set a [lindex $argv $i]
      set g [parse-galaxy-spec $a]
      if {[string equal $g ""]} {
	puts stderr "$argv0: bad galaxy string `$a'"
	exit 1
      }
      destructure {ng g} $g
    }
    "-d" {
      incr i
      set d [expr {int([lindex $argv $i] * 10)}]
    }
    "-w" {
      incr i
      set a [lindex $argv $i]
      set weight "weight-$a"
      if {[lsearch -exact [info commands "weight-*"] $weight] == -1} {
	puts stderr "$argv0: unknown weight function `$a'"
	puts stderr "$argv0: I know [info commands weight-*]"
	exit 1
      }
    }
    "-a" {
      incr i
      set a [lindex $argv $i]
      switch -exact -- $a {
	"none" - "distance" - "weight" { set acc $a }
	default {
	  puts stderr "$argv0: unknown accumulation `$a'"
	  puts stderr "$argv0: I know `none', `distance' and `weight'"
	}
      }
    }
    "--" {
      incr i
      break
    }
    "-*" {
      puts stderr "unknown switch `$a'"
      exit 1
    }
    default {
      break
    }
  }
}

set r {}
set ww [elite-galaxylist $g]
foreach-world $g ii {
  set px($ii(seed)) 1
}
foreach a [lrange $argv $i end] {
  set s [parse-planet-spec $g $a]
  if {[string equal $s ""]} {
    puts stderr "$argv0: unknown planet `$a'"
    exit 1
  }
  if {![info exists px($s)]} {
    puts stderr "$argv0: planet `$a' doesn't exist in galaxy $ng"
    exit 1
  }
  lappend r $s
}
if {[llength $r] < 2} {
  puts stderr "usage: $argv0 \[-g GAL\] \[-d DIST\] \[-w WEIGHT\] \[-a ACC\] PLANET PLANET ..."
  exit 1
}
elite-adjacency adj $ww $d
set home [lindex $r 0]
set start $home
set rt {}
set tm 0
foreach w [lrange $r 1 end] {
  destructure {p m} [shortest-path adj $home $w $weight]
  if {![llength $p]} {
    puts stderr "$argv0: no route from [worldname $home] to [worldname $w]"
    exit 1
  }
  set tm [expr {$tm + $m}]
  eval lappend rt $p
  set home $w
}
puts [format "  1 %s" [world-summary $start]]
set last $start
unset p
elite-worldinfo p $start
destructure {x y} [list $p(x) $p(y)]
set h 1
set td 0
set tw 0
foreach s $rt {
  if {![string equal $s $last]} {
    elite-worldinfo p $s
    set d [expr {[elite-distance $x $y $p(x) $p(y)]/10.0}]
    incr h
    set td [expr {$td + $d}]
    set summ [format "%3d %s" $h [world-summary $s]]
    set w [eval $weight [list $last $s]]
    set tw [expr {$tw + $w}]
    switch -- $acc {
      "none" { }
      "distance" {
	append summ [format " (+ %.1f = %.1f LY)" $d $td]
      }
      "weight" {
	append summ [format " (+ %s = %s)" $w $tw]
      }
    }
    puts $summ
    destructure {x y} [list $p(x) $p(y)]
    set last $s
  }
}
if {$tw != $tm} { error "inconsistent metric ($tw != $tm)" }
set summ "# ("
set sep ""
if {![string equal $acc "distance"]} {
  append summ [format "%stotal distance = %.1f LY" $sep $td]
  set sep "; "
}
if {![string equal $weight "weight-hops"] && \
    ![string equal $weight "weight-fuel"] && \
    ![string equal $acc "weight"]} {
  append summ [format "%stotal metric = %s" $sep $tm]
}
append summ ")"
if {![string equal $summ "# ()"]} { puts $summ }