~mdw
/
rocl
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Prevent unneceessary recomputation of adjacency maps.
[rocl]
/
elite-editor
diff --git
a/elite-editor
b/elite-editor
index
22a6033
..
8777e13
100755
(executable)
--- a/
elite-editor
+++ b/
elite-editor
@@
-1,4
+1,6
@@
#! /usr/bin/wish
#! /usr/bin/wish
+#
+# $Id: elite-editor,v 1.4 2003/02/26 00:02:15 mdw Exp $
package require "elite" "1.0.0"
package require "elite" "1.0.0"
@@
-92,7
+94,7
@@
set nwin 0
array set default {scale 15 colourby off connect 0}
proc set-scale {seq sc} {
array set default {scale 15 colourby off connect 0}
proc set-scale {seq sc} {
- if {![regexp {^
[0-9]
+$} $sc]} {
+ if {![regexp {^
\d
+$} $sc]} {
moan "bad scale factor `$sc'"
return 1
}
moan "bad scale factor `$sc'"
return 1
}
@@
-111,6
+113,15
@@
proc new-view {gs} {
return 0
}
return 0
}
+proc set-hyperspace-range {seq f} {
+ if {![regexp {^\d+(\.\d+)?$} $f]} {
+ moan "bad hyperspace range `$f'"
+ return 1
+ }
+ map-set-fuel $seq [expr {$f * 10}]
+ return 0
+}
+
# --- Colour-coding planets ---
proc colour-by {seq} {
# --- Colour-coding planets ---
proc colour-by {seq} {
@@
-155,14
+166,14
@@
proc set-colour-by {seq} {
proc show-connectivity {seq} {
upvar \#0 map-$seq map
proc show-connectivity {seq} {
upvar \#0 map-$seq map
- upvar \#0 adj-$map(galaxy) adj
+ upvar \#0 adj-$map(galaxy)
-$map(fuel)
adj
upvar \#0 ww-$map(galaxy) ww
set tl .map-$seq
$tl.map delete conn
if {!$map(connect)} {
return
}
upvar \#0 ww-$map(galaxy) ww
set tl .map-$seq
$tl.map delete conn
if {!$map(connect)} {
return
}
- if {![info exists adj]} { adjacency $ww adj }
+ if {![info exists adj]} { adjacency $ww adj
$map(fuel)
}
foreach {s x y} $ww {
set done($s) 1
foreach {ss xx yy} $adj($s) {
foreach {s x y} $ww {
set done($s) 1
foreach {ss xx yy} $adj($s) {
@@
-174,6
+185,7
@@
proc show-connectivity {seq} {
}
}
$tl.map lower conn sep
}
}
$tl.map lower conn sep
+ show-path $seq
}
proc set-connectivity {seq} {
}
proc set-connectivity {seq} {
@@
-254,9
+266,17
@@
proc show-path {seq} {
$tl.map lower path sep
}
$tl.map lower path sep
}
+proc hide-path {seq} {
+ upvar \#0 map-$seq map
+ set tl .map-$seq
+ $tl.map delete path
+ unset map(path)
+ $tl.menu.path entryconfigure 7 -state disabled
+}
+
proc show-shortest-path {seq weight} {
upvar \#0 map-$seq map
proc show-shortest-path {seq weight} {
upvar \#0 map-$seq map
- upvar \#0 adj-$map(galaxy) adj
+ upvar \#0 adj-$map(galaxy)
-$map(fuel)
adj
upvar \#0 ww-$map(galaxy) ww
set tl .map-$seq
$tl.map delete path
upvar \#0 ww-$map(galaxy) ww
set tl .map-$seq
$tl.map delete path
@@
-265,7
+285,7
@@
proc show-shortest-path {seq weight} {
moan "no source or destination set"
return
}
moan "no source or destination set"
return
}
- if {![info exists adj]} { adjacency $ww adj }
+ if {![info exists adj]} { adjacency $ww adj
$map(fuel)
}
destructure {path weight} \
[shortest-path adj $map(select) $map(dest) $weight]
if {![llength $path]} {
destructure {path weight} \
[shortest-path adj $map(select) $map(dest) $weight]
if {![llength $path]} {
@@
-273,6
+293,7
@@
proc show-shortest-path {seq weight} {
return
}
set map(path) $path
return
}
set map(path) $path
+ $tl.menu.path entryconfigure 7 -state normal
show-path $seq
}
show-path $seq
}
@@
-488,7
+509,6
@@
proc map-populate {seq} {
colour-by $seq
show-connectivity $seq
colour-by $seq
show-connectivity $seq
- show-path $seq
show-names $seq
select-world $seq
destination-world $seq
show-names $seq
select-world $seq
destination-world $seq
@@
-525,6
+545,7
@@
proc map-attach-cmdr {seq cmdr} {
upvar \#0 map-$seq map
set map(cmdr) $cmdr
map-set-title $seq
upvar \#0 map-$seq map
set map(cmdr) $cmdr
map-set-title $seq
+ .map-$seq.menu.view entryconfigure 3 -state disabled
}
proc map-set-title {seq} {
}
proc map-set-title {seq} {
@@
-551,8
+572,9
@@
proc map-set-galaxy {seq ng g} {
proc map-set-fuel {seq qty} {
upvar \#0 map-$seq map
proc map-set-fuel {seq qty} {
upvar \#0 map-$seq map
- set map(fuel)
$qty
+ set map(fuel)
[expr {int($qty)}]
select-world $seq
select-world $seq
+ show-connectivity $seq
}
# --- Making a new map window ---
}
# --- Making a new map window ---
@@
-607,10
+629,14
@@
proc map-new {ng g} {
$tl.menu add cascade -label "File" -menu $tl.menu.file
menu $tl.menu.view
$tl.menu.view add command -label "New map..." \
$tl.menu add cascade -label "File" -menu $tl.menu.file
menu $tl.menu.view
$tl.menu.view add command -label "New map..." \
- -command [list get-line .new-view "New
view
" "Galaxy" $ng new-view]
+ -command [list get-line .new-view "New
map
" "Galaxy" $ng new-view]
$tl.menu.view add command -label "Set scale..." \
-command [concat get-line .set-scale-$seq {"Set scale"} "Scale" \
\[set map-${seq}(scale)\] [list [list set-scale $seq]]]
$tl.menu.view add command -label "Set scale..." \
-command [concat get-line .set-scale-$seq {"Set scale"} "Scale" \
\[set map-${seq}(scale)\] [list [list set-scale $seq]]]
+ $tl.menu.view add command -label "Set hyperspace range..." \
+ -command [concat get-line .set-fuel-$seq {"Set hyperspace range"} \
+ {"Hyperspace range"} \[expr \[set map-${seq}(fuel)\]/10.0\] \
+ [list [list set-hyperspace-range $seq]]]
$tl.menu.view add separator
$tl.menu.view add radiobutton -label "Off" \
-variable map-${seq}(colourby) -value off \
$tl.menu.view add separator
$tl.menu.view add radiobutton -label "Off" \
-variable map-${seq}(colourby) -value off \
@@
-643,6
+669,9
@@
proc map-new {ng g} {
-command [list show-shortest-path $seq weight-encounters]
$tl.menu.path add command -label "Maximize trading" \
-command [list show-shortest-path $seq weight-trading]
-command [list show-shortest-path $seq weight-encounters]
$tl.menu.path add command -label "Maximize trading" \
-command [list show-shortest-path $seq weight-trading]
+ $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 configure -menu $tl.menu
$tl.menu add cascade -label "Compute path" -menu $tl.menu.path
$tl configure -menu $tl.menu