X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/rocl/blobdiff_plain/1304202ad2001c85d3eae3a37c51e001794c24c8..856cfd5372e79d637d0bd6b5fb6ab57c859b6222:/elite-map

diff --git a/elite-map b/elite-map
index 7ae2044..d1908c7 100755
--- a/elite-map
+++ b/elite-map
@@ -1,4 +1,6 @@
 #! /usr/bin/tclsh
+#
+# $Id: elite-map,v 1.4 2003/03/07 00:41:46 mdw Exp $
 
 package require "elite" "1.0.0"
 
@@ -13,12 +15,37 @@ proc symbol {i} {
   return [string index $syms $hi][string index $syms $lo]
 }
 
-proc show-map {asp wx wy ww {n ""}} {
+proc show-map {asp wx wy ww {n {}} {p {}}} {
   set minx 10000
   set miny 10000
   set maxx 0
   set maxy 0
 
+  set lmain {}
+  set lmagic {}
+  set lpath {}
+  if {[llength $n] == 1} {
+    set w [lindex $n 0]
+    set fancy($w) "*"
+    lappend lmagic $fancy($w) $w
+  } else {
+    set i 0
+    foreach w $n {
+      if {![info exists fancy($w)]} {
+	set fancy($w) "*[symbol $i]"
+	lappend lmagic $fancy($w) $w
+	incr i
+      }
+    }
+  }
+  set i 0
+  foreach w $p {
+    if {![info exists fancy($w)]} {
+      set fancy($w) "+[symbol $i]"
+      lappend lpath $fancy($w) $w
+      incr i
+    }
+  }
   foreach {s x y} $ww {
     if {$x < $minx} { set minx $x}
     if {$y < $miny} { set miny $y}
@@ -46,7 +73,6 @@ proc show-map {asp wx wy ww {n ""}} {
   set x 0
   set y 0
   set i 0
-  set l {}
   foreach w $pw {
     destructure {s px py} $w
     if {$y < $py} {
@@ -58,56 +84,45 @@ proc show-map {asp wx wy ww {n ""}} {
       puts -nonewline [string repeat " " [expr {$px - $x}]]
       set x $px
     }
-    if {[string equal $s $n]} {
-      set sy "*"
+    set l lmain
+    if {[info exists fancy($s)]} {
+      set sy $fancy($s)
     } else {
       set sy [symbol $i]
+      lappend $l $sy $s
       incr i
     }
     puts -nonewline $sy
     incr x [string length $sy]
-    lappend l $sy $s
   }
   puts -nonewline "\n"
-  return $l
+  return [list $lmagic $lpath $lmain]
 }
 
-proc show-key {l n} {
+proc show-key {l {n {}}} {
   global gov eco
-  if {![string equal $n ""]} {
-    elite-worldinfo p $n
+  if {[llength $n]} {
+    elite-worldinfo p [lindex $n 0]
   }
   foreach {sy s} $l {
     elite-worldinfo pp $s
     set out [format "%2s %s" $sy [world-summary $s]]
-    if {![string equal $n ""]} {
+    if {[llength $n]} {
       append out [format " (%.1f LY)" \
-	[expr {[world-distance $p(x) $p(y) $pp(x) $pp(y)]/10.0}]]
+	[expr {[elite-distance $p(x) $p(y) $pp(x) $pp(y)]/10.0}]]
     }
     puts $out
   }
 }
 
-proc local-area {g d n} {
-  set ww [worldinfo $g]
-  elite-worldinfo p $n
-
-  set w {}
-  foreach {s x y} $ww {
-    if {abs($p(x) - $x) > $d + 10 || abs($p(y) - $y) > $d + 10 ||
-        [world-distance $p(x) $p(y) $x $y] > $d} { continue }
-    lappend w $s $x $y
-  }
-  return $w
-}
-
 set g $galaxy1
 set wx 72
 set wy 10
 set asp 2.17
 set d 70
-set v 1
-set usage "usage: $argv0 \[-qv\] \[-g GAL\] \[-d DIST\] \[-w WD,HT\] \[-a ASP\] \[PLANET\]"
+set v 2
+set weight {}
+set usage "usage: $argv0 \[-qv\] \[-g GAL\] \[-d DIST\] \[-w WEIGHT\]\n\t\[-W WD,HT\] \[-a ASP\] \[PLANET ...\]"
 for {set i 0} {$i < [llength $argv]} {incr i} {
   set a [lindex $argv $i]
   switch -glob -- $a {
@@ -123,15 +138,25 @@ for {set i 0} {$i < [llength $argv]} {incr i} {
     }
     "-d" {
       incr i
-      set d [expr {[lindex $argv $i] * 10}]
+      set d [expr {int([lindex $argv $i] * 10)}]
     }
-    "-w" {
+    "-W" {
       incr i
       if {![regexp {^(\d+),(\d+)$} [lindex $argv $i] . wx wy]} {
 	puts stderr "$argv0: bad window size string"
 	exit 1
       }
     }
+    "-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 asp [lindex $argv $i]
@@ -157,27 +182,72 @@ for {set i 0} {$i < [llength $argv]} {incr i} {
 }
 
 set p [lrange $argv $i end]
-switch -exact [llength $p] {
-  0 {
-    set n ""
-    set w [worldinfo $g]
-    incr v -1
-  }
-  1 {
-    set n [parse-planet-spec $g $a]
-    if {[string equal $n ""]} {
+set ww [elite-galaxylist $g]
+if {![llength $p]} {
+  set n {}
+  set rt {}
+  set w $ww
+  incr v -1
+} else {
+  if {![string equal $weight ""]} { elite-adjacency adj $ww $d }
+  set n {}
+  foreach a $p {
+    set s [parse-planet-spec $g $a]
+    if {[string equal $s ""]} {
       puts stderr "$argv0: unknown planet `$a'"
       exit 1
     }
-    set w [local-area $g $d $n]
+    lappend n $s
+  }
+  set rt {}
+  if {![string equal $weight ""]} {
+    set home [lindex $n 0]
+    foreach w [lrange $n 1 end] {
+      destructure {p .} [shortest-path adj $home $w $weight]
+      if {![llength $p]} {
+	puts stderr \
+	    "$argv0: no route from [worldname $home] to [worldname $w]"
+	exit 1
+      }
+      eval lappend rt $p
+      set home $w
+    }
   }
-  default {
-    puts stderr $usage
-    exit 1
+  set x0 1024
+  set y0 1024
+  set x1 0
+  set y1 0
+  set w {}
+  foreach p [concat $n $rt] {
+    elite-worldinfo ii $p
+    if {$ii(x) < $x0} { set x0 $ii(x) }
+    if {$ii(y) < $y0} { set y0 $ii(y) }
+    if {$ii(x) > $x1} { set x1 $ii(x) }
+    if {$ii(y) > $y1} { set y1 $ii(y) }
+  }
+  set x0 [expr {$x0 - $d - 5}]
+  set y0 [expr {$y0 - $d - 5}]
+  set x1 [expr {$x1 + $d + 5}]
+  set y1 [expr {$y1 + $d + 5}]
+  set w {}
+  foreach {p x y} $ww {
+    if {$x >= $x0 && $y >= $y0 && $x <= $x1 && $y <= $y1} {
+      lappend w $p $x $y
+    }
   }
-}    
-set l [show-map $asp $wx $wy $w $n]
+}
+destructure {lmagic lpath lmain} [show-map $asp $wx $wy $w $n $rt]
 if {$v > 0} {
   puts ""
-  show-key $l $n
+  show-key $lmagic $n
+}
+if {$v > 1} {
+  if {[string equal $weight ""]} {
+    show-key $lmain $n
+  } else {
+    show-key $lpath $n
+    if {$v > 2} {
+      show-key $lmain $n
+    }
+  }
 }