X-Git-Url: https://git.distorted.org.uk/~mdw/rocl/blobdiff_plain/1775d50fa7fce38baa9e3e35e18cb64cd4aa548e..1c647046e8e8ffaead06413834cfa3a9fc57a3dc:/elite-editor diff --git a/elite-editor b/elite-editor index ea8bc1a..46c689d 100755 --- a/elite-editor +++ b/elite-editor @@ -1,6 +1,6 @@ #! /usr/bin/wish # -# $Id: elite-editor,v 1.3 2003/02/25 10:05:08 mdw Exp $ +# $Id: elite-editor,v 1.7 2003/03/03 10:38:08 mdw Exp $ package require "elite" "1.0.0" @@ -31,33 +31,6 @@ proc debug-array {name} { array donesearch a $s } -proc write-file {name contents {trans binary}} { - if {[file exists $name]} { - if {[set rc [catch { file copy -force $name "$name.old" } err]]} { - return -code $rc $err - } - } - if {[set rc [catch { - set f [open $name w] - fconfigure $f -translation $trans - puts -nonewline $f $contents - close $f - } err]]} { - catch { close $f } - catch { file rename -force "$name.old" $name } - return -code $rc $err - } - return "" -} - -proc read-file {name {trans binary}} { - set f [open $name] - fconfigure $f -translation $trans - set c [read $f] - close $f - return $c -} - proc get-line-done {tl cmd} { if {![uplevel \#0 [concat $cmd [$tl.entry get]]]} { destroy $tl @@ -299,11 +272,11 @@ proc show-shortest-path {seq weight} { # --- Planet information box --- -proc do-getinfo {tag seq x y} { +proc show-worldinfo {tag p} { global economy government upvar \#0 info-$tag info set tl .world-info-$tag - elite-worldinfo info [find-click $seq $x $y] + elite-worldinfo info $p if {[winfo exists $tl]} { # raise $tl } else { @@ -350,6 +323,10 @@ proc do-getinfo {tag seq x y} { $tl.desc configure -state disabled } +proc do-getinfo {tag seq x y} { + show-worldinfo $tag [find-click $seq $x $y] +} + # --- Messing with selections --- proc to-ly {seq x} { @@ -434,17 +411,30 @@ proc select-byname {seq name seed proc} { set p [parse-planet-spec $map(galaxy) $map($name)] if {![string equal $p ""] && [in-galaxy-p $map(galaxy) $p]} { $proc $seq $p + return 1 } elseif {[info exists map($seed)]} { bell set map($name) [worldname $map($seed)] + return 0 } else { bell set map($name) "" + return 0 + } +} + +proc info-byname {seq name seed proc} { + upvar \#0 map-$seq map + if {[select-byname $seq $name $seed $proc]} { + show-worldinfo $seed $map($seed) } } proc set-selection {seq p} { upvar \#0 map-$seq map + if {[info exists map(cmdr)]} { + set p [cmdr-set-world $map(cmdr) $p] + } set map(select) $p elite-worldinfo pp $p select-world $seq @@ -454,9 +444,6 @@ proc set-selection {seq p} { } else { set-destination $seq $map(dest) } - if {[info exists map(cmdr)]} { - cmdr-set-world $map(cmdr) $p - } } proc do-select {seq x y} { @@ -572,7 +559,7 @@ proc map-set-galaxy {seq ng g} { proc map-set-fuel {seq qty} { upvar \#0 map-$seq map - set map(fuel) [expr {$qty + 0.0}] + set map(fuel) [expr {int($qty)}] select-world $seq show-connectivity $seq } @@ -687,13 +674,17 @@ proc map-new {ng g} { bind $tl.map <3> [list do-select $seq %x %y] bind $tl.map <1> [list do-destination $seq %x %y] bind $tl.map [list do-getinfo dest $seq %x %y] - bind $tl.map [list do-getinfo home $seq %x %y] + bind $tl.map [list do-getinfo select $seq %x %y] map-set-title $seq entry-on-change $tl.info.home \ [list select-byname $seq sel-name select set-selection] entry-on-change $tl.info.dest \ [list select-byname $seq dest-name dest set-destination] + bind $tl.info.home \ + [list info-byname $seq sel-name select set-selection] + bind $tl.info.dest \ + [list info-byname $seq dest-name dest set-destination] map-setscale $seq $sc return $seq } @@ -831,12 +822,20 @@ proc cmdrdb-custom {seq tag} { proc cmdr-set-world {seq p} { upvar \#0 cmdr-$seq cmdr + upvar \#0 ww-$cmdr(gal-seed) ww elite-worldinfo i $p - set cmdr(world-seed) $p + set pp [nearest-planet $ww $i(x) $i(y)] + if {![string equal $p $pp]} { + set n $i(name) + elite-worldinfo i $pp + moan "world $n is coincident with $i(name); substituting" + } + set cmdr(world-seed) $i(seed) set cmdr(world-name) $i(name) set cmdr(world-x) [expr {$i(x)/4}] set cmdr(world-y) [expr {$i(y)/2}] cmdr-set-fluc $seq + return $i(seed) } proc cmdr-update-world {seq} { @@ -956,7 +955,7 @@ proc cmdr-open {seq} { score "Rating" { dropbox 65535\ "Harmless" 0 \ "Mostly harmless" 8 \ - "Poor" 6 \ + "Poor" 16 \ "Average" 32 \ "Above average" 64 \ "Competent" 128 \ @@ -1180,38 +1179,10 @@ proc cmdr-save {seq} { } proc cmdr-new {} { - global seq galaxy1 products + global seq incr seq upvar \#0 cmdr-$seq cmdr - array set cmdr { - mission 0 - credits 1000 - fuel 70 - gal-number 1 - front-laser 0x0f - rear-laser 0 - left-laser 0 - right-laser 0 - cargo 20 - missiles 3 - legal-status 0 - score 0 - market-fluc 0 - } - set cmdr(gal-seed) $galaxy1 - foreach i { - ecm fuel-scoop energy-bomb energy-unit docking-computer - gal-hyperdrive escape-pod - } { set cmdr($i) 0 } - elite-worldinfo lave [find-world $galaxy1 "Lave"] - set cmdr(world-x) [expr {$lave(x)/4}] - set cmdr(world-y) [expr {$lave(y)/2}] - elite-market mkt $lave(seed) 0 - foreach {t n} $products { - destructure [list . cmdr(station-$t)] $mkt($t) - set cmdr(hold-$t) 0 - } - set cmdr(station-alien-items) 0 + jameson cmdr cmdr-open $seq } @@ -1219,14 +1190,27 @@ proc cmdr-new {} { wm withdraw . +bind Entry { %W delete 0 end } + if {[llength $argv]} { foreach a $argv { - set g [parse-galaxy-spec $a] - if {[llength $g]} { - destructure {ng g} $g - map-new $ng $g - } else { - cmdr-load $a + switch -glob -- $a { + "-jameson" { + cmdr-new + } + "-*" { + puts stderr "$argv0: unknown option: $a" + exit 1 + } + default { + set g [parse-galaxy-spec $a] + if {[llength $g]} { + destructure {ng g} $g + map-new $ng $g + } else { + cmdr-load $a + } + } } } } else {