ref: 76b565d8b219c8db94a882e93725b4ab735414de
dir: /appl/wm/pen.b/
implement Pen;
#
# pen input on touch screen
#
# Copyright © 2001,2002 Vita Nuova Holdings Limited. All rights reserved.
#
# This may be used or modified by anyone for any purpose.
#
include "sys.m";
sys: Sys;
include "draw.m";
draw: Draw;
Point, Rect: import draw;
include "tk.m";
tk: Tk;
include "tkclient.m";
tkclient: Tkclient;
include "bufio.m";
bufio: Bufio;
Iobuf: import bufio;
include "strokes.m";
strokes: Strokes;
Classifier, Penpoint, Stroke: import strokes;
readstrokes: Readstrokes;
include "arg.m";
Pen: module
{
init: fn(nil: ref Draw->Context, nil: list of string);
};
debug := 0;
stderr: ref Sys->FD;
tkconfig := array[] of{
"canvas .c -borderwidth 0 -bg white -height 80 -width 80",
".c create text 0 0 -anchor nw -width 5w -fill gray -tags mode",
".c create text 30 0 -anchor nw -width 3w -fill blue -tags char",
"bind .c <Button-1> {grab set .c; send cmd push %x %y}",
"bind .c <Motion-Button-1> {send cmd move %x %y}",
"bind .c <ButtonRelease-1> {grab release .c; send cmd release %x %y}",
"bind .c <Enter> {send cmd move %x %y}", # does nothing if not previously down
# "bind .c <Leave> {send cmd leave %x %y}", # ditto
"pack .c -expand 1 -fill both -padx 5 -pady 5",
};
usage()
{
sys->fprint(sys->fildes(2), "Usage: pen [-t] [-e] [classifier ...]\n");
raise "fail:usage";
}
init(ctxt: ref Draw->Context, args: list of string)
{
sys = load Sys Sys->PATH;
if (ctxt == nil) {
sys->fprint(sys->fildes(2), "pen: no window context\n");
raise "fail:bad context";
}
stderr = sys->fildes(2);
draw = load Draw Draw->PATH;
bufio = load Bufio Bufio->PATH;
tk = load Tk Tk->PATH;
if(tk == nil)
nomod(Tk->PATH);
tkclient = load Tkclient Tkclient->PATH;
if(tkclient == nil)
nomod(Tkclient->PATH);
strokes = load Strokes Strokes->PATH;
if(strokes == nil)
nomod(Strokes->PATH);
strokes->init();
readstrokes = load Readstrokes Readstrokes->PATH;
if(readstrokes == nil)
nomod(Readstrokes->PATH);
readstrokes->init(strokes);
arg := load Arg Arg->PATH;
if(arg == nil)
nomod(Arg->PATH);
arg->init(args);
taskbar := 0;
noexit := 0;
winopts := Tkclient->Appl;
corner := 1;
while((opt := arg->opt()) != 0)
case opt {
't' =>
taskbar = 1;
'e' =>
noexit = 1;
'r' =>
winopts &= ~Tkclient->Resize;
'c' =>
corner = 0;
* =>
usage();
}
args = arg->argv();
arg = nil;
if(args == nil)
args = "/lib/strokes/letters.clx" :: "/lib/strokes/digits.clx" :: "/lib/strokes/punc.clx" :: nil;
csets := array[len args] of ref Classifier;
cs := 0;
for(; args != nil; args = tl args){
file := hd args;
(err, rc) := readstrokes->read_classifier(file, 1, 0);
if(rc == nil)
error(sys->sprint("can't read classifier %s: %s", file, err));
csets[cs++] = rc;
}
readstrokes = nil;
rec := csets[0];
digits: ref Classifier;
if(len csets > 1)
digits = csets[1]; # need not actually be digits
sys->pctl(Sys->NEWPGRP, nil);
tkclient->init();
(top, ctl) := tkclient->toplevel(ctxt, nil, "Pen", winopts);
cmd := chan of string;
tk->namechan(top, cmd, "cmd");
for (i1 := 0; i1 < len tkconfig; i1++)
tkcmd(top, tkconfig[i1]);
if(winopts & Tkclient->Resize)
tkcmd(top, "pack propagate . 0");
if(corner){
(w, h) := (int tk->cmd(top, ". cget -width"), int tk->cmd(top, ". cget -height"));
r := ctxt.display.image.r;
tkcmd(top, sys->sprint(". configure -x %d -y %d", r.max.x-w, r.max.y-h));
}
shift := 0;
punct := 0;
points := array[1000] of Penpoint;
npoint := 0;
tkclient->onscreen(top, nil);
tkclient->startinput(top, "ptr"::nil);
if(taskbar)
tkclient->wmctl(top, "task");
tk->cmd(top, "update");
for(;;){
if(punct)
drawmode(top, "#&*");
else if(rec == digits)
drawmode(top, "123");
else if(shift == 1)
drawmode(top, "Abc");
else if(shift == 2)
drawmode(top, "ABC");
else if(shift)
drawmode(top, "S "+string shift);
else
drawmode(top, "abc");
tk->cmd(top, "update");
alt{
s := <-top.ctxt.ptr =>
tk->pointer(top, *s);
s := <-top.ctxt.ctl or
s = <-top.wreq or
s = <-ctl =>
if(s == "exit" && noexit)
s = "task";
tkclient->wmctl(top, s);
s := <-cmd =>
(nf, flds) := sys->tokenize(s, " \t");
if(nf < 3)
break;
p := Penpoint(int hd tl flds, int hd tl tl flds, 0);
case hd flds {
"push" =>
tkcmd(top, "raise .");
tk->cmd(top, "update");
npoint = 0;
points[npoint++] = p;
"leave" =>
npoint = 0;
tkcmd(top, ".c delete stuff");
"release" =>
if(npoint == 0)
break;
points[npoint++] = p;
(n, tap) := recognize_stroke(top, rec, ref Stroke(npoint, points[0:npoint], 0, 0), debug);
drawchars(top, "");
name: string = nil;
if(n >= 0){
name = rec.cnames[n];
if(debug > 1){
ex: ref Stroke = nil;
if(rec.canonex != nil)
ex = rec.canonex[n];
drawshape(top, "stuff", ex, "blue", rec.dompts[n], "yellow");
sys->fprint(stderr, "match: %s\n", name);
}
case c := name[0] {
'S' =>
shift = (shift+1)%3;
name = nil;
'A' =>
name = " ";
'B' =>
name = "\b";
'R' =>
name = "\n";
'T' =>
name = "\t";
'N' =>
# num lock
if(rec == digits)
rec = csets[0];
else
rec = digits;
name = nil;
* =>
if(c >= 'A' && c <= 'Z'){ # other gestures, not yet implemented
shift = 0;
punct = 0;
rec = csets[0];
name = nil;
unknown(top);
break;
}
if(punct){
rec = csets[0];
punct = 0;
}
if(shift){
for(i := 0; i < len name; i++)
if((c = name[i]) >= 'a' && c <= 'z')
name[i] += 'A'-'a';
if(shift < 2)
shift = 0;
}
}
}else if(tap != nil){
if(punct == 0){
if(len csets > 2){
rec = csets[2];
punct = 1;
}
name = nil;
}else{
rec = csets[0];
punct = 0;
name = ".";
}
}else
unknown(top);
if(name != nil){
drawchars(top, name);
for(i := 0; i < len name; i++)
sys->fprint(top.ctxt.connfd, "key %d", name[i]);
# tk->keyboard(top, name[i]);
}
tkcmd(top, ".c delete stuff");
npoint = 0;
* =>
if(npoint){
q := points[npoint-1];
points[npoint++] = p;
tkcmd(top, sys->sprint(".c create line %d %d %d %d -tags stuff; update", q.x, q.y, p.x, p.y));
}
}
}
}
}
unknown(top: ref Tk->Toplevel)
{
drawquery(top, (10, 10), 3);
tk->cmd(top, "update");
sys->sleep(300);
tkcmd(top, ".c delete query");
tk->cmd(top, "update");
}
drawchars(top: ref Tk->Toplevel, s: string)
{
t := "";
for(i := 0; i < len s; i++){
c := s[i];
case c {
'\n' => t += "\\n";
'\b' => t += "\\b";
'\t' => t += "\\t";
4 => t += "eot";
* =>
if(c < ' ')
t += sys->sprint("\\%3.3o", c);
else
t[len t] = c;
}
}
tkcmd(top, ".c itemconfigure char -text '"+t);
}
drawmode(top: ref Tk->Toplevel, mode: string)
{
tkcmd(top, ".c itemconfigure mode -text '"+mode);
}
drawquery(top: ref Tk->Toplevel, p: Point, scale: int)
{
width := 2;
size := 1<<scale;
if(size < 4)
width = 1;
o := Point(p.x-size/2, p.x+size/2);
if(o.x < 0)
o.x = 0;
if(o.y < 0)
o.y = 0;
c := o.add((size, size));
m := o.add(c).div(2);
b := c.add((0, size));
tkcmd(top, sys->sprint(".c create arc %d %d %d %d -start 150 -extent -240 -style arc -tags query -width %d -outline red", o.x, o.y, c.x, c.y, width));
tkcmd(top, sys->sprint(".c create line %d %d %d %d -fill red -width %d -tags query", m.x, c.y, m.x, b.y, width));
tkcmd(top, sys->sprint(".c create arc %d %d %d %d -start 0 -extent 360 -fill red -width %d -tags query -style arc -outline red", m.x-width, b.y+2*width, m.x+width, b.y+3*width, width));
}
tkcmd(top: ref Tk->Toplevel, s: string)
{
e := tk->cmd(top, s);
if(e != nil && e[0]=='!')
sys->fprint(sys->fildes(2), "pen: tk error: %s in [%s]\n", e, s);
}
drawshape(top: ref Tk->Toplevel, tag: string, stroke: ref Stroke, colour: string, dompts: ref Stroke, domcol: string)
{
if(top == nil)
return;
if(stroke != nil)
for(i := 1; i < stroke.npts; i++){
p := stroke.pts[i-1];
q := stroke.pts[i];
tkcmd(top, sys->sprint(".c create line %d %d %d %d -fill %s -tags %s", p.x, p.y, q.x, q.y, colour, tag));
}
if(dompts != nil)
for(i = 0; i < dompts.npts; i++){
p := dompts.pts[i];
tkcmd(top, sys->sprint(".c create oval %d %d %d %d -fill %s -tags %s", p.x-1, p.y-1, p.x+1, p.y+1, domcol, tag));
}
tk->cmd(top, "update");
}
#
# duplicate function of strokes module temporarily
# to allow for experiment
#
#DIST_THLD: con 3200; # x100
DIST_THLD: con 3300; # x100
# Tap-handling parameters
TAP_TIME_THLD: con 150; # msec
TAP_DIST_THLD: con 75; # dx*dx + dy*dy
TAP_PATHLEN: con 10*100; # x100
recognize_stroke(top: ref Tk->Toplevel, rec: ref Classifier, stroke: ref Stroke, debug: int): (int, string)
{
if(stroke.npts < 1)
return (-1, nil);
stroke = stroke.filter(); # filter out close points
if(stroke.npts == 1 || stroke.length() < TAP_PATHLEN)
return (-1, "."); # considered a tap regardless of elapsed time
strokes->preprocess_stroke(stroke);
# Compute its dominant points.
dompts := stroke.interpolate().dominant();
if(debug)
drawshape(top, "stuff", stroke, "green", dompts, "red");
if(rec == nil)
return (-1, nil);
best_dist := Strokes->MAXDIST;
best_i := -1;
# Score input stroke against every class in classifier.
for(i := 0; i < rec.nclasses; i++){
name := rec.cnames[i];
(sim, dist) := strokes->score_stroke(dompts, rec.dompts[i]);
if(debug > 1 && dist < Strokes->MAXDIST)
sys->fprint(stderr, "(%s, %d, %d) ", name, sim, dist);
if(dist < DIST_THLD){
if(debug > 1)
sys->fprint(stderr, "(%s, %d, %d) ", name, sim, dist);
# Is it the best so far?
if(dist < best_dist){
best_dist = dist;
best_i = i;
}
}
}
if(debug > 1)
sys->fprint(stderr, "\n");
return (best_i, nil);
}
objrect(t: ref Tk->Toplevel, path: string, addbd: int): Rect
{
r: Rect;
r.min.x = int tk->cmd(t, path+" cget -actx");
if(addbd)
r.min.x += int tk->cmd(t, path+" cget -bd");
r.min.y = int tk->cmd(t, ".f cget -acty");
if(addbd)
r.min.y += int tk->cmd(t, path+" cget -bd");
r.max.x = r.min.x + int tk->cmd(t, path+" cget -actwidth");
r.max.y = r.min.y + int tk->cmd(t, path+" cget -actheight");
return r;
}
nomod(s: string)
{
error(sys->sprint("can't load %s: %r", s));
}
error(s: string)
{
sys->fprint(sys->fildes(2), "scribble: %s\n", s);
raise "fail:error";
}