From d20804748f46e3687d947cc664644c2b6518f954 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Thu, 10 Dec 2009 23:21:16 +0000
Subject: [PATCH] WIP where-vessels zooming works

---
 yarrg/where-vessels | 35 +++++++++++++++++++++++++----------
 1 file changed, 25 insertions(+), 10 deletions(-)

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index 0b32a48..f7bbef6 100755
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -99,7 +99,7 @@ while {[gets $cl l] >= 0} {
 }
 close $cl
 
-set chart [open |[list perl -we {
+set chart [exec perl -we {
 	use strict;
 	use CommodsScrape;
 	use IO::File;
@@ -112,7 +112,7 @@ set chart [open |[list perl -we {
 		sub { printf STDERR "warning: %s: incomprehensible: %s", @_; }
 			);
 	STDOUT->error and die $!;
-}] r]
+}]
 
 frame .f -border 1 -relief groove
 set canvas .f.c
@@ -152,16 +152,17 @@ proc chart-got/league {x1 y1 x2 y2 kind} {
 	}
 }
 
-while {[gets $chart l] >= 0} {
+proc draw {} {
+    global chart count isleloc canvas
+    
+    foreach l [split $chart "\n"] {
 #	puts "CHART-GOT $l"
 	set proc [lindex $l 0]
 	eval chart-got/$proc [lrange $l 1 end]
-}
-
-puts WILLSHOW
+    }
 
-set lastislandname {}
-foreach key [lsort [array names count]] {
+    set lastislandname {}
+    foreach key [lsort [array names count]] {
 	set c $count($key)
 #	puts "SHOWING $key $c"
 	regexp {^(.*) (\S+)$} $key dummy islandname abbrev
@@ -187,8 +188,11 @@ foreach key [lsort [array names count]] {
 	$canvas lower $bid $id
 	manyset $bbox dummy dummy dummy y
 #	puts "NEW Y $y"
+    }
 }
 
+draw
+
 foreach nk [lsort [array names $note]] {
 	puts "IGNORED NOTE $nk"
 }
@@ -203,8 +207,19 @@ pack .ctrl.pan -side top -pady 10 -padx 5
 frame .ctrl.zoom
 pack .ctrl.zoom -side top
 
-button .ctrl.zoom.out -text - -font {Courier 16}
-button .ctrl.zoom.in  -text + -font  {Courier 16}
+proc zoom {extail} {
+    global scale canvas
+    set nscale [expr "\$scale $extail"]
+    puts "ZOOM $scale $nscale"
+    if {$nscale < 1 || $nscale > 200} return
+    set scale $nscale
+    $canvas delete all
+    draw
+    panner::updatecanvas-bbox .ctrl.pan
+}
+
+button .ctrl.zoom.out -text - -font {Courier 16} -command {zoom /2}
+button .ctrl.zoom.in  -text + -font {Courier 16} -command {zoom *2}
 pack .ctrl.zoom.out .ctrl.zoom.in -side left
 
 #. configure -width 640 -height 480
-- 
2.30.2