+# -*- 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 {
$body
"
}
-pannerproc _debug {m} {
- if {!$d(debug)} return
+pannerproc _debug {m {minlevel 1}} {
+ if {$d(debug) < $minlevel} return
puts "PANNER $w $m"
}
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}]
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] \
$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
}