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