| 1 | #! /usr/bin/tclsh |
| 2 | # |
| 3 | # $Id: elite-map,v 1.4 2003/03/07 00:41:46 mdw Exp $ |
| 4 | |
| 5 | package require "elite" "1.0.0" |
| 6 | |
| 7 | set syms "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" |
| 8 | proc symbol {i} { |
| 9 | global syms |
| 10 | if {$i < [string length $syms]} { |
| 11 | return [string index $syms $i] |
| 12 | } |
| 13 | set hi [expr {$i / [string length $syms]}] |
| 14 | set lo [expr {$i % [string length $syms]}] |
| 15 | return [string index $syms $hi][string index $syms $lo] |
| 16 | } |
| 17 | |
| 18 | proc show-map {asp wx wy ww {n {}} {p {}}} { |
| 19 | set minx 10000 |
| 20 | set miny 10000 |
| 21 | set maxx 0 |
| 22 | set maxy 0 |
| 23 | |
| 24 | set lmain {} |
| 25 | set lmagic {} |
| 26 | set lpath {} |
| 27 | if {[llength $n] == 1} { |
| 28 | set w [lindex $n 0] |
| 29 | set fancy($w) "*" |
| 30 | lappend lmagic $fancy($w) $w |
| 31 | } else { |
| 32 | set i 0 |
| 33 | foreach w $n { |
| 34 | if {![info exists fancy($w)]} { |
| 35 | set fancy($w) "*[symbol $i]" |
| 36 | lappend lmagic $fancy($w) $w |
| 37 | incr i |
| 38 | } |
| 39 | } |
| 40 | } |
| 41 | set i 0 |
| 42 | foreach w $p { |
| 43 | if {![info exists fancy($w)]} { |
| 44 | set fancy($w) "+[symbol $i]" |
| 45 | lappend lpath $fancy($w) $w |
| 46 | incr i |
| 47 | } |
| 48 | } |
| 49 | foreach {s x y} $ww { |
| 50 | if {$x < $minx} { set minx $x} |
| 51 | if {$y < $miny} { set miny $y} |
| 52 | if {$x > $maxx} { set maxx $x} |
| 53 | if {$y > $maxy} { set maxy $y} |
| 54 | } |
| 55 | set dx [expr {$maxx - $minx}] |
| 56 | set dy [expr {$maxy - $miny}] |
| 57 | if {$dx == 0} { set dx 1 } |
| 58 | if {$dy == 0} { set dy 1 } |
| 59 | |
| 60 | set sc [expr {$wx/double($dx)}] |
| 61 | if {$dy * $sc/$asp > $wy} { |
| 62 | set sc [expr {$wy * $asp/double($dy)}] |
| 63 | } |
| 64 | set gw {} |
| 65 | foreach {s x y} $ww { |
| 66 | set gx [expr {int(($x - $minx) * $sc + 0.5)}] |
| 67 | set gy [expr {int(($y - $miny) * $sc/$asp + 0.5)}] |
| 68 | lappend gw [list $s $gx $gy] |
| 69 | } |
| 70 | |
| 71 | set pw [lsort -index 1 -integer -increasing $gw] |
| 72 | set pw [lsort -index 2 -integer -increasing $pw] |
| 73 | set x 0 |
| 74 | set y 0 |
| 75 | set i 0 |
| 76 | foreach w $pw { |
| 77 | destructure {s px py} $w |
| 78 | if {$y < $py} { |
| 79 | puts -nonewline [string repeat "\n" [expr {$py - $y}]] |
| 80 | set x 0 |
| 81 | set y $py |
| 82 | } |
| 83 | if {$x < $px} { |
| 84 | puts -nonewline [string repeat " " [expr {$px - $x}]] |
| 85 | set x $px |
| 86 | } |
| 87 | set l lmain |
| 88 | if {[info exists fancy($s)]} { |
| 89 | set sy $fancy($s) |
| 90 | } else { |
| 91 | set sy [symbol $i] |
| 92 | lappend $l $sy $s |
| 93 | incr i |
| 94 | } |
| 95 | puts -nonewline $sy |
| 96 | incr x [string length $sy] |
| 97 | } |
| 98 | puts -nonewline "\n" |
| 99 | return [list $lmagic $lpath $lmain] |
| 100 | } |
| 101 | |
| 102 | proc show-key {l {n {}}} { |
| 103 | global gov eco |
| 104 | if {[llength $n]} { |
| 105 | elite-worldinfo p [lindex $n 0] |
| 106 | } |
| 107 | foreach {sy s} $l { |
| 108 | elite-worldinfo pp $s |
| 109 | set out [format "%2s %s" $sy [world-summary $s]] |
| 110 | if {[llength $n]} { |
| 111 | append out [format " (%.1f LY)" \ |
| 112 | [expr {[elite-distance $p(x) $p(y) $pp(x) $pp(y)]/10.0}]] |
| 113 | } |
| 114 | puts $out |
| 115 | } |
| 116 | } |
| 117 | |
| 118 | set g $galaxy1 |
| 119 | set wx 72 |
| 120 | set wy 10 |
| 121 | set asp 2.17 |
| 122 | set d 70 |
| 123 | set v 2 |
| 124 | set weight {} |
| 125 | set usage "usage: $argv0 \[-qv\] \[-g GAL\] \[-d DIST\] \[-w WEIGHT\]\n\t\[-W WD,HT\] \[-a ASP\] \[PLANET ...\]" |
| 126 | for {set i 0} {$i < [llength $argv]} {incr i} { |
| 127 | set a [lindex $argv $i] |
| 128 | switch -glob -- $a { |
| 129 | "-g" { |
| 130 | incr i |
| 131 | set a [lindex $argv $i] |
| 132 | set g [parse-galaxy-spec $a] |
| 133 | if {[string equal $g ""]} { |
| 134 | puts stderr "$argv0: bad galaxy string `$a'" |
| 135 | exit 1 |
| 136 | } |
| 137 | destructure {. g} $g |
| 138 | } |
| 139 | "-d" { |
| 140 | incr i |
| 141 | set d [expr {int([lindex $argv $i] * 10)}] |
| 142 | } |
| 143 | "-W" { |
| 144 | incr i |
| 145 | if {![regexp {^(\d+),(\d+)$} [lindex $argv $i] . wx wy]} { |
| 146 | puts stderr "$argv0: bad window size string" |
| 147 | exit 1 |
| 148 | } |
| 149 | } |
| 150 | "-w" { |
| 151 | incr i |
| 152 | set a [lindex $argv $i] |
| 153 | set weight "weight-$a" |
| 154 | if {[lsearch -exact [info commands "weight-*"] $weight] == -1} { |
| 155 | puts stderr "$argv0: unknown weight function `$a'" |
| 156 | puts stderr "$argv0: I know [info commands weight-*]" |
| 157 | exit 1 |
| 158 | } |
| 159 | } |
| 160 | "-a" { |
| 161 | incr i |
| 162 | set asp [lindex $argv $i] |
| 163 | } |
| 164 | "-v" { |
| 165 | incr v |
| 166 | } |
| 167 | "-q" { |
| 168 | incr v -1 |
| 169 | } |
| 170 | "--" { |
| 171 | incr i |
| 172 | break |
| 173 | } |
| 174 | "-*" { |
| 175 | puts stderr $usage |
| 176 | exit 1 |
| 177 | } |
| 178 | default { |
| 179 | break |
| 180 | } |
| 181 | } |
| 182 | } |
| 183 | |
| 184 | set p [lrange $argv $i end] |
| 185 | set ww [elite-galaxylist $g] |
| 186 | if {![llength $p]} { |
| 187 | set n {} |
| 188 | set rt {} |
| 189 | set w $ww |
| 190 | incr v -1 |
| 191 | } else { |
| 192 | if {![string equal $weight ""]} { elite-adjacency adj $ww $d } |
| 193 | set n {} |
| 194 | foreach a $p { |
| 195 | set s [parse-planet-spec $g $a] |
| 196 | if {[string equal $s ""]} { |
| 197 | puts stderr "$argv0: unknown planet `$a'" |
| 198 | exit 1 |
| 199 | } |
| 200 | lappend n $s |
| 201 | } |
| 202 | set rt {} |
| 203 | if {![string equal $weight ""]} { |
| 204 | set home [lindex $n 0] |
| 205 | foreach w [lrange $n 1 end] { |
| 206 | destructure {p .} [shortest-path adj $home $w $weight] |
| 207 | if {![llength $p]} { |
| 208 | puts stderr \ |
| 209 | "$argv0: no route from [worldname $home] to [worldname $w]" |
| 210 | exit 1 |
| 211 | } |
| 212 | eval lappend rt $p |
| 213 | set home $w |
| 214 | } |
| 215 | } |
| 216 | set x0 1024 |
| 217 | set y0 1024 |
| 218 | set x1 0 |
| 219 | set y1 0 |
| 220 | set w {} |
| 221 | foreach p [concat $n $rt] { |
| 222 | elite-worldinfo ii $p |
| 223 | if {$ii(x) < $x0} { set x0 $ii(x) } |
| 224 | if {$ii(y) < $y0} { set y0 $ii(y) } |
| 225 | if {$ii(x) > $x1} { set x1 $ii(x) } |
| 226 | if {$ii(y) > $y1} { set y1 $ii(y) } |
| 227 | } |
| 228 | set x0 [expr {$x0 - $d - 5}] |
| 229 | set y0 [expr {$y0 - $d - 5}] |
| 230 | set x1 [expr {$x1 + $d + 5}] |
| 231 | set y1 [expr {$y1 + $d + 5}] |
| 232 | set w {} |
| 233 | foreach {p x y} $ww { |
| 234 | if {$x >= $x0 && $y >= $y0 && $x <= $x1 && $y <= $y1} { |
| 235 | lappend w $p $x $y |
| 236 | } |
| 237 | } |
| 238 | } |
| 239 | destructure {lmagic lpath lmain} [show-map $asp $wx $wy $w $n $rt] |
| 240 | if {$v > 0} { |
| 241 | puts "" |
| 242 | show-key $lmagic $n |
| 243 | } |
| 244 | if {$v > 1} { |
| 245 | if {[string equal $weight ""]} { |
| 246 | show-key $lmain $n |
| 247 | } else { |
| 248 | show-key $lpath $n |
| 249 | if {$v > 2} { |
| 250 | show-key $lmain $n |
| 251 | } |
| 252 | } |
| 253 | } |
| 254 | |
| 255 | |
| 256 | |