From: mdw <mdw>
Date: Fri, 7 Mar 2003 00:43:12 +0000 (+0000)
Subject: Track Elite package interface change.  Fix bug which failed to show the
X-Git-Tag: 1.1.0~7
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/rocl/commitdiff_plain/b48b0bfb41cca75638fbede2f2b62af6b5e070fe

Track Elite package interface change.  Fix bug which failed to show the
path after a scale change if the connectivity map was hidden.  Allow
loading and saving of paths (for viewing Salesman routes).
---

diff --git a/elite-editor b/elite-editor
index 46c689d..82ac25c 100755
--- a/elite-editor
+++ b/elite-editor
@@ -1,8 +1,8 @@
 #! /usr/bin/wish
 #
-# $Id: elite-editor,v 1.7 2003/03/03 10:38:08 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 ----------------------------------------------------
 
@@ -144,9 +144,10 @@ proc show-connectivity {seq} {
   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) {
@@ -244,9 +245,87 @@ proc hide-path {seq} {
   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
@@ -258,7 +337,7 @@ proc show-shortest-path {seq weight} {
     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]} {
@@ -266,7 +345,9 @@ proc show-shortest-path {seq weight} {
     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
 }
 
@@ -462,7 +543,7 @@ proc set-destination {seq p} {
     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}]]
   }
 }
 
@@ -481,7 +562,7 @@ proc map-populate {seq} {
   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)}]
@@ -646,6 +727,13 @@ proc map-new {ng g} {
       -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" \
@@ -659,7 +747,7 @@ proc map-new {ng g} {
   $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]
@@ -841,7 +929,7 @@ proc cmdr-set-world {seq p} {
 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}]]