X-Git-Url: https://git.distorted.org.uk/~mdw/rocl/blobdiff_plain/1304202ad2001c85d3eae3a37c51e001794c24c8..17b1f2a59c6da38e7745059f87c22e5e62ebfcf7:/elite-editor

diff --git a/elite-editor b/elite-editor
index 22a6033..46c689d 100755
--- a/elite-editor
+++ b/elite-editor
@@ -1,4 +1,6 @@
 #! /usr/bin/wish
+#
+# $Id: elite-editor,v 1.7 2003/03/03 10:38:08 mdw Exp $
 
 package require "elite" "1.0.0"
 
@@ -29,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
@@ -92,7 +67,7 @@ set nwin 0
 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
   }
@@ -111,6 +86,15 @@ proc new-view {gs} {
   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} {
@@ -155,14 +139,14 @@ proc set-colour-by {seq} {
 
 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
   }
-  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) {
@@ -174,6 +158,7 @@ proc show-connectivity {seq} {
     }
   }
   $tl.map lower conn sep
+  show-path $seq
 }
 
 proc set-connectivity {seq} {
@@ -254,9 +239,17 @@ proc show-path {seq} {
   $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
-  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
@@ -265,7 +258,7 @@ proc show-shortest-path {seq weight} {
     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]} {
@@ -273,16 +266,17 @@ proc show-shortest-path {seq weight} {
     return
   }
   set map(path) $path
+  $tl.menu.path entryconfigure 7 -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 {
@@ -329,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} {
@@ -413,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
@@ -433,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} {
@@ -488,7 +496,6 @@ proc map-populate {seq} {
 
   colour-by $seq
   show-connectivity $seq
-  show-path $seq
   show-names $seq
   select-world $seq
   destination-world $seq
@@ -525,6 +532,7 @@ proc map-attach-cmdr {seq cmdr} {
   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} {
@@ -551,8 +559,9 @@ proc map-set-galaxy {seq ng g} {
 
 proc map-set-fuel {seq qty} {
   upvar \#0 map-$seq map
-  set map(fuel) $qty
+  set map(fuel) [expr {int($qty)}]
   select-world $seq
+  show-connectivity $seq
 }
 
 # --- Making a new map window ---
@@ -607,10 +616,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..." \
-      -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 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 \
@@ -643,6 +656,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]
+  $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
 
@@ -658,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 <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
 }
@@ -802,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} {
@@ -927,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 \
@@ -1151,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
 }
 
@@ -1190,14 +1190,27 @@ proc cmdr-new {} {
 
 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 {