where-vessels: fanchuans

[ypp-sc-tools.db-live.git] / yarrg / panner.tcl

diff --git a/yarrg/panner.tcl b/yarrg/panner.tcl
index cc3819aaa3af154d5efd37bb2768269336603778..77729b19b1bf37a72b038910e616d507ae934504 100644 (file)
--- a/yarrg/panner.tcl
+++ b/yarrg/panner.tcl
@@ -1,3 +1,29 @@
+# -*- Tcl -*-
+# Tcl panner widget
+
+# 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.
+
+
 package provide panner 0.1;
 namespace eval panner {
 
@@ -7,8 +33,8 @@ proc pannerproc {name argl body} {
 $body
 "
 }
-pannerproc _debug {m} {
-    if {!$d(debug)} return
+pannerproc _debug {m {minlevel 1}} {
+    if {$d(debug) < $minlevel} return
     puts "PANNER $w $m"
 }
 
@@ -82,6 +108,8 @@ pannerproc updatecanvas-bbox {} {
 
 pannerproc updatecanvas {} {
     set d(bbox) [$d(canvas) cget -scrollregion]
+    if {[llength $d(bbox)] < 4} { set d(enabled) 0; _noshow $w; return }
+    
     manyset $d(bbox) x1 y1 x2 y2
     set d(cwidth) [expr {$x2-$x1}]
     set d(cheight) [expr {$y2-$y1}]
@@ -147,12 +175,12 @@ pannerproc _resize {why} {
 pannerproc _mapc {view which} {
     set viewpos [lindex [$d(canvas) $view] $which]
     set r [expr {$viewpos * $d(mul_$view) + $d(add_$view)}]
-    _debug $w "  _mapc $view wh=$which viewpos=$viewpos => $r"
+    _debug $w "  _mapc $view wh=$which viewpos=$viewpos => $r" 2
     return $r
 }
 
 pannerproc _redisplay {} {
-    _debug $w "_redisplay"
+    _debug $w "_redisplay" 2
     $w coords core \
        [_mapc $w xview 0] \
        [_mapc $w yview 0] \
@@ -179,7 +207,7 @@ pannerproc _motion {x y} {
        $d(canvas) ${xy}view moveto $newpos
        lappend dl $newpos
     }
-    _debug $w "_motion $x,$y [join $dl ,]"
+    _debug $w "_motion $x,$y [join $dl ,]" 2
     _redisplay $w
 }