X11HandwritingImpl.mesa
Copyright Ó 1992, 1993 by Xerox Corporation. All rights reserved.
Christian Jacobi, October 14, 1992 11:15 am PDT
Christian Jacobi, May 11, 1993 12:30 pm PDT
Handwriting recognition user interface
DIRECTORY Ascii, Commander, CommanderOps, Convert, ForkOps
, Handwriting, HelpStrings,
IO,
PFS, Rope, SymTab, Xl, XlCursor, XlCutBuffers, XlDB, XlTQOps, XlFontOps, XTk, XTkCommon, XTkContainers, XTkFriends, XTkLabels, XTkOps, XTkPopUps, XTkPrivate, XTkWidgets, XTkHelpShells, XTkGestureInput, X11SimulateKeyInput;
X11HandwritingImpl:
CEDAR
MONITOR
IMPORTS Ascii, Commander, CommanderOps, Convert, ForkOps, Handwriting, HelpStrings, IO, PFS, Rope, SymTab, Xl, XlCutBuffers, XlDB, XlTQOps, XlFontOps, XTk, XTkContainers, XTkFriends, XTkLabels, XTkOps, XTkPopUps, XTkPrivate, XTkWidgets, XTkHelpShells, XTkGestureInput, X11SimulateKeyInput ~
uniStrokesTraining: Handwriting.TrainingDB;
defaultTraining: Handwriting.TrainingDB;
gestures: Handwriting.TrainingDB;
myClass: XTk.Class ¬ XTkFriends.CreateClass[[key: $X11HWRImpl, classNameHint: $X11HWRImpl, cursorKey: NEW[XlCursor.StandardFontCursors ¬ XlCursor.StandardFontCursors.plus], backgroundKey: $white]];
CreateMine:
PROC [widgetSpec: XTk.WidgetSpec ¬ []]
RETURNS [XTk.Widget] = {
RETURN [ XTk.CreateWidget[widgetSpec, myClass] ];
};
Stroke: TYPE = LIST OF Xl.Point;
Strokes: TYPE = LIST OF Stroke;
UIInstance: TYPE ~ REF UIInstanceRec;
UIInstanceRec:
TYPE ~
RECORD [
gridWidth: INT ¬ 10,
wid: XTk.Widget ¬ NIL,
label: XTk.Widget ¬ NIL,
labelStyle: XTkLabels.StyleSpec ¬ [],
c: Xl.Connection ¬ NIL,
gc: Xl.GContext ¬ NIL,
strokes: LIST OF Stroke ¬ NIL,
rememberedText: Rope.ROPE ¬ NIL,
currText: Rope.ROPE ¬ NIL,
currInsertPos: INT ¬ 0,
currFinal: BOOL ¬ TRUE,
lastChar: INT ¬ -1,
lastGrid: INT ¬ -1,
uniStrokes: BOOL ¬ FALSE,
db: Handwriting.TrainingDB ¬ NIL,
regressionDB: Handwriting.TrainingDB ¬ NIL,
lastRep: LIST OF Handwriting.Report ¬ NIL,
firstRep: LIST OF Handwriting.Report ¬ NIL,
lastTInst: TrainingInstance ¬ NIL
];
TrainingInstance: TYPE ~ REF TrainingInstanceRec;
TrainingInstanceRec:
TYPE ~
RECORD [
uiInst: UIInstance ¬ NIL,
gc: Xl.GContext ¬ NIL,
strokeMarkGC: Xl.GContext ¬ NIL,
shell: XTk.Widget ¬ NIL,
help: HelpStrings.Handle ¬ NIL,
wid1: XTk.Widget ¬ NIL,
wid2, nl2: XTk.Widget ¬ NIL,
wid3, nl3: XTk.Widget ¬ NIL,
regressionsName: XTk.Widget ¬ NIL,
trainingName: XTk.Widget ¬ NIL,
trainingChar: XTk.Widget ¬ NIL,
lastNS1, lastNS2: Handwriting.Normalized ¬ NIL
];
fileIdx: CARD ¬ 0;
NewFileName:
ENTRY
PROC [ext: Rope.
ROPE]
RETURNS [name: Rope.
ROPE] = {
Make up a new file name base
We do want to make up the name instead of allowing user input so a handwriting recognition widget can safely handed out to an untrusted user
name ¬ IO.PutFR["/tmp/x11handwriting-%g%g", IO.card[fileIdx], IO.rope[ext]];
fileIdx ¬ fileIdx+1;
};
CleanupRope:
PROC [r: Rope.
ROPE]
RETURNS [Rope.
ROPE] = {
--Restricts rope to single line of finite small length
--Useful to clean externally aquired ropes before stuffing them into the displayer
max: INT ~ 80;
pos: INT;
length: INT ¬ Rope.Length[r];
IF length>max THEN {r ¬ Rope.Substr[r, 0, max]; length ¬ max};
pos ¬ Rope.SkipTo[r, 0, "\r\l"];
IF pos<length THEN r ¬ Rope.Substr[r, 0, pos];
RETURN [r];
};
SwapTrainingInstance:
ENTRY
PROC [ui: UIInstance, ti: TrainingInstance]
RETURNS [old: TrainingInstance ¬
NIL] = {
IF ui#NIL THEN {old ¬ ui.lastTInst; ui.lastTInst ¬ ti};
};
ToChar:
PROC [i:
INT]
RETURNS [
CHAR] = {
IF i<=0 OR i>255 THEN i ¬ ORD['?];
RETURN [VAL[i]]
};
DrawCaret: XTk.WidgetNotifyProc = {
ui: UIInstance ~ NARROW[registerData];
text: Rope.ROPE ¬ ui.currText;
index: INT ¬ ui.currInsertPos;
subText: Rope.ROPE ¬ Rope.Substr[text, 0, index];
te: Xl.TextExtentsRec ¬ Xl.QueryTextExtents[ui.c, ui.labelStyle.font, subText];
x: INT ¬ te.overallRight-te.overallLeft+ui.labelStyle.space.width;
y: INT ¬ te.fontAscent+ui.labelStyle.space.height+1;
Xl.DrawLine[ui.c, widget.window, [x, y], [x+10, y+14], ui.gc];
Xl.DrawLine[ui.c, widget.window, [x, y], [x-10, y+14], ui.gc];
};
Exposure: XTk.WidgetNotifyProc = {
ui: UIInstance ~ NARROW[registerData];
RepaintUI[ui];
};
CharOps: XTk.WidgetNotifyProc = {
ui: UIInstance ~ NARROW[registerData];
SELECT callData
FROM
$clear => {
[] ¬ ClearText[ui]; MakeFinal[ui];
};
$bs => {
MakeFinal[ui]; [] ¬ DoBackspace[ui]; MakeFinal[ui];
};
$sp => {MakeFinal[ui]; DoChar[ui, ' ]; MakeFinal[ui]};
$aAbB => {ChangeChar[ui, $aAbB]};
$xYz0 => {SecondChoice[ui, $xYz0]};
$training => {MakeTraining[ui]};
ENDCASE => {}
};
XOps: XTk.WidgetNotifyProc = {
ui: UIInstance ~ NARROW[registerData];
SELECT callData
FROM
$xSet => {
text: Rope.ROPE ¬ ui.currText;
XlCutBuffers.Put[ui.c, text, NIL];
X11SimulateKeyInput.Send[widget.connection, text];
};
$xSetP => {
text: Rope.ROPE ¬ Rope.Concat[ui.currText, "\n"];
XlCutBuffers.Put[ui.c, text, NIL];
X11SimulateKeyInput.Send[widget.connection, text];
};
$xSetCR => {
X11SimulateKeyInput.Send[widget.connection, "\n"];
};
$xSetBS => {
X11SimulateKeyInput.Send[widget.connection, "\b"];
};
ENDCASE => {}
};
ROps: XTk.WidgetNotifyProc = {
Send:
PROC [ui: UIInstance, code:
INT] = {
a: Xl.XAtom ¬ Xl.MakeAtom[ui.c, "PARC←Handwriting"];
w: Xl.Window ¬ Xl.GetInputFocus[ui.c].window;
Xl.SendClientMessage32[c: ui.c, destination: [[1]], window: w, type: a, data: [Xl.AtomId[a], LOOPHOLE[code], 0, 0, 0]];
};
ui: UIInstance ~ NARROW[registerData];
SELECT callData
FROM
$rSet => {
stuffKey: CARD32 ~ LOOPHOLE[-1];
XlCutBuffers.Put[ui.c, ui.currText, NIL];
Send[ui, -1]
};
$rSetP => {
stuffKey: CARD32 ~ LOOPHOLE[-1];
XlCutBuffers.Put[ui.c, Rope.Concat[ui.currText, "\n"], NIL];
Send[ui, -1]
};
$rClear => {
Send[ui, ORD[Ascii.DEL]];
};
$rBs => {
Send[ui, ORD[Ascii.BS]];
};
$rEnter => {
XlCutBuffers.Put[ui.c, "\r", NIL];
Send[ui, -2];
};
$rNext => {
Send[ui, -3];
};
$from => {
x: Rope.ROPE ¬ XlCutBuffers.Get[ui.c];
x ¬ CleanupRope[x];
[] ¬ ClearText[ui]; MakeFinal[ui];
ui.currText ¬ x;
ui.currInsertPos ¬ Rope.Length[x];
Push[ui];
};
ENDCASE => {}
};
ShowNormalizedStrokes:
PROC [wid: XTk.Widget, gc: Xl.GContext, ns:
REF, strokeMarkGC: Xl.GContext ¬
NIL] = {
IF ns#
NIL
THEN {
mx: INT ¬ wid.actual.size.width/2;
my: INT ¬ wid.actual.size.height/2;
strokes: Strokes ¬ Handwriting.UnNormalize[ns, MIN[mx, my]];
Xl.ClearArea[wid.connection, wid.window, [0, 0], [4000, 4000]];
DrawStrokes[wid.connection, wid.window, gc, strokes, [mx, my]];
IF strokeMarkGC#
NIL
THEN {
idx: INT ¬ CountStrokes[strokes];
FOR l: Strokes ¬ strokes, l.rest
WHILE l#
NIL
DO
stroke: LIST OF Xl.Point ¬ l.first;
IF stroke#
NIL
THEN
DrawStrokeMark[wid.connection, wid.window, strokeMarkGC, stroke.first, [mx, my], idx];
idx ¬ idx - 1;
ENDLOOP;
};
};
};
CountStrokes:
PROC [strokes: Strokes]
RETURNS [cnt:
INT ¬ 0] = {
FOR ss: Strokes ¬ strokes, ss.rest
WHILE ss#
NIL
DO
cnt ¬ cnt+1;
ENDLOOP;
};
DrawStrokeMark:
PROC [c: Xl.Connection, d: Xl.Drawable, gc: Xl.GContext, p, offset: Xl.Point, idx:
INT] = {
p1, p2: Xl.Point;
p ¬ p1 ¬ p2 ¬ [p.x+offset.x, p.y+offset.y];
Xl.DrawLine[c, d, [p.x-2, p.y-2], [p.x+2, p.y-2], gc]; --top
Xl.DrawLine[c, d, [p.x+2, p.y-2+1], [p.x+2, p.y+2], gc]; --right
Xl.DrawLine[c, d, [p.x+2-1, p.y+2], [p.x-2, p.y+2], gc]; --bottom
Xl.DrawLine[c, d, [p.x-2, p.y+2-1], [p.x-2, p.y-2+1], gc]; --left
FOR i:
INT
IN [0..idx)
DO
Xl.DrawLine[c, d, [p1.x-5, p1.y-2], [p1.x-2-1, p1.y-2], gc];
p1.y ¬ p1.y + 2
ENDLOOP;
FOR i:
INT
IN [0..idx)
DO
Xl.DrawLine[c, d, [p2.x-2, p2.y-5], [p2.x-2, p2.y-2-1], gc];
p2.x ¬ p2.x + 2
ENDLOOP;
};
RegressionOps: XTk.WidgetNotifyProc = {
--display the normalized strokes
ENABLE {
IO.Error => {
ti: TrainingInstance ~ NARROW[registerData];
HelpStrings.MakeVisible[ti.help];
HelpStrings.Clear[ti.help];
HelpStrings.Display[ti.help, msg];
GOTO Oops
};
PFS.Error => {
ti: TrainingInstance ~ NARROW[registerData];
HelpStrings.MakeVisible[ti.help];
HelpStrings.Clear[ti.help];
HelpStrings.Display[ti.help, error.explanation];
GOTO Oops
};
};
ti: TrainingInstance ~ NARROW[registerData];
ui: UIInstance ~ ti.uiInst;
SELECT callData
FROM
$rememberReg => {
strokes: Strokes ¬ ui.strokes;
IF strokes#
NIL
THEN {
ui.regressionDB ¬ Handwriting.TrainDB[ui.regressionDB, strokes, ui.lastChar];
};
};
$clearReg => {
ui.regressionDB ¬ NIL;
};
$saveReg => {
regressionsName: Rope.ROPE ¬ XTkWidgets.GetText[ti.regressionsName];
regressionsName: Rope.ROPE ¬ NewFileName[".regressions"];
regressionDB: Handwriting.TrainingDB ¬ ui.regressionDB;
IF regressionDB#
NIL
THEN {
XTkWidgets.SetText[ui.label, Rope.Concat["writing ", regressionsName]];
Handwriting.WriteDB[regressionsName, regressionDB];
XTkWidgets.SetText[ui.label, Rope.Concat["--> ", regressionsName]];
};
};
$loadReg => {
regressionsName: Rope.ROPE ¬ XTkWidgets.GetText[ti.regressionsName];
db: Handwriting.TrainingDB;
db ¬ Handwriting.ReadDB[regressionsName ! IO.Error, PFS.Error => {db ¬ NIL; CONTINUE}];
ui.regressionDB ¬ db
};
$fake => {
regressionDB: Handwriting.TrainingDB ¬ ui.regressionDB;
IF regressionDB#
NIL
THEN {
ns: Handwriting.Normalized ¬ Handwriting.NextNormalized[regressionDB, NIL];
ui.regressionDB ¬ Handwriting.UnTrainDB[regressionDB, ns];
FakeStrokes[ui, Handwriting.UnNormalize[ns, 40]];
};
};
ENDCASE => {};
EXITS Oops => {};
};
Train: XTk.WidgetNotifyProc = {
ti: TrainingInstance ~ NARROW[registerData];
ui: UIInstance ~ ti.uiInst;
name: Rope.ROPE ¬ XTkWidgets.GetText[ti.trainingChar];
length: INT ¬ Rope.Length[name];
strokes: Strokes ¬ ui.strokes;
IF length#1
THEN {
XTkWidgets.SetText[ui.label, "failed: define a single character"];
RETURN;
};
IF strokes=
NIL
THEN {
XTkWidgets.SetText[ui.label, "failed: input strokes first"];
RETURN;
};
BEGIN
ch: CHAR ~ Rope.Fetch[name, 0];
db: Handwriting.TrainingDB ¬ GetModifiableDB[ui];
ui.db ¬ Handwriting.TrainDB[db, strokes, ORD[ch]];
END;
};
GetModifiableDB:
PROC [ui: UIInstance]
RETURNS [db: Handwriting.TrainingDB] = {
db ¬ ui.db;
IF db=uniStrokesTraining
OR db=defaultTraining
OR db=gestures
THEN
db ¬ Handwriting.MergeDB[db: db];
};
Forget: XTk.WidgetNotifyProc = {
ti: TrainingInstance ~ NARROW[registerData];
ui: UIInstance ~ ti.uiInst;
ns: Handwriting.Normalized ¬ NIL;
SELECT callData
FROM
$r1 => ns ¬ ti.lastNS1;
$r2 => ns ¬ ti.lastNS2;
ENDCASE => {};
IF ns#
NIL
AND ui.db#
NIL
THEN {
db: Handwriting.TrainingDB ¬ GetModifiableDB[ui];
ui.db ¬ Handwriting.UnTrainDB[db, ns];
};
};
SpecialReadTraining:
PROC [name: Rope.
ROPE]
RETURNS [db: Handwriting.TrainingDB ¬
NIL] = {
db ¬ Handwriting.ReadDB[name ! IO.Error, PFS.Error => {db ¬ NIL; CONTINUE}];
IF db=
NIL
THEN
db ¬ Handwriting.ReadDB[Rope.Concat["/Cedar/X11Handwriting/", name] ! IO.Error, PFS.Error => {db ¬ NIL; CONTINUE}];
};
ReadDefaultTraining:
PROC [x:
REF
ANY] = {
g, d, u: Handwriting.TrainingDB ¬ NIL;
g ¬ SpecialReadTraining["gestures.hwrTraining"];
IF g#NIL THEN gestures ¬ g;
d ¬ SpecialReadTraining["default.hwrTraining"];
IF d#NIL THEN defaultTraining ¬ d;
u ¬ SpecialReadTraining["unistrokes.hwrTraining"];
IF u#NIL THEN uniStrokesTraining ¬ u;
};
DefaultTraining:
PROC [ui: UIInstance] = {
db: Handwriting.TrainingDB ¬ defaultTraining;
IF db=NIL THEN db ¬ SpecialReadTraining["default.hwrTraining"];
IF db#
NIL
THEN {
ui.db ¬ db;
ui.uniStrokes ¬ FALSE
};
};
UnistrokesTraining:
PROC [ui: UIInstance] = {
db: Handwriting.TrainingDB ¬ uniStrokesTraining;
IF db=NIL THEN db ¬ SpecialReadTraining["unistrokes.hwrTraining"];
IF db#
NIL
THEN {
ui.db ¬ db;
ui.uniStrokes ¬ TRUE
};
};
ReadTrainingDB: XTk.WidgetNotifyProc = {
ENABLE {
IO.Error => {
ti: TrainingInstance ~ NARROW[registerData];
HelpStrings.MakeVisible[ti.help];
HelpStrings.Clear[ti.help];
HelpStrings.Display[ti.help, msg];
GOTO Oops
};
PFS.Error => {
ti: TrainingInstance ~ NARROW[registerData];
HelpStrings.MakeVisible[ti.help];
HelpStrings.Clear[ti.help];
HelpStrings.Display[ti.help, error.explanation];
GOTO Oops
};
};
ti: TrainingInstance ~ NARROW[registerData];
ui: UIInstance ~ ti.uiInst;
name: Rope.ROPE ¬ XTkWidgets.GetText[ti.trainingName];
db: Handwriting.TrainingDB ¬ Handwriting.ReadDB[name];
IF db#NIL THEN ui.db ¬ Handwriting.MergeDB[into: db, db: ui.db];
EXITS Oops => {};
};
ClearTrainingDB: XTk.WidgetNotifyProc = {
ti: TrainingInstance ~ NARROW[registerData];
ui: UIInstance ~ ti.uiInst;
ui.db ¬ NIL;
};
WriteTrainingDB: XTk.WidgetNotifyProc = {
ENABLE {
IO.Error => {
ti: TrainingInstance ~ NARROW[registerData];
HelpStrings.MakeVisible[ti.help];
HelpStrings.Clear[ti.help];
HelpStrings.Display[ti.help, msg];
GOTO Oops
};
PFS.Error => {
ti: TrainingInstance ~ NARROW[registerData];
HelpStrings.MakeVisible[ti.help];
HelpStrings.Clear[ti.help];
HelpStrings.Display[ti.help, error.explanation];
GOTO Oops
};
};
ti: TrainingInstance ~ NARROW[registerData];
ui: UIInstance ~ ti.uiInst;
name: Rope.ROPE ¬ XTkWidgets.GetText[ti.trainingName];
name: Rope.ROPE ¬ NewFileName[".training"];
db: Handwriting.TrainingDB ¬ ui.db;
IF db#
NIL
THEN {
XTkWidgets.SetText[ui.label, Rope.Concat["writing ", name]];
Handwriting.WriteDB[name, db];
XTkWidgets.SetText[ui.label, Rope.Concat["--> ", name]];
};
EXITS Oops => {};
};
Recognize:
PROC [ui: UIInstance, strokes: Strokes] = {
reps: LIST OF Handwriting.Report;
ti: TrainingInstance ¬ ui.lastTInst;
db: Handwriting.TrainingDB ¬ ui.db;
ns: Handwriting.Normalized ¬ Handwriting.Normalize[strokes];
IF db=
NIL
THEN {
XTkWidgets.SetText[ui.label, "read a training database first"];
RETURN;
};
reps ¬ ui.lastRep ¬ ui.firstRep ¬ Handwriting.RecognizeNormalized[db, ns];
IF reps#NIL THEN DoChar[ui, ToChar[reps.first.ch]];
IF ti#NIL THEN Forward[ui, ti, ns];
};
Forward:
PROC [ui: UIInstance, ti: TrainingInstance, ns: Handwriting.Normalized] = {
Assumes caller catches Xl.XError
IF ti#
NIL
THEN {
c: Xl.Connection ¬ ti.wid1.connection;
reps: LIST OF Handwriting.Report ¬ ui.lastRep;
ShowNormalizedStrokes[ti.wid1, ti.gc, ns, ti.strokeMarkGC];
IF reps#
NIL
THEN {
FancyText:
PROC [x: Handwriting.Report]
RETURNS [r: Rope.
ROPE] = {
IF x.ch>32
AND x.ch<128
THEN r ¬ IO.PutFR["%g : %g", IO.int[ABS[x.badness/1000]], IO.rope[Rope.FromChar[VAL[x.ch]]]]
ELSE r ¬ IO.PutFR["%g %g", IO.int[ABS[x.badness/1000]], IO.int[x.ch]];
};
ti.lastNS1 ¬ reps.first.x;
ti.lastNS2 ¬ NIL;
ShowNormalizedStrokes[ti.wid2, ti.gc, reps.first.x, ti.strokeMarkGC];
XTkLabels.SetText[ti.nl2, FancyText[reps.first]];
IF reps.rest#
NIL
THEN {
ShowNormalizedStrokes[ti.wid3, ti.gc, reps.rest.first.x, ti.strokeMarkGC];
XTkLabels.SetText[ti.nl3, FancyText[reps.rest.first]];
ti.lastNS2 ¬ reps.rest.first.x;
};
};
IF ui.c#c THEN Xl.Flush[c];
};
};
MakeFinal:
PROC [ui: UIInstance] = {
ui.currFinal ¬ TRUE;
};
MakeSpecialGC:
PROC [screen: Xl.Screen]
RETURNS [gc: Xl.GContext] = {
c: Xl.Connection ¬ screen.connection;
gc ¬ Xl.MakeGContext[c, screen.root.drawable];
Xl.SetGCFunction[gc: gc, function: copy];
Xl.SetGCForeground[gc: gc, foreground: screen.blackPixel];
Xl.SetGCBackground[gc: gc, background: screen.whitePixel];
Xl.SetGCLineWidth[gc: gc, width: 0];
};
UIBindScreen: XTk.WidgetNotifyProc = {
style: XTkCommon.StyleSpec ¬ []; fontName: Rope.ROPE; font: Xl.Font;
ui: UIInstance ~ NARROW[registerData];
sd: Xl.ScreenDepth ~ ui.wid.screenDepth;
ui.c ¬ sd.screen.connection;
ui.gc ¬ XTkGestureInput.TrustedSharedGC[sd];
fontName ¬ XlDB.QueryStandardDB[ui.c, "(X11Handwriting)(FeedbackFont)"];
IF Rope.IsEmpty[fontName] THEN fontName ¬ "12x24";
font ¬ Xl.OpenFont[c: sd.screen.connection, name: fontName, details: XTkPrivate.detailsForSynchronous !
Xl.XError => {
font ¬ XlFontOps.GetDefaultFont[ui.c];
CONTINUE
}];
style.space.width ¬ 4;
style.space.height ¬ 6;
style.font ¬ font;
ui.labelStyle ¬ style;
XTkLabels.SetStyleSpec[ui.label, style, dont];
BEGIN
vendor, heightRope: Rope.ROPE ¬ NIL; h: CARD ¬ 0;
heightRope ¬ XlDB.QueryStandardDB[ui.c, "(X11Handwriting)(ActiveHeight)"];
vendor ¬ Xl.Info[ui.c].vendor;
IF ~Rope.IsEmpty[heightRope]
THEN
h ¬ Convert.CardFromRope[heightRope ! Convert.Error => CONTINUE];
SELECT
TRUE
FROM
h>10 AND h<400 => ui.wid.s.geometry.size.height ¬ h;
Rope.Equal[vendor, "Xerox Split MPAD"] => ui.wid.s.geometry.size.height ¬ 60;
ENDCASE => ui.wid.s.geometry.size.height ¬ 120;
END;
};
Good fonts
12x24
-xerox-helvetica-medium-r-normal--24-240-75-75-p-170-iso8859-1
-xerox-helvetica-medium-r-normal--36-360-75-75-p-250-iso8859-1
UIForgetScreen: XTk.WidgetNotifyProc = {
ui: UIInstance ~ NARROW[registerData];
ti: TrainingInstance ~ SwapTrainingInstance[ui, NIL];
IF ti#NIL THEN DestroyTI[ti];
};
TIBindScreen: XTk.WidgetNotifyProc = {
ti: TrainingInstance ~ NARROW[registerData];
ui: UIInstance ¬ ti.uiInst;
sd: Xl.ScreenDepth ~ ti.wid1.screenDepth;
ti.gc ¬ XTkGestureInput.TrustedSharedGC[sd];
ti.strokeMarkGC ¬ MakeSpecialGC[sd.screen];
IF ui#
NIL
THEN {
old: TrainingInstance ¬ SwapTrainingInstance[ui, ti];
IF old#ti THEN DestroyTI[old];
};
};
TIPostWindowCreation: XTk.WidgetNotifyProc = {
ti: TrainingInstance ~ NARROW[registerData];
ui: UIInstance ¬ ti.uiInst;
IF ui#
NIL
THEN {
XlTQOps.EnqueueSoon[100, ui.wid.rootTQ, DelayedTIPostWindowCreation, ti];
};
};
DelayedTIPostWindowCreation: Xl.EventProcType = {
ti: TrainingInstance ~ NARROW[clientData];
ui: UIInstance ¬ ti.uiInst;
IF ui#
NIL
AND ti.wid1.fastAccessAllowed=ok
AND ti.wid2.fastAccessAllowed=ok
AND ti.wid3.fastAccessAllowed=ok
AND ti.nl2.fastAccessAllowed=ok
AND ti.nl3.fastAccessAllowed=ok
THEN {
strokes: Strokes ¬ ui.strokes;
IF strokes#
NIL
THEN {
Forward[ui, ti, Handwriting.Normalize[strokes] ! Xl.XError => CONTINUE];
};
};
};
TIForgetScreen: XTk.WidgetNotifyProc = {
NilTrainingInstance:
ENTRY
PROC [ui: UIInstance, expect: TrainingInstance] = {
IF ui#NIL AND ui.lastTInst=expect THEN {ui.lastTInst ¬ NIL};
};
ti: TrainingInstance ~ NARROW[registerData];
ui: UIInstance ¬ ti.uiInst;
IF ui#NIL THEN NilTrainingInstance[ui, ti];
};
PaintGrid:
PROC [ui: UIInstance] = {
w: INT ¬ ui.wid.actual.size.width;
h: INT ¬ ui.wid.actual.size.height;
gridSize: INT ¬ ui.gridWidth ¬ MAX[h/5*4, 10];
gridPos: INT ¬ gridSize;
WHILE gridPos<w
DO
Xl.DrawLine[ui.wid.connection, ui.wid.window, [gridPos, 0], [gridPos, h], ui.gc];
gridPos ¬ gridPos+gridSize;
ENDLOOP;
};
RepaintUI:
PROC [ui: UIInstance] = {
Xl.ClearArea[ui.c, ui.wid.window, [0, 0], [1000, 1000]];
DrawStrokes[ui.c, ui.wid.window, ui.gc, ui.strokes];
IF ~ui.uniStrokes THEN PaintGrid[ui];
};
DrawStroke:
PROC [c: Xl.Connection, d: Xl.Drawable, gc: Xl.GContext, stroke:
LIST
OF Xl.Point, offset: Xl.Point ¬ [0, 0]] = {
IF stroke#
NIL
THEN {
DO
next: LIST OF Xl.Point ¬ stroke.rest;
IF next=
NIL
THEN
EXIT
ELSE {
a: Xl.Point ¬ stroke.first;
b: Xl.Point ¬ next.first;
Xl.DrawLine[c, d, [a.x+offset.x, a.y+offset.y], [b.x+offset.x, b.y+offset.y], gc];
stroke ¬ next;
};
ENDLOOP
};
};
StrokeBounds:
PROC [stroke: Stroke]
RETURNS [
min: Xl.Point ¬ [LAST[INT], LAST[INT]],
max: Xl.Point ¬ [FIRST[INT], FIRST[INT]]
] = {
FOR l: Stroke ¬ stroke, l.rest
WHILE l#
NIL
DO
min.x ¬ MIN[min.x, l.first.x];
max.x ¬ MAX[max.x, l.first.x];
min.y ¬ MIN[min.x, l.first.y];
max.y ¬ MAX[max.x, l.first.y];
ENDLOOP;
};
DrawStrokes:
PROC [c: Xl.Connection, d: Xl.Drawable, gc: Xl.GContext, strokes: Strokes, offset: Xl.Point ¬ [0, 0]] = {
FOR l: Strokes ¬ strokes, l.rest
WHILE l#
NIL
DO
DrawStroke[c, d, gc, l.first, offset];
ENDLOOP;
};
Push:
PROC [ui: UIInstance] = {
text: Rope.ROPE ¬ ui.currText;
XTkWidgets.SetText[ui.label, text];
XlCutBuffers.Put[ui.c, text, $Handwriting];
};
ClearText:
PROC [ui: UIInstance]
RETURNS [propagate:
BOOL ¬
FALSE] = {
propagate ¬ ui.currText=NIL;
ui.currText ¬ NIL;
ui.currInsertPos ¬ 0;
ui.currFinal ¬ TRUE;
Push[ui];
};
InsertRope:
PROC [ui: UIInstance, new: Rope.
ROPE] = {
text: Rope.ROPE ~ ui.currText;
ip: INT ¬ MIN[ui.currInsertPos, Rope.Length[text]];
ui.currText ¬ Rope.Cat[Rope.Substr[text, 0, ip], new, Rope.Substr[text, ip]];
ui.currInsertPos ¬ ip+Rope.Length[new];
};
SwapChar:
PROC [ui: UIInstance, new:
CHAR] = {
text: Rope.ROPE ~ ui.currText;
length: INT ¬ Rope.Length[text];
ip: INT ¬ MIN[ui.currInsertPos, length];
IF ip>0
THEN {
ui.currText ¬ Rope.Cat[Rope.Substr[text, 0, ip-1], Rope.FromChar[new], Rope.Substr[text, ip]];
};
};
LastChar:
PROC [ui: UIInstance]
RETURNS [ch:
CHAR ¬ 0C] = {
text: Rope.ROPE ~ ui.currText;
ip: INT ¬ MIN[ui.currInsertPos, Rope.Length[text]];
IF ip>0
THEN {
ch ¬ Rope.Fetch[text, ip-1];
};
};
DoBackspace:
PROC [ui: UIInstance]
RETURNS [propagate:
BOOL ¬
FALSE] = {
text: Rope.ROPE ~ ui.currText;
ip: INT ¬ MIN[ui.currInsertPos, Rope.Length[text]];
IF ip>0
THEN {
ui.currText ¬ Rope.Concat[Rope.Substr[text, 0, ip-1], Rope.Substr[text, ip]];
ui.currInsertPos ¬ ip-1;
Push[ui];
}
ELSE RETURN [Rope.Length[text]=0];
};
SecondChoice:
PROC [ui: UIInstance, a:
ATOM] = {
IF ui.lastRep#
NIL
THEN {
ui.lastRep ¬ ui.lastRep.rest;
IF ui.lastRep=NIL THEN ui.lastRep ¬ ui.firstRep;
IF ui.lastRep#
NIL
THEN {
char: CHAR ¬ ToChar[ui.lastRep.first.ch];
SwapChar[ui, char];
};
};
ui.currFinal ¬ TRUE;
Push[ui];
};
ChangeChar:
PROC [ui: UIInstance, a:
ATOM] = {
char: CHAR ¬ LastChar[ui];
SELECT a
FROM
$aAbB => {
SELECT char
FROM
IN ['A..'Z] => char ¬ Ascii.Lower[char];
IN ['a..'z] => char ¬ Ascii.Upper[char];
'( => char ¬ '[;
'[ => char ¬ '{;
'{ => char ¬ '<;
'< => char ¬ '(;
') => char ¬ '];
'] => char ¬ '};
'} => char ¬ '>;
'> => char ¬ ');
'. => char ¬ ',;
', => char ¬ ';;
'; => char ¬ ':;
': => char ¬ '.;
'" => char ¬ '=;
'= => char ¬ '~;
'~ => char ¬ '";
'$ => char ¬ '&;
'& => char ¬ '@;
'@ => char ¬ '$;
'/ => char ¬ '|;
'| => char ¬ '\\;
'\\ => char ¬ '/;
'- => char ¬ '←
'← => char ¬ '-;
'+ => char ¬ '*;
'* => char ¬ '+;
'1 => char ¬ '7;
'7 => char ¬ '1;
'9 => char ¬ 'g;
'5 => char ¬ 'S;
'2 => char ¬ 'Z;
IN [Ascii.ControlA..Ascii.ControlZ] => char ¬ char + Ascii.controlOffset - Ascii.caseOffset;
ENDCASE => {};
};
$A => char ¬ Ascii.Upper[char];
$a => char ¬ Ascii.Lower[char];
$ctrl => {
SELECT char
FROM
IN ['A..'Z] => char ¬ char - Ascii.controlOffset;
IN ['a..'z] => char ¬ char - Ascii.caseOffset - Ascii.controlOffset;
IN [Ascii.ControlA..Ascii.ControlZ] => char ¬ char + Ascii.controlOffset + Ascii.caseOffset;
ENDCASE;
};
ENDCASE => {};
SwapChar[ui, char];
ui.currFinal ¬ TRUE;
Push[ui];
};
DoChar:
PROC [ui: UIInstance, ch:
CHAR] = {
text: Rope.ROPE ¬ ui.currText;
ip: INT ¬ Rope.Length[text];
IF ~ui.currFinal
AND ip>0
THEN SwapChar[ui, ch]
ELSE InsertRope[ui, Rope.FromChar[ch]];
ui.currFinal ¬ FALSE;
ui.lastChar ¬ ORD[ch];
Push[ui];
};
SetCaretPosition:
PROC [ui: UIInstance, x:
INT] = {
i: INT ¬ XlFontOps.QueryPosInfo[ui.c, ui.labelStyle.font, ui.currText, x-ui.labelStyle.space.width].gapIndex;
ui.currInsertPos ¬ i;
Push[ui];
};
SetCaretPositionAfter:
PROC [ui: UIInstance, x:
INT] = {
i: INT ¬ XlFontOps.QueryPosInfo[ui.c, ui.labelStyle.font, ui.currText, x-ui.labelStyle.space.width].charIndex;
ui.currInsertPos ¬ i+1;
};
Delete:
PROC [ui: UIInstance, minx, maxx:
INT, remember:
BOOL ¬
FALSE] = {
text: Rope.ROPE ~ ui.currText;
length: INT ¬ Rope.Length[text];
p1: XlFontOps.PosInfo ¬ XlFontOps.QueryPosInfo[ui.c, ui.labelStyle.font, ui.currText, minx-ui.labelStyle.space.width];
p2: XlFontOps.PosInfo ¬ XlFontOps.QueryPosInfo[ui.c, ui.labelStyle.font, ui.currText, maxx-ui.labelStyle.space.width];
startIdx: INT ¬ MIN[p1.gapIndex, length];
stopIdx: INT ¬ MIN[p2.gapIndex, length];
IF startIdx>=stopIdx
THEN {
startIdx ¬ MIN[p1.charIndex, length];
stopIdx ¬ MIN[startIdx+1, length];
};
ui.currText ¬ Rope.Concat[Rope.Substr[text, 0, startIdx], Rope.Substr[text, stopIdx]];
ui.currInsertPos ¬ startIdx;
Push[ui];
IF remember
THEN
ui.rememberedText ¬ Rope.Substr[text, startIdx, stopIdx-startIdx];
};
LabelGesture: XTkGestureInput.GestureReportProc = {
ui: UIInstance ~ NARROW[d1];
min, max: Xl.Point;
[min, max] ¬ StrokeBounds[stroke];
IF max.x-min.x<=3
AND max.y-min.y<=3
THEN {
SetCaretPosition[ui, (min.x+max.x)/2];
}
ELSE {
report: LIST OF Handwriting.Report ¬ Handwriting.Recognize[gestures, LIST[stroke]];
IF report#
NIL
THEN {
SELECT report.first.ch
FROM
ORD['1] => SetCaretPosition[ui, (min.x+max.x)/2];
ORD['2] => Delete[ui, min.x, max.x, FALSE];
ORD['3] => {
SetCaretPositionAfter[ui, (min.x+max.x)/2];
ChangeChar[ui, $aAbB];
};
ORD['4] => {
x: Rope.ROPE ¬ XlCutBuffers.Get[ui.c];
x ¬ CleanupRope[x];
InsertRope[ui, x];
Push[ui];
};
ORD['5] => {
x: Rope.ROPE ¬ ui.rememberedText;
SetCaretPosition[ui, (min.x+max.x)/2];
InsertRope[ui, x];
Push[ui];
};
ORD['6] => Delete[ui, min.x, max.x, TRUE];
ORD['7] => {
SetCaretPositionAfter[ui, (min.x+max.x)/2];
ChangeChar[ui, $ctrl];
};
ENDCASE => {};
};
};
};
StartX:
PROC [list:
LIST
OF Xl.Point]
RETURNS [x:
INT ¬ 0] = {
IF list=NIL THEN RETURN;
FOR l:
LIST
OF Xl.Point ¬ list, l.rest
DO
IF l.rest=NIL THEN RETURN [l.first.x];
ENDLOOP
};
FakeStrokes:
PROC [ui: UIInstance, strokes: Strokes] = {
MakeFinal[ui];
ui.strokes ¬ strokes;
ui.lastGrid ¬ -1;
Recognize[ui, strokes];
};
MainGesture: XTkGestureInput.GestureReportProc = {
IF stroke#
NIL
THEN {
ui: UIInstance ~ NARROW[d1];
strokes: Strokes ¬ ui.strokes;
ngi: INT ← StartX[stroke]/MAX[ui.gridWidth, 10];
IF ngi#ui.lastGrid
OR ui.uniStrokes
THEN {
MakeFinal[ui];
ui.lastGrid ¬ ngi;
ui.strokes ¬ strokes ¬ LIST[stroke];
RepaintUI[ui];
}
ELSE {
strokes ¬ CONS[stroke, strokes];
};
ui.strokes ¬ strokes;
Recognize[ui, strokes];
};
};
HWRCommand: Commander.CommandProc ~ {
ui: UIInstance ~ NEW[UIInstanceRec];
--
menu: XTkWidgets.Widget ¬ XTkPopUps.CreateSimplePopUpButton[text: "Menu ",
list:
LIST[
["help", $help, NIL, "open documentation", HelpHit],
["pseudo keyboard", NIL, NIL, "create a pseudo keyboard (alpha)", CreateAlphaKeyboard],
["numeric keyboard", NIL, NIL, "create a pseudo keyboard (numeric)", CreateSpecialKeyboard],
[NIL, NIL, NEW[XTkPopUps.WidgetCreateClosureRec ¬ [TrainingSelection, ui]], NIL, DBSelectorHit],
["do training", $training, NIL, "create training ui widget", CharOps]
],
defaultNotify: NIL,
registerData: ui
];
aAbB: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "cap", hitProc: CharOps, registerData: ui, callData: $aAbB];
secondChoice: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "2nd", hitProc: CharOps, registerData: ui, callData: $xYz0];
sp: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "space ", hitProc: CharOps, registerData: ui, callData: $sp];
xSet: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "Xset", hitProc: XOps, registerData: ui, callData: $xSet];
xSetCR: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "Xcr", hitProc: XOps, registerData: ui, callData: $xSetCR];
xSetBS: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "Xbs", hitProc: XOps, registerData: ui, callData: $xSetBS];
controlRow: XTkWidgets.Widget ¬ XTkWidgets.CreateXStack[stack: LIST[menu, <<clear, bs,>> aAbB, secondChoice, sp, xSet, xSetCR, xSetBS]];
rSet: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "SET", hitProc: ROps, registerData: ui, callData: $rSet];
rSetP: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "SET+", hitProc: ROps, registerData: ui, callData: $rSetP];
rClear: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "r-clear", hitProc: ROps, registerData: ui, callData: $rClear];
rBs: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "r-back", hitProc: ROps, registerData: ui, callData: $rBs];
rEnter: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "enter", hitProc: ROps, registerData: ui, callData: $rEnter];
rNext: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "next", hitProc: ROps, registerData: ui, callData: $rNext];
rControlRow: XTkWidgets.Widget ¬ XTkWidgets.CreateXStack[stack: LIST[rSet, rSetP, rClear, rBs, rEnter, rNext<<, from>>]];
--
label: XTkWidgets.Widget ¬ ui.label ¬ XTkWidgets.CreateLabel[];
wid: XTkWidgets.Widget ¬ ui.wid ¬ CreateMine[
widgetSpec: [geometry: [size: [300, 120], borderWidth: 1]]
];
--
container: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[stack: LIST[label, wid, controlRow, rControlRow]];
tq: Xl.TQ ¬ Xl.CreateTQ[order: XTk.rootLockingOrder];
shell: XTkWidgets.Widget ¬ XTkWidgets.CreateShell[child: container, windowHeader: "Handwriting recognition", rootTQ: tq];
XTkGestureInput.SetReport[wid, MainGesture, ui, NIL, tq];
XTkGestureInput.SetPainting[wid, TRUE];
XTkGestureInput.SetReport[label, LabelGesture, ui];
XTkGestureInput.SetPainting[label, TRUE];
XTk.RegisterNotifier[wid, XTk.bindScreenLRKey, UIBindScreen, ui];
XTk.RegisterNotifier[wid, XTk.forgetScreenLRKey, UIForgetScreen, ui];
XTk.RegisterNotifier[label, $LabelRepaint, DrawCaret, ui];
XTkOps.RegisterNotifierProcOnEvents[widget: wid, handles: Xl.CreateEventFilter[expose], proc: Exposure, registerData: ui, generate: [exposure: TRUE]];
shell.attributes.eventMask ¬ Xl.ORSetOfEvents[shell.attributes.eventMask, [buttonRelease: TRUE, buttonPress: TRUE]];
XTkContainers.SetVaryingSize[wid, TRUE];
XTkWidgets.RealizeShell[shell];
InitializeWithDefaultTraining[ui];
};
InitializeWithDefaultTraining:
PROC [x:
REF
ANY] = {
ui: UIInstance ~ NARROW[x];
IF ui.db=
NIL
THEN {
ui.db ¬ defaultTraining;
IF ui.db=NIL THEN ForkOps.ForkDelayed[300, InitializeWithDefaultTraining, ui];
};
};
HelpHit: XTk.WidgetNotifyProc = {
serverName: Rope.ROPE ~ Xl.ServerName[widget.connection];
[] ¬ CommanderOps.DoCommandRope[Rope.Cat["X11 -server ", serverName, " -- XOpen /Cedar10.1/X11Handwriting/X11HandwritingDoc.tioga"], NIL, NIL];
};
DBSelectorHit: XTk.WidgetNotifyProc = {
failure: BOOL ¬ FALSE;
ui: UIInstance ~ NARROW[registerData];
XTkWidgets.SetText[ui.label, "...wait"];
WITH callData
SELECT
FROM
a:
ATOM => {
SELECT callData
FROM
$m => DefaultTraining[ui];
$u => UnistrokesTraining[ui];
ENDCASE => {};
};
lr:
LIST
OF Rope.
ROPE => {
db: Handwriting.TrainingDB ¬ NIL;
FOR list:
LIST
OF Rope.
ROPE ¬ lr, list.rest
WHILE list#
NIL
DO
IF Rope.Equal[list.first, "default",
FALSE]
THEN db ¬ Handwriting.MergeDB[db, defaultTraining]
ELSE {
d: Handwriting.TrainingDB ¬ NIL;
d ¬ Handwriting.ReadDB[list.first !
IO.Error,
PFS.Error => {
failure ¬ TRUE;
XTkWidgets.SetText[ui.label, "file failed"];
d ¬ NIL;
CONTINUE
}];
IF db=NIL THEN db ¬ d ELSE db ¬ Handwriting.MergeDB[db, d];
};
ENDLOOP;
IF db#NIL THEN {ui.db ¬ db; ui.uniStrokes ¬ FALSE};
};
ENDCASE => {};
IF failure
THEN XTkWidgets.SetText[ui.label, "partial replacement of training database"]
ELSE XTkWidgets.SetText[ui.label, "training database replaced"];
IF ui.label.state=realized THEN RepaintUI[ui];
};
DestroyTI:
PROC [ti: TrainingInstance] ~ {
IF ti#NIL THEN XTkWidgets.DestroyShell[ti.shell]
};
MakeTraining:
PROC [ui: UIInstance] ~ {
ti: TrainingInstance ~ NEW[TrainingInstanceRec ¬ [uiInst: ui]];
--
fake: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "REPLAY", hitProc: RegressionOps, registerData: ti, callData: $fake];
rememberReg: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "remember", hitProc: RegressionOps, registerData: ti, callData: $rememberReg];
clearReg: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "new", hitProc: RegressionOps, registerData: ti, callData: $clearReg];
saveReg: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "write", hitProc: RegressionOps, registerData: ti, callData: $saveReg];
loadReg: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "read", hitProc: RegressionOps, registerData: ti, callData: $loadReg];
nameReg: XTkWidgets.Widget ¬ ti.regressionsName ¬ XTkWidgets.CreateLabeledField[
label: "file:",
init: "junk.hwrRegressions"
];
regressionRow: XTkWidgets.Widget ¬ XTkWidgets.CreateXStack[stack: LIST[fake, rememberReg, saveReg, clearReg, loadReg, nameReg]];
--
trainingChar: XTkWidgets.Widget ¬ ti.trainingChar ¬ XTkWidgets.CreateLabeledField[
label: " char:",
init: "???"
];
train0: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "TRAIN", hitProc: Train, registerData: ti];
forget1: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "forget1", hitProc: Forget, registerData: ti, callData: $r1];
forget2: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "forget2", hitProc: Forget, registerData: ti, callData: $r2];
trainingRow: XTkWidgets.Widget ¬ XTkWidgets.CreateXStack[stack: LIST[train0, forget1, forget2, trainingChar]];
--
dbLab: XTkWidgets.Widget ¬ XTkWidgets.CreateLabel[text: "DB"];
readTraining: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "merge", hitProc: ReadTrainingDB, registerData: ti];
writeTraining: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "write", hitProc: WriteTrainingDB, registerData: ti];
clearTraining: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[text: "new", hitProc: ClearTrainingDB, registerData: ti];
trainingName: XTkWidgets.Widget ¬ ti.trainingName ¬ XTkWidgets.CreateLabeledField[
label: "file:",
init: "junk.hwrTraining"
];
trainingDbRow: XTkWidgets.Widget ¬ XTkWidgets.CreateXStack[stack: LIST[dbLab, writeTraining, clearTraining, readTraining, trainingName]];
--
wid1: XTkWidgets.Widget ¬ ti.wid1 ¬ XTkWidgets.CreateBareWidget[
widgetSpec: [geometry: [size: [120, 144], borderWidth: 1]]
];
wid2: XTkWidgets.Widget ¬ ti.wid2 ¬ XTkWidgets.CreateBareWidget[
widgetSpec: [geometry: [size: [120, 144], borderWidth: 1]]
];
wid3: XTkWidgets.Widget ¬ ti.wid3 ¬ XTkWidgets.CreateBareWidget[
widgetSpec: [geometry: [size: [120, 144], borderWidth: 1]]
];
nl1: XTkWidgets.Widget ¬ XTkWidgets.CreateLabel[text: "normalized"];
nl2: XTkWidgets.Widget ¬ ti.nl2 ¬ XTkWidgets.CreateLabel[text: " "];
nl3: XTkWidgets.Widget ¬ ti.nl3 ¬ XTkWidgets.CreateLabel[text: " "];
c1: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[stack: LIST[nl1, wid1]];
c2: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[stack: LIST[nl2, wid2]];
c3: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[stack: LIST[nl3, wid3]];
cc: XTkWidgets.Widget ¬ XTkWidgets.CreateXStack[stack: LIST[c1, c2, c3]];
container: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[stack: LIST[regressionRow, trainingDbRow, trainingRow, cc]];
shell: XTkWidgets.Widget ¬ ti.shell ¬ XTkWidgets.CreateShell[child: container, windowHeader: "Handwriting recognition training"];
XTk.RegisterNotifier[wid1, XTk.postWindowCreationKey, TIPostWindowCreation, ti];
XTk.RegisterNotifier[wid1, XTk.bindScreenLRKey, TIBindScreen, ti];
XTk.RegisterNotifier[wid1, XTk.forgetScreenLRKey, TIForgetScreen, ti];
XTkWidgets.BindScreenShell[shell, ui.c];
ti.help ¬ XTkHelpShells.CreateHelpWithPopShell[shell];
XTkWidgets.RealizeShell[shell];
};
KeyHit: XTkWidgets.ButtonHitProcType = {
ui: UIInstance ~ NARROW[registerData];
text: Rope.ROPE ¬ NARROW[callData];
WITH event
SELECT
FROM
br: Xl.ButtonReleaseEvent =>
IF br.button>1 THEN text ¬ Rope.Translate[base: text, translator: Rope.Upper];
ENDCASE => {};
MakeFinal[ui];
InsertRope[ui, text];
Push[ui];
};
KeyboardPainter: TYPE = PROC [L: PROC [char: CHAR], Lx: PROC [key, text: Rope.ROPE, extraWidth: INT], Home: PROC, Down: PROC, Right: PROC [amount: INT], sz: Xl.Size];
CreateKeyboard:
PROC [ui: UIInstance, basicWidth:
INT ¬ 19, basicHeight:
INT ¬ 19, rows, cols:
INT, painter: KeyboardPainter] ~ {
next: Xl.Point ¬ [0, 0];
sz: Xl.Size ¬ [basicWidth, basicHeight];
Home:
PROC [] = {
next.x ¬ 0; next.y ¬ 0;
};
Down:
PROC [] = {
next.y ¬ next.y + sz.height;
next.x ¬ 0;
};
Right:
PROC [amount:
INT] = {
next.x ¬ next.x + amount;
};
L:
PROC [char:
CHAR] = {
key: Rope.ROPE ¬ Rope.FromChar[Ascii.Lower[char]];
text: Rope.ROPE ¬ Rope.FromChar[char];
Lx[key, text];
};
Lx:
PROC [key, text: Rope.
ROPE, extraWidth:
INT ¬ 0] = {
b: XTkWidgets.TextWidget ¬ XTkWidgets.CreateButton[
widgetSpec: [geometry: [pos: next, size: [width: sz.width-2+extraWidth, height: sz.height-2], borderWidth: 1]],
text: text, hitProc: KeyHit, registerData: ui, callData: key
];
Right[sz.width+extraWidth];
XTkWidgets.AppendChild[keyboard, b];
};
shell: XTkWidgets.Widget ¬ XTkWidgets.CreateShell[windowHeader: "pseudo-keyboard", className: $PseudoKeyboard];
keyboard: XTkWidgets.Widget ¬ XTkWidgets.CreateContainer[
widgetSpec: [
geometry: [size: [width: cols*basicWidth, height: rows*basicHeight]]
]
];
XTkWidgets.SetShellChild[shell, keyboard];
--
painter[L, Lx, Home, Down, Right, sz];
--
XTkWidgets.BindScreenShell[shell, ui.c];
XTkOps.SetupDestruction[shell, ui.label, XTk.forgetScreenKey];
XTkWidgets.RealizeShell[shell];
};
CreateAlphaKeyboard: XTkWidgets.ButtonHitProcType ~ {
PaintAlpha: KeyboardPainter = {
Home[];
L['Q]; L['W]; L['E]; L['R]; L['T]; L['Y]; L['U]; L['I]; L['O]; L['P];
Down[]; Right[sz.width/3];
L['A]; L['S]; L['D]; L['F]; L['G]; L['H]; L['J]; L['K]; L['L];
Down[]; Right[sz.width/3*2];
L['Z]; L['X]; L['C]; L['V]; L['B]; L['N]; L['M]; Lx[" ", "sp", 6];
};
CreateKeyboard[NARROW[registerData], 19, 19, 3, 10, PaintAlpha];
};
CreateSpecialKeyboard: XTkWidgets.ButtonHitProcType ~ {
PaintSpecial: KeyboardPainter = {
Home[];
L['1]; L['2]; L['3]; L['4]; L['5]; L['6]; L['7]; L['8]; L['9]; L['0];
Down[];
L['!]; L['@]; L['#]; L['$]; L['%]; L['~]; L['&]; L['*]; L['(]; L[')];
ForkOps.ForkDelayed[100, ReadDefaultTraining];
Down[];
L['-]; L['+]; L['=]; L['\\]; L['|]; L['[]; L[']]; L['{]; L['}]; L['?];
Down[];
L[':]; L[';]; L['"]; L['']; L[',]; L['.]; L['/]; L['<]; L['>]; L[' ];
};
CreateKeyboard[NARROW[registerData], 19, 19, 4, 10, PaintSpecial];
};
TrainingSelection: XTkPopUps.CreateWidgetProc ¬ {
choiceList: XTkPopUps.ChoiceList ¬ NIL;
EachEntry: SymTab.EachPairAction = {
help: Rope.ROPE ~ "read a personalized training database";
choiceList ¬ CONS[[key, val, NIL, help, DBSelectorHit], choiceList];
};
[] ¬ SymTab.Pairs[trainingMenuTab, EachEntry];
choiceList ¬ CONS[["uni-strokes", $u, NIL, "recognize uni strokes", DBSelectorHit], choiceList];
choiceList ¬ CONS[["default database", $m, NIL, "default latin characters", DBSelectorHit], choiceList];
RETURN [XTkPopUps.CreateSimplePopUpButton[text: "select training", list: choiceList, defaultNotify: DBSelectorHit, registerData: registerData, help: "select a user dependent training database"]];
};
trainingMenuTab: SymTab.Ref ~ SymTab.Create[];
TrainingMenuCommand: Commander.CommandProc ~ {
list: LIST OF Rope.ROPE ¬ NIL;
key: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
IF Rope.IsEmpty[key]
THEN
ERROR CommanderOps.Failed["needs a menu entry and a list of file names"];
FOR file: Rope.
ROPE ¬ CommanderOps.NextArgument[cmd], CommanderOps.NextArgument[cmd]
WHILE file#
NIL
DO
IF ~Rope.IsEmpty[file] THEN list ¬ CONS[file, list];
ENDLOOP;
IF list=
NIL
THEN [] ¬ SymTab.Delete[trainingMenuTab, key]
ELSE [] ¬ SymTab.Store[trainingMenuTab, key, list]
};
ForkOps.ForkDelayed[50, ReadDefaultTraining];
Commander.Register["X11Handwriting", HWRCommand, "Open a handwriting recognition widget"];
Commander.Register["X11Handwriting-TrainingMenu", TrainingMenuCommand, "Update the menu for training databases"];
END.