#! /usr/bin/tclsh
+#
+# $Id: elite-map,v 1.4 2003/03/07 00:41:46 mdw Exp $
package require "elite" "1.0.0"
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}
set x 0
set y 0
set i 0
- set l {}
foreach w $pw {
destructure {s px py} $w
if {$y < $py} {
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 {
}
"-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]
}
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
}
- default {
- puts stderr $usage
- exit 1
+ 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
+ }
+ }
+ 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 l [show-map $asp $wx $wy $w $n]
+ 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
+ }
+ }
+}
+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
+ }
+ }
+}
+
+
+
\ No newline at end of file
~mdw / rocl / blobdiff