#! /usr/bin/wish
#
-# $Id: elite-editor,v 1.4 2003/02/26 00:02:15 mdw Exp $
+# $Id: elite-editor,v 1.8 2003/03/07 00:43:12 mdw Exp $
-package require "elite" "1.0.0"
+package require "elite" "1.0.1"
# --- Utility procedures ----------------------------------------------------
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
set tl .map-$seq
$tl.map delete conn
if {!$map(connect)} {
+ show-path $seq
return
}
- if {![info exists adj]} { adjacency $ww adj $map(fuel) }
+ if {![info exists adj]} { elite-adjacency adj $ww $map(fuel) }
foreach {s x y} $ww {
set done($s) 1
foreach {ss xx yy} $adj($s) {
set tl .map-$seq
$tl.map delete path
unset map(path)
- $tl.menu.path entryconfigure 7 -state disabled
+ foreach i {2 3 11} {
+ $tl.menu.path entryconfigure $i -state disabled
+ }
+}
+
+proc path-to-text {seq} {
+ upvar \#0 map-$seq map
+ set t {}
+ foreach n $map(path) {
+ append t [world-summary $n] "\n"
+ }
+ return $t
+}
+
+proc save-path {seq} {
+ set file [tk_getSaveFile -initialfile "path" -title "Save path"]
+ if {[string equal $file ""]} { return }
+ if {[catch { write-file $file [path-to-text $seq] auto } err]} {
+ moan $err
+ }
}
+proc list-path {seq} {
+ upvar \#0 map-$seq map
+ set tl .map-$seq.path
+ if {[winfo exists $tl]} {
+ # raise $tl
+ } else {
+ toplevel $tl
+ wm title $tl "Path listing"
+ scrollbar $tl.hscr -orient horizontal -command [list $tl.text xview]
+ scrollbar $tl.vscr -orient vertical -command [list $tl.text yview]
+ text $tl.text -wrap none -width 80 -height 20 \
+ -xscrollcommand [list $tl.hscr set] \
+ -yscrollcommand [list $tl.vscr set]
+ grid configure $tl.text -row 0 -column 0 -sticky nsew
+ grid configure $tl.hscr -row 1 -column 0 -sticky ew
+ grid configure $tl.vscr -row 0 -column 1 -sticky ns
+ grid rowconfigure $tl 0 -weight 1
+ grid columnconfigure $tl 0 -weight 1
+ }
+ $tl.text configure -state normal
+ $tl.text delete 1.0 end
+ $tl.text insert end [path-to-text $seq]
+ $tl.text configure -state disabled
+}
+
+proc load-path {seq} {
+ upvar \#0 map-$seq map
+ set tl .map-$seq
+ set file [tk_getOpenFile -title "Load path"]
+ if {[catch {
+ set f [open $file]
+ set path {}
+ while {[gets $f line] >= 0} {
+ if {[regexp {^\s*(\#|$)} $line]} { continue }
+ if {[regexp {\m[0-9a-f]{12}\M} $line p]} {
+ } else {
+ set p [parse-planet-spec $map(galaxy) [lindex $line 0]]
+ if {[string equal $p ""]} {
+ error "unrecognized path line `$line'"
+ }
+ }
+ lappend path $p
+ }
+ if {![in-galaxy-p $map(galaxy) $path]} {
+ error "not all worlds in this galaxy"
+ }
+ close $f
+ } err]} {
+ catch { close $f }
+ moan $err
+ return
+ }
+ set map(path) $path
+ foreach i {2 3 11} {
+ $tl.menu.path entryconfigure $i -state normal
+ }
+ show-path $seq
+}
+
proc show-shortest-path {seq weight} {
upvar \#0 map-$seq map
upvar \#0 adj-$map(galaxy)-$map(fuel) adj
moan "no source or destination set"
return
}
- if {![info exists adj]} { adjacency $ww adj $map(fuel) }
+ if {![info exists adj]} { elite-adjacency adj $ww $map(fuel) }
destructure {path weight} \
[shortest-path adj $map(select) $map(dest) $weight]
if {![llength $path]} {
return
}
set map(path) $path
- $tl.menu.path entryconfigure 7 -state normal
+ foreach i {2 3 11} {
+ $tl.menu.path entryconfigure $i -state normal
+ }
show-path $seq
}
# --- 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 {
$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} {
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
} else {
set-destination $seq $map(dest)
}
- if {[info exists map(cmdr)]} {
- cmdr-set-world $map(cmdr) $p
- }
}
proc do-select {seq x y} {
set map(dest-name) $pd(name)
set map(distance) \
[format "%.1f" \
- [expr {[world-distance $ps(x) $ps(y) $pd(x) $pd(y)] / 10.0}]]
+ [expr {[elite-distance $ps(x) $ps(y) $pd(x) $pd(y)] / 10.0}]]
}
}
set scale $map(scale)
$tl.map delete all
$tl.map create line -10000 -20000 -10000 -20000 -fill black -tags sep
- if {![info exists ww]} { set ww [worldinfo $map(galaxy)] }
+ if {![info exists ww]} { set ww [elite-galaxylist $map(galaxy)] }
foreach {seed x y} $ww {
elite-worldinfo p $seed
set x [expr {$x * 10 / $map(scale)}]
-command [list set-names $seq]
$tl.menu add cascade -label "View" -menu $tl.menu.view
menu $tl.menu.path
+ $tl.menu.path add command -label "Load path..." \
+ -command [list load-path $seq]
+ $tl.menu.path add command -label "Save path..." -state disabled \
+ -command [list save-path $seq]
+ $tl.menu.path add command -label "List path..." -state disabled \
+ -command [list list-path $seq]
+ $tl.menu.path add separator
$tl.menu.path add command -label "Minimize hops" \
-command [list show-shortest-path $seq weight-hops]
$tl.menu.path add command -label "Minimize fuel" \
$tl.menu.path add separator
$tl.menu.path add command -label "Hide path" -state disabled \
-command [list hide-path $seq]
- $tl.menu add cascade -label "Compute path" -menu $tl.menu.path
+ $tl.menu add cascade -label "Path" -menu $tl.menu.path
$tl configure -menu $tl.menu
wm protocol $tl WM_DELETE_WINDOW [list map-destroy $seq]
bind $tl.map <3> [list do-select $seq %x %y]
bind $tl.map <1> [list do-destination $seq %x %y]
bind $tl.map <Double-1> [list do-getinfo dest $seq %x %y]
- bind $tl.map <Double-3> [list do-getinfo home $seq %x %y]
+ bind $tl.map <Double-3> [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 <Control-Return> \
+ [list info-byname $seq sel-name select set-selection]
+ bind $tl.info.dest <Control-Return> \
+ [list info-byname $seq dest-name dest set-destination]
map-setscale $seq $sc
return $seq
}
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} {
upvar \#0 cmdr-$seq cmdr
upvar \#0 ww-$cmdr(gal-seed) ww
- if {![info exists ww]} { set ww [worldinfo $cmdr(gal-seed)] }
+ if {![info exists ww]} { set ww [elite-galaxylist $cmdr(gal-seed)] }
set tl .cmdr-$seq
set w [nearest-planet $ww \
[expr {$cmdr(world-x) * 4}] [expr {$cmdr(world-y) * 2}]]
score "Rating" { dropbox 65535\
"Harmless" 0 \
"Mostly harmless" 8 \
- "Poor" 6 \
+ "Poor" 16 \
"Average" 32 \
"Above average" 64 \
"Competent" 128 \
}
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
}
wm withdraw .
+bind Entry <Control-u> { %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 {
~mdw / rocl / blobdiff