From 7ab71be9a9a6307947b3ac4ffc90e2a6d10f57b4 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Sat, 12 Dec 2009 15:09:57 +0000
Subject: [PATCH] where-vessels: can acquire

---
 yarrg/where-vessels | 50 +++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 48 insertions(+), 2 deletions(-)

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index c0252a0..8886c79 100755
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -278,6 +278,8 @@ proc chart-got/league {x1 y1 x2 y2 kind} {
 proc draw {} {
     global chart count isleloc canvas
     
+    $canvas delete all
+
     foreach l [split $chart "\n"] {
 #	debug "CHART-GOT $l"
 	set proc [lindex $l 0]
@@ -320,7 +322,7 @@ proc draw {} {
 #---------- user interface ----------
 
 proc widgets-setup {} {
-    global canvas debug
+    global canvas debug acqdeffont
 
     frame .f -border 1 -relief groove
     set canvas .f.c
@@ -344,6 +346,20 @@ proc widgets-setup {} {
     button .ctrl.zoom.in  -text + -font {Courier 16} -command {zoom *2}
     pack .ctrl.zoom.out .ctrl.zoom.in -side left
 
+    frame .ctrl.acquire
+    button .ctrl.acquire.do -text Acquire -command acquire
+
+    frame .ctrl.acquire.resframe -width 120 -height 32
+    button .ctrl.acquire.resframe.res -text {} -anchor nw \
+	-padx 1 -pady 1 -borderwidth 0 -justify left
+    glset acqdeffont [.ctrl.acquire.resframe.res cget -font]
+    place .ctrl.acquire.resframe.res -relx 0.5 -y 0 -anchor n
+    #	-relheight 1.0 -relwidth 1.0
+
+    pack .ctrl.acquire.do -side top
+    pack .ctrl.acquire.resframe -side top -expand y -fill both
+    pack .ctrl.acquire -side top
+
     wm geometry . 1024x480
 }
 
@@ -353,7 +369,37 @@ proc zoom {extail} {
     debug "ZOOM $scale $nscale"
     if {$nscale < 1 || $nscale > 200} return
     set scale $nscale
-    $canvas delete all
+    draw
+}
+
+proc acquire_showerror {} {
+    global acqerr
+    tk_messageBox -type ok \
+	-title "where-vessels: clipboard parsing error" \
+	-message $acqerr
+}
+
+proc acquire {} {
+    global clipboard acqdeffont acqerr
+    set old $clipboard
+    if {[catch {
+	set clipboard [clipboard get]
+	parse-clipboard
+	.ctrl.acquire.resframe.res configure \
+	    -background blue -disabledforeground black -font $acqdeffont \
+	    -state disabled -command {} \
+	    -text " acquired ok "
+    } emsg]} {
+	set acqerr "clipboard parsing failed: $emsg"
+	puts stderr $acqerr
+	regsub -all {.{18}} "error: [string trim $emsg]" "&\n" ewrap
+	.ctrl.acquire.resframe.res configure \
+	    -background red -foreground white -font fixed \
+	    -state normal -command acquire_showerror \
+	    -text $ewrap
+	set clipboard $old
+	parse-clipboard
+    }
     draw
 }
 
-- 
2.30.2