Version 1 of Playing SHARK
Updated 2005-09-02 11:31:16if 0 {Richard Suchenwirth 2005-09-02 - SHARK is for Shorthand Aided Rapid Keyboarding, also known as Shapewriter, a research project by IBM Almaden Laboratory [L1 ] . Here's an experiment to play with this concept in Tcl. Check the IBM site whether this concept is patented (it probably is), so best use this only as an illustrative toy.
The idea is that you do a pen (or mouse, with button 1 down) movement on the virtual keyboard, from the first to the last letter. The sequence of "visited" keys is matched against a dictionary according to the rule: if the first and the last letter match, and each character of a word is contained in the sequence, then that word is considered a candidate. In contrast to the SHARK implementation, the sequence of letters does not matter, except for the first and last - this seems to be sufficient in my tests, at least for a small dictionary. Words not in the dictionary can be typed letter by letter. "Sharked" words are inserted into the text widget on top (alternatives separated by slashes - I was too lazy to add popup menu selection. For the last word, you also see the input string and the result in the window's title bar. }
package require Tk
set keys {
b d k g / c a n i m q / f l e s y x / j h t o p v / . . r u w z
}
#-- frequent English words, borrowed from somewhere in the Web
set words {
about after all am an and are as at
back bad be because been before being between big but by
came can come could country
day days debts did different do dollars down
even every first for found from
general get go going good got great
had has have he her here him his
if in input interest into is it its just kick kind
large last like little look
made make man many may me more most must my
new no not now of off old on one only or other our out over
people please power public
said saw see shark she since so some still such system
take test than that the their them then there these they this through
time to today two under up upon very
war was we well went were what when where which while who will
with would writing years you your
}
foreach word $words {set dic($word) ""}#------------------ Callback for bindings
set buffer ""
set last ""
proc down {w key} {
$w itemconfig key -fill white
$w itemconfig k-$key -fill yellow
set ::buffer $key
set ::last $key
}
proc pass {w x y} {
set id [$w find closest $x $y]
set key [string index [lindex [$w gettags $id] 0] end]
if {$::last ne "" && $key ne $::last} {
$w itemconfig k-$key -fill orange
append ::buffer $key
set ::last $key
}
}
proc up {w x y t} {
set id [$w find closest $x $y]
set ::last ""
$t insert insert "[join [lookup $::buffer] /] "
}#----------------------- dictionary "logic"
proc lookup string {
switch [string length $string] {
1 {set candidates $string}
2 {set candidates [array names ::dic $string]}
default {
set first [string index $string 0]
set last [string index $string end]
set candidates {}
foreach word [array names ::dic $first*$last] {
if [contained $word $string] {lappend candidates $word}
}
}
}
wm title . $::buffer/$candidates
set candidates
}
proc contained {word string} {
foreach char [split $word ""] {
if {[string first $char $string]==-1} {return 0}
}
return 1
}
foreach op {+ - * /} {proc $op {a b} "expr {\$a $op \$b}"}#------------------------ Demo UI
set w [canvas .c]
pack $w -fill both -expand 1
set t [text $w.t -width 40 -height 10 -wrap word]
$w create window 0 0 -window $t -anchor nw
set x 30
set y 138
foreach key $keys {
switch -- $key {
/ {set x 30; incr y 28}
. {incr x 28}
default {
set id [$w create rect $x $y [+ $x 26] [+ $y 26] -fill white]
$w itemconfigure $id -tag [list t-$key k-$key key]
$w create text [+ $x 13] [+ $y 13] -text $key -tag t-$key
$w bind t-$key <1> [list down $w $key]
$w bind t-$key <B1-Motion> [list pass $w %x %y]
$w bind t-$key <ButtonRelease-1> [list up $w %x %y $t]
incr x 28
}
}
}
wm geometry . 240x280+0+0
bind . <Up> {exec wish $argv0 &; exit}
bind . <F1> {console show}if 0 {