From: Ian Jackson <ian@liberator.(none)>
Date: Thu, 10 Dec 2009 20:23:12 +0000 (+0000)
Subject: where-vessels: Include panner and (nonfunctional) zoom buttons
X-Git-Tag: 6.3.0~14
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=commitdiff_plain;h=3616ca51dd30ef8b9b1e50180ace8f16fdf6acf8;hp=66b7b921f50bc3242a7e45a63a94391bcebf7cb9;ds=sidebyside

where-vessels: Include panner and (nonfunctional) zoom buttons
---

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index a827892..a7afc1e 100755
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -1,5 +1,10 @@
 #!/usr/bin/wish
 
+pkg_mkIndex .
+set auto_path [concat . $auto_path]
+
+package require panner
+
 set us Aristarchus
 
 proc manyset {list args} {
@@ -114,9 +119,9 @@ set canvas .f.c
 canvas $canvas
 #$canvas configure -width 1000 -height 800
 pack $canvas -expand 1 -fill both
-pack .f -expand 1 -fill both
+pack .f -expand 1 -fill both -side left
 
-set scale 15
+set scale 16
 
 proc coord {c} {
 	global scale
@@ -188,4 +193,21 @@ foreach nk [lsort [array names $note]] {
 	puts "IGNORED NOTE $nk"
 }
 
+frame .ctrl
+pack .ctrl -side right
+
+panner::canvas-scroll-bbox .f.c
+panner::create .ctrl.pan .f.c 200 200
+
+pack .ctrl.pan -side top -pady 20 -padx 20
+frame .ctrl.zoom
+pack .ctrl.zoom -side top
+
+button .ctrl.zoom.out -text - -font {Courier 16}
+button .ctrl.zoom.in  -text + -font  {Courier 16}
+pack .ctrl.zoom.out .ctrl.zoom.in -side left
+
+#. configure -width 640 -height 480
+wm geometry . 1024x480
+
 #puts "[$canvas bbox all]"