| 1 | #! /usr/bin/tclsh |
| 2 | # |
| 3 | # $Id: elite-map,v 1.2 2003/02/25 00:25:38 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 ""}} { |
| 19 | set minx 10000 |
| 20 | set miny 10000 |
| 21 | set maxx 0 |
| 22 | set maxy 0 |
| 23 | |
| 24 | foreach {s x y} $ww { |
| 25 | if {$x < $minx} { set minx $x} |
| 26 | if {$y < $miny} { set miny $y} |
| 27 | if {$x > $maxx} { set maxx $x} |
| 28 | if {$y > $maxy} { set maxy $y} |
| 29 | } |
| 30 | set dx [expr {$maxx - $minx}] |
| 31 | set dy [expr {$maxy - $miny}] |
| 32 | if {$dx == 0} { set dx 1 } |
| 33 | if {$dy == 0} { set dy 1 } |
| 34 | |
| 35 | set sc [expr {$wx/double($dx)}] |
| 36 | if {$dy * $sc/$asp > $wy} { |
| 37 | set sc [expr {$wy * $asp/double($dy)}] |
| 38 | } |
| 39 | set gw {} |
| 40 | foreach {s x y} $ww { |
| 41 | set gx [expr {int(($x - $minx) * $sc + 0.5)}] |
| 42 | set gy [expr {int(($y - $miny) * $sc/$asp + 0.5)}] |
| 43 | lappend gw [list $s $gx $gy] |
| 44 | } |
| 45 | |
| 46 | set pw [lsort -index 1 -integer -increasing $gw] |
| 47 | set pw [lsort -index 2 -integer -increasing $pw] |
| 48 | set x 0 |
| 49 | set y 0 |
| 50 | set i 0 |
| 51 | set l {} |
| 52 | foreach w $pw { |
| 53 | destructure {s px py} $w |
| 54 | if {$y < $py} { |
| 55 | puts -nonewline [string repeat "\n" [expr {$py - $y}]] |
| 56 | set x 0 |
| 57 | set y $py |
| 58 | } |
| 59 | if {$x < $px} { |
| 60 | puts -nonewline [string repeat " " [expr {$px - $x}]] |
| 61 | set x $px |
| 62 | } |
| 63 | if {[string equal $s $n]} { |
| 64 | set sy "*" |
| 65 | } else { |
| 66 | set sy [symbol $i] |
| 67 | incr i |
| 68 | } |
| 69 | puts -nonewline $sy |
| 70 | incr x [string length $sy] |
| 71 | lappend l $sy $s |
| 72 | } |
| 73 | puts -nonewline "\n" |
| 74 | return $l |
| 75 | } |
| 76 | |
| 77 | proc show-key {l n} { |
| 78 | global gov eco |
| 79 | if {![string equal $n ""]} { |
| 80 | elite-worldinfo p $n |
| 81 | } |
| 82 | foreach {sy s} $l { |
| 83 | elite-worldinfo pp $s |
| 84 | set out [format "%2s %s" $sy [world-summary $s]] |
| 85 | if {![string equal $n ""]} { |
| 86 | append out [format " (%.1f LY)" \ |
| 87 | [expr {[world-distance $p(x) $p(y) $pp(x) $pp(y)]/10.0}]] |
| 88 | } |
| 89 | puts $out |
| 90 | } |
| 91 | } |
| 92 | |
| 93 | proc local-area {g d n} { |
| 94 | set ww [worldinfo $g] |
| 95 | elite-worldinfo p $n |
| 96 | |
| 97 | set w {} |
| 98 | foreach {s x y} $ww { |
| 99 | if {abs($p(x) - $x) > $d + 10 || abs($p(y) - $y) > $d + 10 || |
| 100 | [world-distance $p(x) $p(y) $x $y] > $d} { continue } |
| 101 | lappend w $s $x $y |
| 102 | } |
| 103 | return $w |
| 104 | } |
| 105 | |
| 106 | set g $galaxy1 |
| 107 | set wx 72 |
| 108 | set wy 10 |
| 109 | set asp 2.17 |
| 110 | set d 70 |
| 111 | set v 1 |
| 112 | set usage "usage: $argv0 \[-qv\] \[-g GAL\] \[-d DIST\] \[-w WD,HT\] \[-a ASP\] \[PLANET\]" |
| 113 | for {set i 0} {$i < [llength $argv]} {incr i} { |
| 114 | set a [lindex $argv $i] |
| 115 | switch -glob -- $a { |
| 116 | "-g" { |
| 117 | incr i |
| 118 | set a [lindex $argv $i] |
| 119 | set g [parse-galaxy-spec $a] |
| 120 | if {[string equal $g ""]} { |
| 121 | puts stderr "$argv0: bad galaxy string `$a'" |
| 122 | exit 1 |
| 123 | } |
| 124 | destructure {. g} $g |
| 125 | } |
| 126 | "-d" { |
| 127 | incr i |
| 128 | set d [expr {[lindex $argv $i] * 10}] |
| 129 | } |
| 130 | "-w" { |
| 131 | incr i |
| 132 | if {![regexp {^(\d+),(\d+)$} [lindex $argv $i] . wx wy]} { |
| 133 | puts stderr "$argv0: bad window size string" |
| 134 | exit 1 |
| 135 | } |
| 136 | } |
| 137 | "-a" { |
| 138 | incr i |
| 139 | set asp [lindex $argv $i] |
| 140 | } |
| 141 | "-v" { |
| 142 | incr v |
| 143 | } |
| 144 | "-q" { |
| 145 | incr v -1 |
| 146 | } |
| 147 | "--" { |
| 148 | incr i |
| 149 | break |
| 150 | } |
| 151 | "-*" { |
| 152 | puts stderr $usage |
| 153 | exit 1 |
| 154 | } |
| 155 | default { |
| 156 | break |
| 157 | } |
| 158 | } |
| 159 | } |
| 160 | |
| 161 | set p [lrange $argv $i end] |
| 162 | switch -exact [llength $p] { |
| 163 | 0 { |
| 164 | set n "" |
| 165 | set w [worldinfo $g] |
| 166 | incr v -1 |
| 167 | } |
| 168 | 1 { |
| 169 | set n [parse-planet-spec $g $a] |
| 170 | if {[string equal $n ""]} { |
| 171 | puts stderr "$argv0: unknown planet `$a'" |
| 172 | exit 1 |
| 173 | } |
| 174 | set w [local-area $g $d $n] |
| 175 | } |
| 176 | default { |
| 177 | puts stderr $usage |
| 178 | exit 1 |
| 179 | } |
| 180 | } |
| 181 | set l [show-map $asp $wx $wy $w $n] |
| 182 | if {$v > 0} { |
| 183 | puts "" |
| 184 | show-key $l $n |
| 185 | } |