Support for an IE-like panning tool.
# Usage:
#
# pan::pan bind $w
#
# Add pan capabilities to a tcl/tk widget, including BLT graphs.
#
# Either middle click to start pan, move the mouse in the direction you
# want to pan followed by any click to stop, or middle press to start
# pan, move the mouse in the direction you want to pan followed by middle
# release to stop. There is a timeout which stops panning after 10 seconds
# of no mouse movement.
#
# pan::pan start $w
#
# Start panning the widget from current mouse position. Use this for
# example from a context sensitive menu with an entry for panning.
#
# Resources:
#
# The .pan widget is a toplevel undecorated window of class Pan
# which contains a label. The single .pan widget is shared by
# all graphs. You can control its features using the usual label
# resources, indicated by *Pan.Label*.
#
# You can control the pan repeat rate (milliseconds) and increment using
# *Pan.Rate: 200
# *Axis.ScrollIncrement: 1
# The step size is scaled linearly with the number of pixels.
# Pan.Accel determines the number of pixels away to increase
# speed by one scrollincrement per repeat.
# *Pan.Accel: 20
# Since we have an application grab, we also have a timeout set.
# *Pan.Timeout: 10000
# Alternatively, you can set the variables ::pan::rate, ::pan::accel
# and ::pan::timeout
#
# Axis.ScrollIncrement is a BLT resource. It is set to 1 at the
# widgetDefault level when pan.tcl is sourced. Be sure to source
# pan.tcl before creating your graphs.
#
# Pan is attached to the middle mouse button. You could for example
# attach it to button 1 using the following in lieu of pan::pan bind
#
# bind $w <ButtonPress-1> { ::pan::pan start %W %X %Y }
# bind $w <ButtonRelease-1> { ::pan::pan stop %W }
# bind $w <B1-Motion> { ::pan::pan move %W %X %Y }
#
# Test using
# $wish pan.tcl
# zoom into a region with the left button and use the middle button to pan.
#
# To do:
# The pan widget and the cursors are not as pretty as they might be.
# Keyboard support --- bind arrow keys to cursor warping events.
# This program is in the public domain.
#
# Please edit this as you see fit, but update the changelog.
#
# 2003-05-29 Paul Kienzle <pkienzle at users sf net>
# * initial release
namespace eval pan {
# use these cursors to indicate pan direction
variable cursor
array set cursor {
++ bottom_right_corner
+= bottom_side
+- bottom_left_corner
=+ right_side
== fleur
=- left_side
-+ top_right_corner
-= top_side
-- top_left_corner
}
# internal: xview and yview for BLT graphs
proc graph_xview { w args } {
foreach side { xaxis x2axis } {
foreach axis [$w $side use] {
eval $w axis view $axis $args
}
}
}
proc graph_yview { w args } {
foreach side { yaxis y2axis } {
foreach axis [$w $side use] {
eval $w axis view $axis $args
}
}
}
# internal: convert a direction to a cursor code
proc dir { value } {
if { $value > 0 } {
return +
} elseif { $value < 0 } {
return -
} else {
return =
}
}
# pan actions
proc pan { action { w {} } { x {} } { y {} } } {
variable timeout
variable rate
variable accel
variable cursor
variable pan
switch $action {
init { # initialize the pan icon (only called once)
# Create pan icon
toplevel .pan -class Pan
wm overrideredirect .pan 1
wm withdraw .pan
.pan conf -cursor $cursor(==)
option add *Pan.Label.Background yellow widgetDefault
option add *Pan.Label.Relief raised widgetDefault
pack [label .pan.label -text Pan]
# Get resources
foreach {var val} { rate 200 accel 20 timeout 10000 } {
if {![info exists $var]} {
set tvar [string totitle $var]
option add *Pan.$tvar $val widgetDefault
set $var [option get .pan $var $tvar]
}
}
# Make sure future graphs use a small increment
option add *Axis.ScrollIncrement 1 widgetDefault
}
bind { # bind panning to a widget
bind $w <ButtonPress-2> { ::pan::pan start %W %X %Y }
bind $w <ButtonRelease-2> { ::pan::pan stop %W }
bind $w <B2-Motion> { ::pan::pan move %W %X %Y }
}
start { # start panning
if { [info exists pan($w,x)] } { return }
# if no x-position, start from current cursor --- this
# can happen if panning is triggered by something other
# than the mouse bindings, such as a context sensitive
# menu.
if { [llength $x] == 0 } {
foreach { x y } [winfo pointerxy .] break
}
# remember the initial state
set pan($w,x) $x
set pan($w,y) $y
set pan($w,v) 0
set pan($w,h) 0
set pan($w,cursor) [$w cget -cursor]
set pan($w,focus) [focus]
# set the cursor
$w conf -cursor $cursor(==)
.pan conf -cursor $cursor(==)
# display the pan icon
set xpos [expr {$x-[winfo width .pan]/2}]
set ypos [expr {$y-[winfo height .pan]/2}]
wm geometry .pan +$xpos+$ypos
wm deiconify .pan
raise .pan
# associate panning actions with the current widget
bind .pan <Motion> [list ::pan::pan move $w %X %Y]
bind .pan <ButtonPress> [list set ::pan::pan($w,motion) 1]
bind .pan <ButtonRelease> [list ::pan::pan stop $w]
grab set .pan
# start panning --- don't really need to start until
# after the mouse moves, but it doesn't seem to hurt
# anything starting immediately
after 0 [list ::pan::pan step $w]
# set timeout
after $timeout [list ::pan::pan cancel $w]
}
move { # mouse motion
if { ![info exists pan($w,x)] } { return }
# compute new step size
set v [expr {$y - $pan($w,y)}]
set h [expr {$x - $pan($w,x)}]
set vstep [expr {abs($v)/$accel}]
set hstep [expr {abs($h)/$accel}]
if {$v>=0} { set vsign 1 } { set vsign -1 }
if {$h>=0} { set hsign 1 } { set hsign -1 }
set pan($w,v) [expr {$vstep*$vsign}]
set pan($w,h) [expr {$hstep*$hsign}]
# puts "$v $vstep $vsign $h $hstep $hsign"
# set new cursor
$w conf -cursor $cursor([dir $pan($w,v)][dir $pan($w,h)])
.pan conf -cursor $cursor([dir $pan($w,v)][dir $pan($w,h)])
# remember that there is motion --- if there is no motion
# between press and release, then it is a click action and
# the pan icon stays until the next click.
set pan($w,motion) 1
# reset timeout
after cancel [list ::pan::pan cancel $w]
after $timeout [list ::pan::pan cancel $w]
}
step { # do the panning
if { ![info exists pan($w,x)] } { return }
# handle blt::graph specially --- perhaps want to generalize
# so that we can add functions for all widgets that do not
# support xview/yview.
if { [winfo class $w] == "Graph" } {
graph_xview $w scroll $pan($w,h) units
graph_yview $w scroll $pan($w,v) units
} else {
$w xview scroll $pan($w,h) units
$w yview scroll $pan($w,v) units
}
# program the next step
after $rate [list ::pan::pan step $w]
}
stop { # button release
# if the mouse hasn't moved yet, don't cancel panning
if { [info exists pan($w,motion)] } { ::pan::pan cancel $w }
}
cancel { # cancel panning for whatever reason
if { ![info exists pan($w,x)] } { return }
# restore state
grab release .pan
wm withdraw .pan
$w conf -cursor $pan($w,cursor)
focus $pan($w,focus)
# clear variables
foreach el [array names pan "$w,*"] { unset pan($el) }
# stop panning update
after cancel [list ::pan::pan step $w]
# stop timeout
after cancel [list ::pan::pan cancel $w]
}
}
}
# initialize pan widget
# use catch so that the file can be sourced multiple times
catch { pan init }
}
# Test code
if {[info exists argv0] && [file tail [info script]]==[file tail $argv0]} {
catch {
# add a blt graph if blt is available
package require BLT
blt::graph .g
.g elem create x -xdata { 1 2 3 4 5 } -ydata { 2 1 3 1 2 }
Blt_ZoomStack .g
pan::pan bind .g
grid .g - -sticky news
}
# add a text widget
text .t -width 10 -height 5 -wrap no \
-xscrollcommand { .h set } -yscrollcommand { .v set }
scrollbar .h -orient h -command { .t xview }
scrollbar .v -orient v -command { .t yview }
.t insert end "1 This is a bunch of text which I am using to test the panning capabilities\n2 of the text widget.\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22 end of text ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- really!"
pan::pan bind .t
grid .t x -sticky news
grid .h x -sticky ew
grid .v -row 1 -column 1 -sticky ns
grid columnconf . 0 -weight 1
}