Support smooth scrolling of Canvas widgets and demonstrate it in the simple scrollable canvas demo.

3 files changed, 32 insertions, 26 deletions

diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl
index 98a4be2..a72a08b 100644
--- a/library/demos/cscroll.tcl
+++ b/library/demos/cscroll.tcl
@@ -108,6 +108,13 @@ if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk
 	    %W xview scroll [expr {(%D-2)/-3}] units
 	}
     }
+    #Touchpad scrolling
+    bind $c <Control-MouseWheel> {
+	lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+	if {$deltaX != 0 || $deltaY != 0} {
+	    tk::CanvasScrollByPixels %W $deltaX $deltaY
+	}
+    }
 }
 
 if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8.7-]} {
diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl
index 4038e15..3ef9deb 100644
--- a/library/scrlbar.tcl
+++ b/library/scrlbar.tcl
@@ -140,10 +140,10 @@ bind Scrollbar <MouseWheel> {
 bind Scrollbar <Control-MouseWheel> {
     lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
     if {$deltaX != 0} {
-	tk::ScrollByPixels %W h $deltaX
+	ScrollbarScrollByPixels %W h $deltaX
     }
     if {$deltaY != 0} {
-	tk::ScrollByPixels %W v $deltaY
+	ScrollbarScrollByPixels %W v $deltaY
     }
 }
 
@@ -307,10 +307,10 @@ proc ::tk::ScrollEndDrag {w x y} {
     set Priv(initPos) ""
 }
 
-# ::tk::ScrollByPixels --
+# ScrollbarScrollByPixels --
 # This procedure tells the scrollbar's associated widget to scroll up
-# or down by a given number of pixels.  It notifies the associated widget
-# in different ways for old and new command syntaxes.
+# or down by a given number of pixels.  It only works with scrollbars
+# because it uses the delta command.
 #
 # Arguments:
 # w -		The scrollbar widget.
@@ -318,38 +318,24 @@ proc ::tk::ScrollEndDrag {w x y} {
 #		horizontal, "v" for vertical.
 # amount -	How many pixels to scroll.
 
-proc ::tk::ScrollByPixels {w orient amount} {
-    set cmd [$w cget -command]
+proc ScrollbarScrollByPixels {sb orient amount} {
+    set cmd [$sb cget -command]
     if {$cmd eq ""} {
 	return
     }
     set xyview [lindex [split $cmd] end]
-    if {$orient eq "v"} {
-	if {$xyview eq "xview"} {
-	    return
-	}
-	set size [winfo height $w]
-    }
-    if {$orient eq "h"} {
-	if {$xyview eq "yview"} {
-	    return
-	}
-	set size [winfo width $w]
+    if {$orient eq "v" && $xyview eq "xview" || \
+	$orient eq "h" && $xyview eq "yview"} {    
+	return
     }
-
-    # The moveto command allows scrolling by pixel deltas even for
-    # widgets which only support scrolling by units or pages.  The
-    # code below works with both the current and old syntax for the
-    # scrollbar get command.
-
-    set info [$w get]
+    set info [$sb get]
     if {[llength $info] == 2} {
 	set first [lindex $info 0]
     } else {
 	set first [lindex $info 2]
     }
     set pixels [expr {-$amount}]
-    uplevel #0 $cmd moveto [expr $first + [$w delta $pixels $pixels]]
+    uplevel #0 $cmd moveto [expr $first + [$sb delta $pixels $pixels]]
 }
 
 # ::tk::ScrollByUnits --
diff --git a/library/tk.tcl b/library/tk.tcl
index 0bb49eb..1345fbf 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -844,6 +844,19 @@ if {[tk windowingsystem] eq "x11"} {
 if {$::ttk::library ne ""} {
     uplevel \#0 [list source -encoding utf-8 $::ttk::library/ttk.tcl]
 }
+
+# Helper for smooth scrolling of Canvas widgets
+proc ::tk::CanvasScrollByPixels {canvas deltaX deltaY} {
+    set width [expr {1.0 * [$canvas cget -width]}]
+    set height [expr {1.0 * [$canvas cget -height]}]
+    set X [lindex [$canvas xview] 0]
+    set Y [lindex [$canvas yview] 0]
+    set x [expr {$X - $deltaX / $width}]
+    set y [expr {$Y - $deltaY / $height}]
+    $canvas xview moveto $x
+    $canvas yview moveto $y
+}
+
 
 # Local Variables:
 # mode: tcl