PWE 20060202 Since a PocketPC (and a Tablet-PC, too) does't have a mouse, but only a stylus, there is no right mouse button. The context sensitive menus usually bound to the right mouse button, are displayed on the pocket pc after a Tap&Hold, meaning to press the stylus for about a second, after which the menu appears. During the waiting time some balls are shown to indicate that a menu will appear. This is my attempt to do something similar in tcl:
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 little 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 makemymenu
It'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 :)
I compared with the "real thing" in Pocket IE, and the time for full circle seems to be more like 0.5 sec. My current settings are: ballsize=4, balldistance=16, after=60
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 $w
can 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, especially the "event generate". With both version any movement of the stylus stops the tap&hold. This makes a tap&hold a bit tricky, so I extended the above to allow a small movement of the stylus:
namespace eval ::tapandhold { variable ballcount -3 nrballs 8 distance 16 size 5 accuracy 2 proc showball {w x y} { 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"] incr ballcount set startx $x set starty $y } 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 checkmovement { x y } { variable startx; variable starty; variable accuracy if { [expr {abs($x - $startx)}] > $accuracy || \ [expr {abs($y - $starty)}] > $accuracy } { stopball } } } proc tapandhold::init w { bind $w <1> [list ::tapandhold::showball $w %X %Y] bind $w <ButtonRelease-1> ::tapandhold::stopball bind $w <B1-Motion> [list ::tapandhold::checkmovement %X %Y] }
You can use the same demo as above