#! /usr/bin/tclsh # # $Id: elite-map,v 1.3 2003/02/26 01:12:57 mdw Exp $ package require "elite" "1.0.0" set syms "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" proc symbol {i} { global syms if {$i < [string length $syms]} { return [string index $syms $i] } set hi [expr {$i / [string length $syms]}] set lo [expr {$i % [string length $syms]}] return [string index $syms $hi][string index $syms $lo] } 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} if {$x > $maxx} { set maxx $x} if {$y > $maxy} { set maxy $y} } set dx [expr {$maxx - $minx}] set dy [expr {$maxy - $miny}] if {$dx == 0} { set dx 1 } if {$dy == 0} { set dy 1 } set sc [expr {$wx/double($dx)}] if {$dy * $sc/$asp > $wy} { set sc [expr {$wy * $asp/double($dy)}] } set gw {} foreach {s x y} $ww { set gx [expr {int(($x - $minx) * $sc + 0.5)}] set gy [expr {int(($y - $miny) * $sc/$asp + 0.5)}] lappend gw [list $s $gx $gy] } set pw [lsort -index 1 -integer -increasing $gw] set pw [lsort -index 2 -integer -increasing $pw] set x 0 set y 0 set i 0 foreach w $pw { destructure {s px py} $w if {$y < $py} { puts -nonewline [string repeat "\n" [expr {$py - $y}]] set x 0 set y $py } if {$x < $px} { puts -nonewline [string repeat " " [expr {$px - $x}]] set x $px } 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] } puts -nonewline "\n" return [list $lmagic $lpath $lmain] } proc show-key {l {n {}}} { global gov eco 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 {[llength $n]} { append out [format " (%.1f LY)" \ [expr {[world-distance $p(x) $p(y) $pp(x) $pp(y)]/10.0}]] } puts $out } } set g $galaxy1 set wx 72 set wy 10 set asp 2.17 set d 70 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 { "-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 {. g} $g } "-d" { incr i set d [expr {[lindex $argv $i] * 10}] } "-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] } "-v" { incr v } "-q" { incr v -1 } "--" { incr i break } "-*" { puts stderr $usage exit 1 } default { break } } } set p [lrange $argv $i end] set ww [worldinfo $g] if {![llength $p]} { set n {} set rt {} set w $ww incr v -1 } else { if {![string equal $weight ""]} { puts -nonewline stderr "\[computing adjacency table..." adjacency $ww adj puts stderr " done\]" } set n {} foreach a $p { set s [parse-planet-spec $g $a] if {[string equal $s ""]} { puts stderr "$argv0: unknown planet `$a'" exit 1 } 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 [worldinfo $home] to [worldinfo $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 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 $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 } } }