chiark / gitweb /
Print seed -- it's useful.
[rocl] / elite-cmdr
CommitLineData
1ded87ba 1#! /usr/bin/tclsh
2
161e6ada 3package require "elite" "1.0.1"
1ded87ba 4
5if {[llength $argv] < 1} {
6 puts stderr "usage: $argv0 \[-OPTION | ATTR | ATTR=VALUE\] ..."
7 exit 1
8}
9jameson cmdr
10
11proc get/string {a} { global cmdr; return $cmdr($a) }
12proc dump/string {a} { global cmdr; return $cmdr($a) }
13proc set/string {a v} { global cmdr; set cmdr($a) $v }
14
15proc get/int {min max a} {
16 global cmdr
17 return [format "%d" [expr {$cmdr($a) + 0}]]
18}
19proc dump/int {min max a} {
20 global cmdr
21 return [format "%d" [expr {$cmdr($a) + 0}]]
22}
23proc set/int {min max a v} {
24 global cmdr
25 if {$v < $min || $v > $max} { error "value out of range" }
26 set cmdr($a) $v
27}
28
29proc get/tenth {min max a} {
30 global cmdr
31 return [format "%.1f" [expr {$cmdr($a)/10.0}]]
32}
33proc dump/tenth {min max a} {
34 global cmdr
35 return [format "%.1f" [expr {$cmdr($a)/10.0}]]
36}
37proc set/tenth {min max a v} {
38 global cmdr
39 if {$v < $min || $v > $max} { error "value out of range" }
40 set cmdr($a) [expr {int($v * 10)}]
41}
42
43proc get/choice {min max l a} {
44 global cmdr
45 set x "custom"
46 foreach {t v} $l { if {$cmdr($a) >= $v} { set x $t } }
47 return [format "%d (%s)" [expr {$cmdr($a) + 0}] $x]
48}
49proc dump/choice {min max l a} {
50 global cmdr
51 return [format "%d" [expr {$cmdr($a) + 0}]]
52}
53proc set/choice {min max l a v} {
54 global cmdr
55 if {[regexp {^\d+$} $v]} {
56 if {$v < $min || $v > $max} { error "value out of range" }
57 } else {
58 set x $v
59 set v -1
60 foreach {t vv} $l {
61 if {[string equal -nocase $x $t]} { set v $vv; break }
62 }
63 if {$v == -1} { error "unknown tag `$x'" }
64 }
65 set cmdr($a) $v
66}
67
68proc get/seed {a} { global cmdr; return $cmdr($a) }
69proc dump/seed {a} { global cmdr; return $cmdr($a) }
70proc set/seed {a v} {
71 global cmdr
72 set s [parse-galaxy-spec $v]
73 if {[string equal $s ""]} { error "bad galaxy spec `$v'" }
74 destructure [list . cmdr($a)] $s
75}
76
77proc get/world {a} {
78 global cmdr gov eco
161e6ada 79 set ww [elite-galaxylist $cmdr(gal-seed)]
1ded87ba 80 set s [nearest-planet $ww \
81 [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]]
82 elite-worldinfo p $s
83 return [list $p(name) $p(x) $p(y) $eco($p(economy)) $gov($p(government)) \
84 $p(techlevel)]
85}
86proc dump/world {a} {
87 global cmdr
88 return [format "%d, %d" \
89 [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]]
90}
91proc set/world {a v} {
92 global cmdr
161e6ada 93 set ww [elite-galaxylist $cmdr(gal-seed)]
1ded87ba 94 set s [parse-planet-spec $cmdr(gal-seed) $v]
95 if {[string equal $s ""]} { error "bad planet spec `$v'" }
96 if {![in-galaxy-p $cmdr(gal-seed) $s]} {
97 error "planet `[worldname $s]' not in galaxy $cmdr(gal-seed)"
98 }
99 elite-worldinfo p $s
8bdcaa8b 100 set ss [nearest-planet $ww $p(x) $p(y)]
101 if {![string equal $s $ss]} {
102 set n $p(name)
103 elite-worldinfo p $ss
104 puts stderr "can't dock at $n: $p(name) is coincident"
105 }
1ded87ba 106 set cmdr(world-x) [expr {$p(x)/4}]
107 set cmdr(world-y) [expr {$p(y)/2}]
108}
109
110proc get/bool {dfl a} {
111 global cmdr
112 if {$cmdr($a)} { return "yes" } else { return "no" }
113}
114proc dump/bool {dfl a} {
115 global cmdr
116 if {$cmdr($a)} { return "yes" } else { return "no" }
117}
118proc set/bool {dfl a v} {
119 global cmdr
120 switch -- [string tolower $v] {
121 "y" - "yes" - "true" - "on" { set v 1 }
122 "n" - "no" - "false" - "off" { set v 0 }
123 }
124 if {$v} { set cmdr($a) $dfl } else { set cmdr($a) 0 }
125}
126
127proc set/comment {a v} { }
128
129set attrs {}
130set attr(\#) { comment }
131foreach {a type} {
132 mission { int 0 255 }
133 score { choice 0 65535 {
134 "harmless" 0 "mostly-harmless" 8 "poor" 16 "average" 32
135 "above-average" 64 "competent" 128 "dangerous" 512 "deadly" 2560
136 "elite" 6400
137 } }
138 credits { tenth 0 429496729.5 }
139 cargo { int 4 255 }
140 gal-number { int 1 8 }
141 gal-seed { seed }
142 world { world }
143 market-fluc { int 0 255 }
144 missiles { int 0 255 }
145 fuel { tenth 0 25.5 }
146 energy-unit { choice 0 255 { "none" 0 "standard" 1 "naval" 2 } }
147} {
148 set attr($a) $type
149 lappend attrs $a
150}
151foreach l {front rear left right} {
152 set attr($l-laser) {
153 choice 0 255
154 { "none" 0 "pulse" 0x0f "mining" 0x32 "beam" 0x8f "military" 0x97 }
155 }
156 lappend attrs $l-laser
157}
158foreach i {
159 ecm fuel-scoop energy-bomb escape-pod docking-computer gal-hyperdrive
160} {
161 set attr($i) { bool 255 }
162 lappend attrs $i
163}
164foreach l {station hold} {
165 foreach {t p} $products {
166 set attr($l-$t) { int 0 255 }
167 lappend attrs $l-$t
168 }
169}
170
171set acted 0
172for {set i 0} {$i < [llength $argv]} {incr i} {
173 set a [lindex $argv $i]
174 switch -regexp -- $a {
175 "^-reset$" { jameson cmdr }
176 "^-show$" {
177 foreach a $attrs {
178 puts [format "%-20s %s" $a [eval \
179 get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
180 }
181 set acted 1
182 }
183 "^-load$" {
184 incr i
185 set a [lindex $argv $i]
186 if {[catch { elite-unpackcmdr cmdr [read-file $a] } err]} {
187 puts stderr "$argv0: couldn't read `$a': $err"
188 exit 1
189 }
190 }
191 "^-save$" {
192 incr i
193 set a [lindex $argv $i]
194 if {[catch { write-file $a [elite-packcmdr cmdr] } err]} {
195 puts stderr "$argv0: couldn't write `$a': $err"
196 exit 1
197 }
198 set acted 1
199 }
200 "^-dump$" {
201 puts "# {Elite commander dump}"
202 puts ""
203 foreach a $attrs {
204 puts [list $a [eval \
205 dump/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
206 }
207 set acted 1
208 }
209 "^-read$" {
210 incr i
211 set a [lindex $argv $i]
212 if {[catch {
213 foreach {a v} [read-file $a auto] {
214 if {![info exists attr($a)]} {
215 error "no such attribute `$a'"
216 }
217 eval set/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a $v]
218 }
219 } err]} {
220 puts stderr "$argv0: error in script: $err"
221 exit 1
222 }
223 }
224 "^-" {
225 puts stderr "$argv0: unknown option `$a'"
226 exit 1
227 }
228 "^[a-z][a-z-]*=" {
229 regexp {^([a-z][a-z-]*)=(.*)$} $a . a v
230 if {![info exists attr($a)]} {
231 puts stderr "$argv0: no such attribute `$a'"
232 exit 1
233 }
234 if {[catch {
235 eval set/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a $v]
236 } err]} {
237 puts stderr "$argv0: error setting `$a': $err"
238 exit 1
239 }
240 }
1ded87ba 241 default {
d45cab7c 242 set n 0
243 foreach aa $attrs {
244 if {[string match $a $aa]} {
245 incr n
246 puts [format "%-20s %s" $aa [eval \
247 get/[lindex $attr($aa) 0] \
248 [lrange $attr($aa) 1 end] [list $aa]]]
249 }
250 }
251 if {$n} {
252 set acted 1
253 } else {
254 if {[catch { elite-unpackcmdr cmdr [read-file $a] } err]} {
255 puts stderr "$argv0: couldn't read `$a': $err"
256 exit 1
257 }
1ded87ba 258 }
259 }
260 }
261}
262if {!$acted} {
263 foreach a $attrs {
264 puts [format "%-20s %s" $a [eval \
265 get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
266 }
267}