#! /usr/bin/tclsh package require "elite" "1.0.1" if {[llength $argv] < 1} { puts stderr "usage: $argv0 \[-OPTION | ATTR | ATTR=VALUE\] ..." exit 1 } jameson cmdr proc get/string {a} { global cmdr; return $cmdr($a) } proc dump/string {a} { global cmdr; return $cmdr($a) } proc set/string {a v} { global cmdr; set cmdr($a) $v } proc get/int {min max a} { global cmdr return [format "%d" [expr {$cmdr($a) + 0}]] } proc dump/int {min max a} { global cmdr return [format "%d" [expr {$cmdr($a) + 0}]] } proc set/int {min max a v} { global cmdr if {$v < $min || $v > $max} { error "value out of range" } set cmdr($a) $v } proc get/tenth {min max a} { global cmdr return [format "%.1f" [expr {$cmdr($a)/10.0}]] } proc dump/tenth {min max a} { global cmdr return [format "%.1f" [expr {$cmdr($a)/10.0}]] } proc set/tenth {min max a v} { global cmdr if {$v < $min || $v > $max} { error "value out of range" } set cmdr($a) [expr {int($v * 10)}] } proc get/choice {min max l a} { global cmdr set x "custom" foreach {t v} $l { if {$cmdr($a) >= $v} { set x $t } } return [format "%d (%s)" [expr {$cmdr($a) + 0}] $x] } proc dump/choice {min max l a} { global cmdr return [format "%d" [expr {$cmdr($a) + 0}]] } proc set/choice {min max l a v} { global cmdr if {[regexp {^\d+$} $v]} { if {$v < $min || $v > $max} { error "value out of range" } } else { set x $v set v -1 foreach {t vv} $l { if {[string equal -nocase $x $t]} { set v $vv; break } } if {$v == -1} { error "unknown tag `$x'" } } set cmdr($a) $v } proc get/seed {a} { global cmdr; return $cmdr($a) } proc dump/seed {a} { global cmdr; return $cmdr($a) } proc set/seed {a v} { global cmdr set s [parse-galaxy-spec $v] if {[string equal $s ""]} { error "bad galaxy spec `$v'" } destructure [list . cmdr($a)] $s } proc get/world {a} { global cmdr gov eco set ww [elite-galaxylist $cmdr(gal-seed)] set s [nearest-planet $ww \ [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]] elite-worldinfo p $s return [list $p(name) $p(x) $p(y) $eco($p(economy)) $gov($p(government)) \ $p(techlevel)] } proc dump/world {a} { global cmdr return [format "%d, %d" \ [expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]] } proc set/world {a v} { global cmdr set ww [elite-galaxylist $cmdr(gal-seed)] set s [parse-planet-spec $cmdr(gal-seed) $v] if {[string equal $s ""]} { error "bad planet spec `$v'" } if {![in-galaxy-p $cmdr(gal-seed) $s]} { error "planet `[worldname $s]' not in galaxy $cmdr(gal-seed)" } elite-worldinfo p $s set ss [nearest-planet $ww $p(x) $p(y)] if {![string equal $s $ss]} { set n $p(name) elite-worldinfo p $ss puts stderr "can't dock at $n: $p(name) is coincident" } set cmdr(world-x) [expr {$p(x)/4}] set cmdr(world-y) [expr {$p(y)/2}] } proc get/bool {dfl a} { global cmdr if {$cmdr($a)} { return "yes" } else { return "no" } } proc dump/bool {dfl a} { global cmdr if {$cmdr($a)} { return "yes" } else { return "no" } } proc set/bool {dfl a v} { global cmdr switch -- [string tolower $v] { "y" - "yes" - "true" - "on" { set v 1 } "n" - "no" - "false" - "off" { set v 0 } } if {$v} { set cmdr($a) $dfl } else { set cmdr($a) 0 } } proc set/comment {a v} { } set attrs {} set attr(\#) { comment } foreach {a type} { mission { int 0 255 } score { choice 0 65535 { "harmless" 0 "mostly-harmless" 8 "poor" 16 "average" 32 "above-average" 64 "competent" 128 "dangerous" 512 "deadly" 2560 "elite" 6400 } } credits { tenth 0 429496729.5 } legal-status { choice 0 255 { "clean" 0 "offender" 1 "fugitive" 50 } } cargo { int 4 255 } gal-number { int 1 8 } gal-seed { seed } world { world } market-fluc { int 0 255 } missiles { int 0 255 } fuel { tenth 0 25.5 } energy-unit { choice 0 255 { "none" 0 "standard" 1 "naval" 2 } } } { set attr($a) $type lappend attrs $a } foreach l {front rear left right} { set attr($l-laser) { choice 0 255 { "none" 0 "pulse" 0x0f "mining" 0x32 "beam" 0x8f "military" 0x97 } } lappend attrs $l-laser } foreach i { ecm fuel-scoop energy-bomb escape-pod docking-computer gal-hyperdrive } { set attr($i) { bool 255 } lappend attrs $i } foreach l {station hold} { foreach {t p} $products { set attr($l-$t) { int 0 255 } lappend attrs $l-$t } } set acted 0 for {set i 0} {$i < [llength $argv]} {incr i} { set a [lindex $argv $i] switch -regexp -- $a { "^-reset$" { jameson cmdr } "^-show$" { foreach a $attrs { puts [format "%-20s %s" $a [eval \ get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]] } set acted 1 } "^-load$" { incr i set a [lindex $argv $i] if {[catch { elite-unpackcmdr cmdr [read-file $a] } err]} { puts stderr "$argv0: couldn't read `$a': $err" exit 1 } } "^-save$" { incr i set a [lindex $argv $i] if {[catch { write-file $a [elite-packcmdr cmdr] } err]} { puts stderr "$argv0: couldn't write `$a': $err" exit 1 } set acted 1 } "^-dump$" { puts "# {Elite commander dump}" puts "" foreach a $attrs { puts [list $a [eval \ dump/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]] } set acted 1 } "^-read$" { incr i set a [lindex $argv $i] if {[catch { foreach {a v} [read-file $a auto] { if {![info exists attr($a)]} { error "no such attribute `$a'" } eval set/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a $v] } } err]} { puts stderr "$argv0: error in script: $err" exit 1 } } "^-" { puts stderr "$argv0: unknown option `$a'" exit 1 } "^[a-z][a-z-]*=" { regexp {^([a-z][a-z-]*)=(.*)$} $a . a v if {![info exists attr($a)]} { puts stderr "$argv0: no such attribute `$a'" exit 1 } if {[catch { eval set/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a $v] } err]} { puts stderr "$argv0: error setting `$a': $err" exit 1 } } default { set n 0 foreach aa $attrs { if {[string match $a $aa]} { incr n puts [format "%-20s %s" $aa [eval \ get/[lindex $attr($aa) 0] \ [lrange $attr($aa) 1 end] [list $aa]]] } } if {$n} { set acted 1 } else { if {[catch { elite-unpackcmdr cmdr [read-file $a] } err]} { puts stderr "$argv0: couldn't read `$a': $err" exit 1 } } } } } if {!$acted} { foreach a $attrs { puts [format "%-20s %s" $a [eval \ get/[lindex $attr($a) 0] [lrange $attr($a) 1 end] [list $a]]] } }