chiark / gitweb /
panner: mouse motion debug only if debug>=2
[ypp-sc-tools.db-test.git] / yarrg / panner.tcl
index cc3819aaa3af154d5efd37bb2768269336603778..7c598fe7d06090dcef6a048c7e2aef24fc0181be 100644 (file)
@@ -7,8 +7,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 +82,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 +149,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 +181,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
 }