ref: 1018d7a7091fd5e0433f501a3474cdc3fec322cc
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"; }