X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=blobdiff_plain;f=yarrg%2Fpanner.tcl;h=77729b19b1bf37a72b038910e616d507ae934504;hp=cc3819aaa3af154d5efd37bb2768269336603778;hb=13931006f26ed2707664989b5adb5ed893054dc2;hpb=66b7b921f50bc3242a7e45a63a94391bcebf7cb9 diff --git a/yarrg/panner.tcl b/yarrg/panner.tcl index cc3819a..77729b1 100644 --- 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 +# +# 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 . +# +# 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 }