From: mgc@cray.com (M. G. Christenson)
Subject: Re: Automatic Scrolling
Reply-To: mgc@cray.com
Organization: Cray Research, Inc.
Date: 24 Dec 92 01:14:40 CST

>Hi,
>
>I am trying to implement automatic scrolling for scrollable canvas.
>Instead of using the scroll bar, the canvas will be scrolling when
>the mouse pointer is outside of the canvas. (The canvas will scroll
>to the opposite direction of the location of the mouse pointer.)
>(This feature is great when you want to drag a widget across a
>scrollable canvas, so you can always see the widget at the edge
>of the canvas.)
>
>I have tried to implement this feature through bindings. However
>it does not work out nicely, since the events are not repeated.
>
>Has someone tried to accomplish similar task before?
>Any input would be appreciated.
>
>Te-Wei Sun
>tewei@bnr.ca

Here is the code I use, along with an example.  Hopefully the usage
will be apparent from the example.

--Mark

proc autoscroll_var w {
    global autoscroll_index

    if [info exists autoscroll_index($w)] {
	return autoscroll.$autoscroll_index($w)
    } else {
	if [info exists autoscroll_index(next)] {
	    set next [expr {$autoscroll_index(next) + 1}]
	} else {
	    set next 0
	}
	set autoscroll_index(next) $next
	return autoscroll.[set autoscroll_index($w) $next]
    }
}

proc autoscroll_init \
    {w delta_t {yscrollbar {}} {delta_y 1} {xscrollbar {}} {delta_x 1}} {
    upvar #0 [autoscroll_var $w] v

    if {$delta_t == 0} {
	catch {unset v}
	return {}
    }

    set v(autoscroll_delta_t) $delta_t
    set v(autoscroll_delta_x) $delta_x
    set v(autoscroll_delta_y) $delta_y

    set v(autoscroll_xscrollbar) $xscrollbar
    if {$xscrollbar == {}} {
	set v(autoscroll_dx) 0
    }
    set v(autoscroll_yscrollbar) $yscrollbar
    if {$yscrollbar == {}} {
	set v(autoscroll_dy) 0
    }

    if {[trace vinfo v(autoscroll_dx)] == {}} {
	set v(autoscrolling) 0
	set v(autoscroll_dx) 0
	set v(autoscroll_dy) 0

	trace variable v(autoscroll_dx) w "autoscroll $w"
	trace variable v(autoscroll_dy) w "autoscroll $w"
    }

    return {}
}

proc autoscroll_event {w x y event} {
    set cmd [bind $w $event]
    if {$cmd == {}} {
	set cmd [bind [winfo class $w] $event]
    }
    if {$cmd != {}} {
	regsub -all W $cmd $w cmd
	regsub -all 2bfa10 $cmd $x cmd
	regsub -all y $cmd $y cmd
	uplevel #0 $cmd
    }
}

proc autoscroll {w args} {
    upvar #0 [autoscroll_var $w] v

    if {$args == {}} {
	if $v(autoscroll_dx) {
	    set current [lindex [$v(autoscroll_xscrollbar) get] 2]
	    set cmd [lindex [$v(autoscroll_xscrollbar) config -command] 4]
	    eval $cmd [expr "$current + $v(autoscroll_dx)"]
	    if {$v(autoscroll_event) != {}} {
		autoscroll_event $w $v(autoscroll_x) $v(autoscroll_y) \
		    $v(autoscroll_event)
	    }
	}
	if $v(autoscroll_dy) {
	    set current [lindex [$v(autoscroll_yscrollbar) get] 2]
	    set cmd [lindex [$v(autoscroll_yscrollbar) config -command] 4]
	    eval $cmd [expr "$current + $v(autoscroll_dy)"]
	    if {$v(autoscroll_event) != {}} {
		autoscroll_event $w $v(autoscroll_x) $v(autoscroll_y) \
		    $v(autoscroll_event)
	    }
	}
	set v(autoscrolling) 0
    }

    if {$v(autoscroll_dx) || $v(autoscroll_dy)} {
	if !$v(autoscrolling) {
	    set v(autoscrolling) 1
	    after $v(autoscroll_delta_t) autoscroll $w
	}
    } else {
	set v(autoscrolling) 0
    }
}

proc clear_autoscroll {w} {
    upvar #0 [autoscroll_var $w] v

    if [info exists v] {
	set v(autoscroll_dx) 0
	set v(autoscroll_dy) 0
    }
    return {}
}

proc check_autoscroll {w x y {event {}}} {
    upvar #0 [autoscroll_var $w] v

    if ![info exists v] {
	return {}
    }

    set dx 0
    if {$v(autoscroll_xscrollbar) != {}} {
	if {$x < 0} {
	    set dx -$v(autoscroll_delta_x)
	} else {
	    if {$x >= [winfo width $w]} {
		set dx $v(autoscroll_delta_x)
	    }
	}
    }

    set dy 0
    if {$v(autoscroll_yscrollbar) != {}} {
	if {$y < 0} {
	    set dy -$v(autoscroll_delta_y)
	} else {
	    if {$y >= [winfo height $w]} {
		set dy $v(autoscroll_delta_y)
	    }
	}
    }

    set v(autoscroll_x) $x
    set v(autoscroll_y) $y
    set v(autoscroll_event) $event

    if {$v(autoscroll_dx) != $dx} {
	set v(autoscroll_dx) $dx
    }

    if {$v(autoscroll_dy) != $dy} {
	set v(autoscroll_dy) $dy
    }

    return {}
}

proc bind_for_autoscroll {{classes {Text Listbox Canvas Entry}}} {
    foreach class $classes {
	bind $class <B1-Motion> {+check_autoscroll W 2c03bd y <B1-Motion>}
	bind $class <Shift-B1-Motion> \
	    {+check_autoscroll W 2c0426 y <Shift-B1-Motion>}
	bind $class <Any-ButtonRelease-1> {+clear_autoscroll W}
    }
}

proc autoscroll_example {} {
    catch {destroy .example}

    frame .example
    scrollbar .example.h -orient horizontal -command ".example.c xview"
    scrollbar .example.v -command ".example.c yview"
    canvas .example.c -confine 0 -xscrollcommand ".example.h set" \
	-yscrollcommand ".example.v set"

    bind .example.c <1> {set x [W canvasx 2c05e9]; set y [W canvasy y]}
    bind .example.c <B1-Motion> {
	W delete oval
	set xx  [W canvasx 2c066a]
	set yy  [W canvasy y]
	W create oval \
	    $x $y $xx $yy -tag oval -fill red
	W config -scrollregion [W bbox withtag oval]
    }

    autoscroll_init .example.c 100 .example.v 1 .example.h 1

    bind_for_autoscroll .example.c

    pack append .example \
	.example.h {bottom fillx} \
	.example.c {left expand fill} \
	.example.v {left filly}

    pack append . .example {top expand fill}
}