PWE 20060202 Since a PocketPC 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 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 :)
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? 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 .menu %X %Y}