3 package require "elite" "1.0.1"
5 if {[llength $argv] < 1} {
6 puts stderr "usage: $argv0 \[-OPTION | ATTR | ATTR=VALUE\] ..."
11 proc get/string {a} { global cmdr; return $cmdr($a) }
12 proc dump/string {a} { global cmdr; return $cmdr($a) }
13 proc set/string {a v} { global cmdr; set cmdr($a) $v }
15 proc get/int {min max a} {
17 return [format "%d" [expr {$cmdr($a) + 0}]]
19 proc dump/int {min max a} {
21 return [format "%d" [expr {$cmdr($a) + 0}]]
23 proc set/int {min max a v} {
25 if {$v < $min || $v > $max} { error "value out of range" }
29 proc get/tenth {min max a} {
31 return [format "%.1f" [expr {$cmdr($a)/10.0}]]
33 proc dump/tenth {min max a} {
35 return [format "%.1f" [expr {$cmdr($a)/10.0}]]
37 proc set/tenth {min max a v} {
39 if {$v < $min || $v > $max} { error "value out of range" }
40 set cmdr($a) [expr {int($v * 10)}]
43 proc get/choice {min max l a} {
46 foreach {t v} $l { if {$cmdr($a) >= $v} { set x $t } }
47 return [format "%d (%s)" [expr {$cmdr($a) + 0}] $x]
49 proc dump/choice {min max l a} {
51 return [format "%d" [expr {$cmdr($a) + 0}]]
53 proc set/choice {min max l a v} {
55 if {[regexp {^\d+$} $v]} {
56 if {$v < $min || $v > $max} { error "value out of range" }
61 if {[string equal -nocase $x $t]} { set v $vv; break }
63 if {$v == -1} { error "unknown tag `$x'" }
68 proc get/seed {a} { global cmdr; return $cmdr($a) }
69 proc dump/seed {a} { global cmdr; return $cmdr($a) }
72 set s [parse-galaxy-spec $v]
73 if {[string equal $s ""]} { error "bad galaxy spec `$v'" }
74 destructure [list . cmdr($a)] $s
79 set ww [elite-galaxylist $cmdr(gal-seed)]
80 set s [nearest-planet $ww \
81 [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]]
83 return [list $p(name) $p(x) $p(y) $eco($p(economy)) $gov($p(government)) \
88 return [format "%d, %d" \
89 [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]]
91 proc set/world {a v} {
93 set ww [elite-galaxylist $cmdr(gal-seed)]
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)"
100 set ss [nearest-planet $ww $p(x) $p(y)]
101 if {![string equal $s $ss]} {
103 elite-worldinfo p $ss
104 puts stderr "can't dock at $n: $p(name) is coincident"
106 set cmdr(world-x) [expr {$p(x)/4}]
107 set cmdr(world-y) [expr {$p(y)/2}]
110 proc get/bool {dfl a} {
112 if {$cmdr($a)} { return "yes" } else { return "no" }
114 proc dump/bool {dfl a} {
116 if {$cmdr($a)} { return "yes" } else { return "no" }
118 proc set/bool {dfl a v} {
120 switch -- [string tolower $v] {
121 "y" - "yes" - "true" - "on" { set v 1 }
122 "n" - "no" - "false" - "off" { set v 0 }
124 if {$v} { set cmdr($a) $dfl } else { set cmdr($a) 0 }
127 proc set/comment {a v} { }
130 set attr(\#) { comment }
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
138 credits { tenth 0 429496729.5 }
140 gal-number { int 1 8 }
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 } }
151 foreach l {front rear left right} {
154 { "none" 0 "pulse" 0x0f "mining" 0x32 "beam" 0x8f "military" 0x97 }
156 lappend attrs $l-laser
159 ecm fuel-scoop energy-bomb escape-pod docking-computer gal-hyperdrive
161 set attr($i) { bool 255 }
164 foreach l {station hold} {
165 foreach {t p} $products {
166 set attr($l-$t) { int 0 255 }
172 for {set i 0} {$i < [llength $argv]} {incr i} {
173 set a [lindex $argv $i]
174 switch -regexp -- $a {
175 "^-reset$" { jameson cmdr }
178 puts [format "%-20s %s" $a [eval \
179 get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
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"
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"
201 puts "# {Elite commander dump}"
204 puts [list $a [eval \
205 dump/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
211 set a [lindex $argv $i]
213 foreach {a v} [read-file $a auto] {
214 if {![info exists attr($a)]} {
215 error "no such attribute `$a'"
217 eval set/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a $v]
220 puts stderr "$argv0: error in script: $err"
225 puts stderr "$argv0: unknown option `$a'"
229 regexp {^([a-z][a-z-]*)=(.*)$} $a . a v
230 if {![info exists attr($a)]} {
231 puts stderr "$argv0: no such attribute `$a'"
235 eval set/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a $v]
237 puts stderr "$argv0: error setting `$a': $err"
242 if {![info exists attr($a)]} {
243 puts stderr "$argv0: no such attribute `$a'"
246 puts [format "%-20s %s" $a [eval \
247 get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]
251 if {[catch { elite-unpackcmdr cmdr [read-file $a] } err]} {
252 puts stderr "$argv0: couldn't read `$a': $err"
260 puts [format "%-20s %s" $a [eval \
261 get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]]