summaryrefslogtreecommitdiff
path: root/appl/wm/pen.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/wm/pen.b')
-rw-r--r--appl/wm/pen.b447
1 files changed, 447 insertions, 0 deletions
diff --git a/appl/wm/pen.b b/appl/wm/pen.b
new file mode 100644
index 00000000..17b2be39
--- /dev/null
+++ b/appl/wm/pen.b
@@ -0,0 +1,447 @@
+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";
+}
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 18:15:00 +0000