X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fwhere-vessels;h=ecf1e063156bbd3ddee66d3359da8a4ab5b6b1da;hb=4f2334b5230b2ee0f3a1416bb7f4019d684fb520;hp=43d4a60db0cda0fb3e2af0608cc94e524622176b;hpb=9f61e96561e428dad8e20156731594b0be7d178e;p=ypp-sc-tools.main.git

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index 43d4a60..ecf1e06 100755
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -1,9 +1,36 @@
 #!/usr/bin/wish
+# show your vessels on a map
+
+# This is part of ypp-sc-tools, a set of third-party tools for assisting
+# players of Yohoho Puzzle Pirates.
+#
+# Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+#
+# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+# are used without permission.  This program is not endorsed or
+# sponsored by Three Rings.
+
+
 
 source yarrglib.tcl
 source panner.tcl
 package require http
 
+#---------- general utilities ----------
+
 set debug 0
 proc debug {m} {
     global debug
@@ -15,6 +42,13 @@ proc badusage {m} {
     exit 1
 }
 
+proc glset {n val} {
+    upvar #0 $n var
+    set var $val
+}
+
+#---------- argument parsing ----------
+
 proc nextarg {} {
     global ai argv
     if {$ai >= [llength $argv]} {
@@ -25,11 +59,6 @@ proc nextarg {} {
     return $v
 }
 
-proc glset {n val} {
-    upvar #0 $n var
-    set var $val
-}
-
 set notes_loc vessel-notes
 set scraper {./yppedia-ocean-scraper --chart}
 
@@ -66,6 +95,9 @@ proc argdefaults {} {
     lappend scraper $ocean
 }
 
+
+#---------- loading and parsing the vessel notes ----------
+
 proc load-notes {} {
     global notes_loc notes
     catch { unset notes }
@@ -95,6 +127,8 @@ proc load-notes {} {
 }
 
 
+#---------- loading and parsing the clipboard (vessel locations) ----------
+
 proc vessel {vin} {
 	global pirate notes_used
 	upvar 1 $vin vi
@@ -187,6 +221,9 @@ proc load-clipboard-file {fn} {
     close $f
 }
 
+
+#---------- loading and parsing the chart ----------
+
 proc load-chart {} {
     global chart scraper
     debug "FETCHING CHART"
@@ -241,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]
@@ -280,8 +319,10 @@ proc draw {} {
 }
 
 
+#---------- user interface ----------
+
 proc widgets-setup {} {
-    global canvas debug
+    global canvas debug acqdeffont
 
     frame .f -border 1 -relief groove
     set canvas .f.c
@@ -305,20 +346,66 @@ 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
 }
 
-
 proc zoom {extail} {
     global scale canvas
     set nscale [expr "\$scale $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 errorInfo
+    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
+	append acqerr "\n$errorInfo"
+	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
+}
+
+
+#---------- main program ----------
 
 parseargs
 argdefaults