namespace eval ::tapandhold {
variable ballcount 0
variable afterid ""
variable nrballs 8
variable balldistance 20
variable ballsize 10
variable PI [expr {atan(1.0) * 4.0}]
proc showball {command w m x y} {
variable ballcount
variable nrballs
variable balldistance
variable ballsize
variable afterid
variable PI
if { $ballcount < $nrballs } {
set angle [expr {2.0*$PI*($ballcount+0)/$nrballs} ]
set dx [expr {int($balldistance*sin($angle))}]
set dy [expr {int(-$balldistance*cos($angle))}]
toplevel .tapandholdball_$ballcount
wm overrideredirect .tapandholdball_$ballcount true
wm geometry .tapandholdball_$ballcount "${ballsize}x${ballsize}+[expr {$x+$dx}]+[expr {$y+$dy}]"
pack [canvas .tapandholdball_$ballcount.c -bg blue -width $ballsize -height $ballsize]
set afterid [after 100 "::tapandhold::showball $command $w $m $x $y"]
incr ballcount
} else {
::tapandhold::stopball
update
bell
if { $command eq "popup" } {
tk_popup $m $x $y 0
} else {
$m $w $x $y
}
}
}
proc stopball { } {
variable ballcount
variable afterid
catch { after cancel $afterid}
for { set n 0 } { $n < $ballcount } { incr n } {
destroy .tapandholdball_$n
}
set ballcount 0
}
proc tapandhold_bind {command w m} {
if { $command ne "popup" && $command ne "command" } {
error "bad option $command must be popup or command"
}
bind $w <ButtonPress-1> "
::tapandhold::showball $command $w $m %X %Y
"
bind $w <ButtonRelease-1> {
::tapandhold::stopball
}
bind $w <Motion> {
::tapandhold::stopball
}
}
}# A little demonstration (must be small to fit the pocketpc) :
proc makemymenu { window x y } {
menu .menu2 -tearoff false
set now [clock format [clock seconds]]
set comm [list .t1 insert end $now\n]
.menu2 add command -command $comm -label $now
puts [tk_popup .menu2 $x $y 0]
update
destroy .menu2
}
menu .menu -tearoff false
.menu add command -label {Item1} -command {.t insert end "Choosen 1\n"}
.menu add command -label {Item2} -command {.t insert end "Choosen 2\n"}
pack [text .t -height 10 -width 35]
pack [text .t1 -height 10 -width 35]
::tapandhold::tapandhold_bind popup .t .menu
::tapandhold::tapandhold_bind command .t1 makemymenuIt's a bit tricky to use it on the pocketpc, since any movement of the stylus will abort the tap&hold. SRIV Neat! I've been thinking of adding something like this into Whim window manager for use on the N770. Would it be less tricky if you took out the <Motion> handler, or is that needed?RS: Very cool indeed! I tried it under eTcl on my HTC Magician, and it works. And of course I couldn't resist to make it simpler :)
- The balls are of course square, as they are tiny toplevels. But to pack a canvas on each is redundant - just give the toplevels -bg blue (lightblue seems to be more similar to what CE does)
- PI can be calculated simpler as [expr atan(-1)] - and braces are really not needed here. They are not some special expr syntax, but just say: "group, but don't substitute". As there's nothing to substitute in atan(-1), the effect is the same without braces
- The update in showball can be taken out without noticeable effect. However, in makemymenu it's needed, otherwise the action (inserting the time/date string) is not done
- The <Motion> handler is important so you can still mark text, without the "balls" getting in the way - but <B1-Motion> should be enough
Another idea: As "tap and hold" is to emulate right-click, why not let it generate a <3> event? Portable code can use <3>, and with a single line
tapandhold::init $wcan enable the <3>-emulation for a widget. Here's this variation by RS:
namespace eval ::tapandhold {
variable ballcount -3 nrballs 8 distance 16 size 5
proc showball {w x y} {
variable ballcount; variable nrballs
variable distance; variable size
if { $ballcount < $nrballs } {
if {$ballcount > -1} {
set angle [expr {2.0*acos(-1)*$ballcount/$nrballs} ]
set dx [expr {int($distance*sin($angle))}]
set dy [expr {int(-$distance*cos($angle))}]
toplevel .tapandholdball_$ballcount -bg lightblue
wm overrideredirect .tapandholdball_$ballcount 1
wm geometry .tapandholdball_$ballcount \
${size}x${size}+[expr {$x+$dx}]+[expr {$y+$dy}]
}
variable afterid [after 50 "::tapandhold::showball $w $x $y"]
incr ballcount
} else {
stopball
bell
event generate $w <3> -x [expr {$x-[winfo rootx $w]}]\
-y [expr {$y-[winfo rooty $w]}]
}
}
proc stopball {} {
variable ballcount; variable afterid
catch {after cancel $afterid}
for {set n 0} {$n < $ballcount} {incr n} {
destroy .tapandholdball_$n
}
set ballcount -3
}
}
proc tapandhold::init w {
bind $w <1> [list ::tapandhold::showball $w %X %Y]
bind $w <ButtonRelease-1> ::tapandhold::stopball
bind $w <B1-Motion> ::tapandhold::stopball
}#----------- Demo menu .m -tearoff false
.m add command -label Foo -command {.t insert end foo\n}
.m add command -label Bar -command {.t insert end bar\n}
pack [text .t -height 20 -width 35]
tapandhold::init .t
bind .t <3> {tk_popup .m %X %Y}Tested to work on Win95 at home, and XP at work, but most of all on PocketPC under eTcl.PWE The version by RS is clearly better, I especially like the "event generate". However when trying this in a BWidget NoteBook, I had the problem not being able to select other notebook tabs, after a tapandhold event. The first other tab succeeds, after that you can only select other tabs if you first click in the window of the tab. This problem only occurs with etcl on the pocket pc, not with etcl for windows or activestate tcl for windows. (only tested etcl 6 and 7), after some trying, I noticed that this is related to the "event generate $w <3>". The reason for it is beyond me. But to be able to use the tapandhold anyway, I came up with this version, which also allows for a small movement of the stylus during a tap and hold. And also added the + to the bindings, as not to erase previous bindings:
namespace eval ::tapandhold {
variable ballcount -3 nrballs 8 distance 16 size 5 accuracy 2
proc showball {w x y command} {
variable ballcount; variable nrballs
variable distance; variable size
variable startx; variable starty
if { $ballcount < $nrballs } {
if {$ballcount > -1} {
set angle [expr {2.0*acos(-1)*$ballcount/$nrballs} ]
set dx [expr {int($distance*sin($angle))}]
set dy [expr {int(-$distance*cos($angle))}]
toplevel .tapandholdball_$ballcount -bg lightblue
wm overrideredirect .tapandholdball_$ballcount 1
wm geometry .tapandholdball_$ballcount \
${size}x${size}+[expr {$x+$dx}]+[expr {$y+$dy}]
}
variable afterid [after 50 "::tapandhold::showball $w $x $y [list $command]"]
incr ballcount
set startx $x
set starty $y
} else {
stopball $w
bell
uplevel #0 $command
}
}
proc stopball { w } {
variable ballcount; variable afterid
catch {after cancel $afterid}
for {set n 0} {$n < $ballcount} {incr n} {
destroy .tapandholdball_$n
}
set ballcount -3
}
proc checkmovement { w x y } {
variable startx; variable starty; variable accuracy
if { [expr {abs($x - $startx)}] > $accuracy || \
[expr {abs($y - $starty)}] > $accuracy } {
stopball $w
}
}
}
proc tapandhold::init { w command } {
bind $w <1> +[list ::tapandhold::showball $w %X %Y $command]
bind $w <ButtonRelease-1> +[list ::tapandhold::stopball $w]
bind $w <B1-Motion> +[list ::tapandhold::checkmovement $w %X %Y]
}#----------- Demo package require BWidget
console show
NoteBook .n -internalborderwidth 0
pack .n -expand y -fill both
set p1 [.n insert end 1 -text test ]
set p2 [.n insert end 2 -text test2 ]
.n raise 1
menu .m -tearoff false
.m add command -label Foo -command {$p1.t insert end foo\n}
.m add command -label Bar -command {$p1.t insert end bar\n}
pack [text $p1.t -height 20 -width 35]
pack [text $p2.t -height 20 -width 35]
tapandhold::init $p1.t {tk_popup .m %X %Y }This demo when using the <3> event, you will not be able to switch back and forth between tabs after the <3> event has fired.2006-02-08: Motivated by this nice attempt to emulate tapandHold on PocketPC, EH decided to add native support for TapAndHold in eTcl for Windows Mobile (starting from release 8.4.12-pl8). See wce tapandhold subcommand. TapAndHold can be enabled/disabled for each widget separately. A right click (that is, ButtonPress-3 and ButtonRelease-3 sequence) is simulated when TapAndHold is used.ramsan: I am trying to select a word in the text widget and make a contextual menu appears by using the TapAndHold mechanism. The problem is that when the menu appears, the word is deselected. Is it my problem if etcl problem? Code is similar to:
wce tapandhold $text on
bind $text <ButtonPress-3> "break"
bind $text <ButtonRelease-3> {
event generate %W <<Contextual>> -x %x -y %y -rootx %X -rooty %Y
break
}using:event add <<Contextual>> <ButtonRelease-3>did not work either.RS: Could it be that the <1> event at the beginning of the tap fires first, and clears the selection? How to handle that correctly, I however have no idea currently...EH Richard is too fast, he gave same answer I was typing before I coull save it :-) Yes, I left the original WM_LBUTTONDOWN (aka ButtonPress-1) event in queue. I was wondering if I should prevent it to be reported to Tk, and in doubt left it as is, but your example shows it is probably a better idea to drop it and leave only the <ButtonPress-3> <ButtonRelease3> generated event. May also provide both behavior, using different tapandhold options. This was the expected behavior of the "auto" vs "on" modes (one to generate left click, other to generate some virtual event). Your suggestions are welcome. 2006-02-09: fixed. In (coming) pl9 release, ButtonPress-1 event is droped, so only a <ButtonPress-3> <ButtonRelease-3> sequence is received, and code above works without changing active selection.
Category GUI - Category Mobile
