Updated 2006-10-14 19:40:35

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 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 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 :)

  • 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

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, 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