<<>> <> <> <> <> <<>> <> <<>> DIRECTORY Handwriting, IO, PFS, Rope, Xl USING [Point]; HandwritingImpl: CEDAR MONITOR IMPORTS PFS, IO EXPORTS Handwriting ~ BEGIN OPEN Handwriting; <> IsTrainingDB: PUBLIC PROC [x: REF] RETURNS [BOOL] = { RETURN [ISTYPE[x, LIST OF NormalizedStrokes]]; }; NarrowTrainingDB: PUBLIC PROC [x: REF] RETURNS [TrainingDB] = { RETURN [NARROW[x, LIST OF NormalizedStrokes]]; }; IsNormalized: PUBLIC PROC [x: REF] RETURNS [BOOL] = { RETURN [ISTYPE[x, NormalizedStrokes]]; }; NarrowNormalized: PUBLIC PROC [x: REF] RETURNS [Normalized] = { RETURN [NARROW[x, NormalizedStrokes]]; }; MCopyStroke: PROC [s: Stroke, dx: INT, dy: INT, f: INT] RETURNS [copy: Stroke Ź NIL] = { IF s#NIL THEN { lag: Stroke Ź copy Ź LIST[[(s.first.x+dx)*f, (s.first.y+dy)*f]]; FOR seg: Stroke Ź s.rest, seg.rest WHILE seg#NIL DO lag.rest Ź LIST[[(seg.first.x+dx)*f, (seg.first.y+dy)*f]]; lag Ź lag.rest ENDLOOP } }; MCopyStrokes: PROC [strokes: Strokes, dx: INT, dy: INT, f: INT] RETURNS [copy: Strokes Ź NIL] = { IF strokes#NIL THEN { lag: Strokes Ź copy Ź LIST[MCopyStroke[strokes.first, dx, dy, f]]; FOR sl: Strokes Ź strokes.rest, sl.rest WHILE sl#NIL DO lag.rest Ź LIST[MCopyStroke[sl.first, dx, dy, f]]; lag Ź lag.rest ENDLOOP } }; <> normalPoints: NAT = 16; EachPoint: TYPE = RECORD [x, y: INT]; NormalizedSingleStroke: TYPE = ARRAY [0..normalPoints) OF EachPoint; NormalizedStrokes: TYPE = REF NormalizedStrokesRec; NormalizedStrokesRec: TYPE = RECORD [ key: INT Ź 0, strokes: Strokes Ź NIL, dx, dy, f: INT, included: BOOL Ź FALSE, data: SEQUENCE strokeCnt: NAT OF NormalizedSingleStroke ]; idxForLeng: NAT = 1; normalizedLengthConst: INT = 010000H; CopyNormalizedStrokes: PROC [ns: NormalizedStrokes] RETURNS [copy: NormalizedStrokes] = { copy Ź NEW[NormalizedStrokesRec[ns.strokeCnt]]; copy.key Ź ns.key; copy.strokes Ź ns.strokes; --pointer copy because is readonly copy.dx Ź ns.dx; copy.dy Ź ns.dy; copy.f Ź ns.f; copy.included Ź FALSE; FOR i: NAT IN [0..ns.strokeCnt) DO copy.data[i] Ź ns.data[i]; ENDLOOP; }; CountStrokes: PROC [strokes: Strokes] RETURNS [cnt: INT Ź 0] = { FOR ss: Strokes Ź strokes, ss.rest WHILE ss#NIL DO cnt Ź cnt+1; ENDLOOP; }; NormalizeStrokes: PROC [strokes: Strokes] RETURNS [ns: NormalizedStrokes] = { factor: INT; totalLeng: INT Ź 0; strokeCnt, strokeIdx: INT Ź 0; min: Xl.Point Ź [INT.LAST, INT.LAST]; max: Xl.Point Ź [INT.FIRST, INT.FIRST]; av: Xl.Point Ź [0, 0]; <<--Count strokes and allocate memory>> strokeCnt Ź CountStrokes[strokes]; IF strokeCnt=0 THEN ERROR; ns Ź NEW[NormalizedStrokesRec[strokeCnt]]; <<--Find total bounding box and length>> strokeIdx Ź 0; FOR sl: Strokes Ź strokes, sl.rest WHILE sl#NIL DO strokeLeng: INT Ź 0; lastP: Xl.Point Ź sl.first.first; FOR seg: Stroke Ź sl.first, seg.rest WHILE seg#NIL DO nextP: Xl.Point ~ seg.first; min.x Ź MIN[min.x, nextP.x]; min.y Ź MIN[min.y, nextP.y]; max.x Ź MAX[max.x, nextP.x]; max.y Ź MAX[max.y, nextP.y]; strokeLeng Ź strokeLeng + ABS[lastP.x-nextP.x] + ABS[lastP.y-nextP.y]; lastP Ź nextP; ENDLOOP; ns.data[strokeIdx][idxForLeng].x Ź strokeLeng; totalLeng Ź totalLeng+strokeLeng; strokeIdx Ź strokeIdx+1; ENDLOOP; <<--Copy with normalized size and position of original segments>> ns.dx Ź -(max.x+min.x)/2; ns.dy Ź-(max.y+min.y)/2; IF (max.x-min.x)<=3 AND (max.y-min.y)<=3 THEN { <<--Special case for a dot>> ns.f Ź 1; ns.strokes Ź MCopyStrokes[strokes: strokes, dx: ns.dx, dy: ns.dy, f: 1]; FOR si: NAT IN [1..strokeCnt) DO ns.data[si] Ź ALL[[0, 0]]; ENDLOOP; RETURN; }; factor Ź ns.f Ź MAX[(normalizedLengthConst / MAX[totalLeng, 1]), 1]; strokes Ź ns.strokes Ź MCopyStrokes[strokes: strokes, dx: ns.dx, dy: ns.dy, f: factor]; <<--Interpolate points>> strokeIdx Ź 0; FOR ss: Strokes Ź strokes, ss.rest WHILE ss#NIL DO seg: Stroke Ź ss.first; next: Stroke; actualStrokeLeng: INT Ź ns.data[strokeIdx][idxForLeng].x*factor; desiredPieceLeng: INT Ź actualStrokeLeng/(normalPoints-1); sofarLeng: INT Ź 0; goalLeng: INT Ź 0; lastP: Xl.Point Ź seg.first; ns.data[strokeIdx][0].x Ź lastP.x; ns.data[strokeIdx][0].y Ź lastP.y; <<--Find each interpolated point>> FOR i: NAT IN [1..normalPoints) DO dx, dy, dl: INT Ź 0; goalLeng Ź sofarLeng+desiredPieceLeng; DO --eventually skip some segments next Ź seg.rest; IF next=NIL THEN { dl Ź 0; EXIT; }; dx Ź next.first.x-lastP.x; dy Ź next.first.y-lastP.y; dl Ź ABS[dx] + ABS[dy]; IF sofarLeng+dl>=goalLeng THEN EXIT --found the right segment ELSE { sofarLeng Ź sofarLeng+dl; seg Ź next; lastP Ź next.first; }; ENDLOOP; IF sofarLeng+dl<=goalLeng OR dl<=0 THEN { IF next#NIL THEN lastP Ź next.first; } ELSE { desiredSegLeng: INT Ź (goalLeng-sofarLeng); lastP.x Ź lastP.x+(desiredSegLeng*dx)/dl; lastP.y Ź lastP.y+(desiredSegLeng*dy)/dl; }; sofarLeng Ź goalLeng; ns.data[strokeIdx][i].x Ź lastP.x; ns.data[strokeIdx][i].y Ź lastP.y; ENDLOOP; strokeIdx Ź strokeIdx+1; ENDLOOP; <<--reset offsets to move the origin to the mass center>> IF strokeCnt>0 THEN { tx, ty: INT Ź 0; FOR si: INT IN [0..strokeCnt) DO FOR pi: INT IN [0..normalPoints) DO tx Ź tx + ns.data[si][pi].x; ty Ź ty + ns.data[si][pi].y; ENDLOOP; ENDLOOP; tx Ź tx/(normalPoints*strokeCnt); ty Ź ty/(normalPoints*strokeCnt); FOR si: INT IN [0..strokeCnt) DO FOR pi: INT IN [0..normalPoints) DO ns.data[si][pi].x Ź ns.data[si][pi].x - tx; ns.data[si][pi].y Ź ns.data[si][pi].y - ty; ENDLOOP; ENDLOOP; }; }; Normalize: PUBLIC PROC [strokes: Strokes, ch: INT Ź -1] RETURNS [REF] = { ns: NormalizedStrokes Ź NormalizeStrokes[strokes]; ns.key Ź ch; RETURN [ns]; }; ToStrokes: PROC [ns: NormalizedStrokes, sizemax: INT Ź 40] RETURNS [strokes: Strokes Ź NIL] = { normalize: INT; min: Xl.Point Ź [INT.LAST, INT.LAST]; max: Xl.Point Ź [INT.FIRST, INT.FIRST]; FOR si: INT DECREASING IN [0..ns.strokeCnt) DO FOR pi: INT DECREASING IN [0..normalPoints) DO p: Xl.Point Ź [ ns.data[si][pi].x, ns.data[si][pi].y ]; min.x Ź MIN[min.x, p.x]; min.y Ź MIN[min.y, p.y]; max.x Ź MAX[max.x, p.x]; max.y Ź MAX[max.y, p.y]; ENDLOOP; ENDLOOP; normalize Ź MAX[ABS[max.x], ABS[max.y], ABS[min.x], ABS[min.y], 1]; FOR si: INT DECREASING IN [0..ns.strokeCnt) DO s: Stroke Ź NIL; FOR pi: INT DECREASING IN [0..normalPoints) DO p: Xl.Point Ź [ ns.data[si][pi].x, ns.data[si][pi].y ]; p.x Ź (p.x*sizemax)/normalize; p.y Ź (p.y*sizemax)/normalize; s Ź CONS[p, s]; ENDLOOP; strokes Ź CONS[s, strokes]; ENDLOOP; }; UnNormalize: PUBLIC PROC [x: REF, sizemax: INT Ź 40] RETURNS [strokes: Strokes] = { ns: NormalizedStrokes Ź NARROW[x]; strokes Ź ToStrokes[ns, sizemax]; }; <> CompareFine: PROC [ns1, ns2: NormalizedStrokes, limit: INT Ź LAST[INT]] RETURNS [b: INT Ź 0] = { CompI: PROC [n1, n2: NormalizedStrokes, sidx: NAT, pidx: [0..normalPoints)] RETURNS [INT] = INLINE { RETURN [ABS[n1.data[sidx][pidx].x-n2.data[sidx][pidx].x] + ABS[n1.data[sidx][pidx].y-n2.data[sidx][pidx].y]] }; IF ns1.strokeCnt#ns2.strokeCnt THEN RETURN [LAST[INT]]; FOR si: INT IN [0..ns1.strokeCnt) DO FOR pi: NAT IN [0..normalPoints) DO d: INT ~ CompI[ns1, ns2, si, pi]; b Ź b + d * (1 + d / 256); IF b>limit THEN RETURN [b]; ENDLOOP; ENDLOOP; }; Evaluation: TYPE = RECORD [ b: INT Ź INT.LAST, ns: NormalizedStrokes Ź NIL ]; Search: PROC [ns: NormalizedStrokes, list: LIST OF NormalizedStrokes] RETURNS [best, secondBest: Evaluation] = { considerCount: NAT = 2; cache: ARRAY [0..considerCount) OF Evaluation; next: INT Ź 0; Insert1: PROC [e: Evaluation] = INLINE { FOR i: NAT IN [0..considerCount) DO IF e.b> GetChar: PUBLIC PROC [x: Normalized] RETURNS [ch: INT Ź -1] = { ns: NormalizedStrokes Ź NARROW[x]; IF ns#NIL THEN ch Ź ns.key; }; SetChar: PUBLIC PROC [x: Normalized, ch: INT Ź -1] = { ns: NormalizedStrokes Ź NARROW[x]; IF ns.included THEN ERROR; ns.key Ź ch; }; SetIncludeFlag: ENTRY PROC [ns: NormalizedStrokes] RETURNS [mustRaise: BOOL Ź TRUE] = { IF ns=NIL OR ns.included THEN RETURN [TRUE] ELSE {ns.included Ź TRUE; RETURN [FALSE]} }; AddToDB: PROC [db: LIST OF NormalizedStrokes, ns: NormalizedStrokes] RETURNS [LIST OF NormalizedStrokes] = { IF SetIncludeFlag[ns].mustRaise THEN ERROR; RETURN [CONS[ns, db]]; }; TrainDB: PUBLIC PROC [db: TrainingDB, strokes: Strokes, ch: INT] RETURNS [TrainingDB] = { list: LIST OF NormalizedStrokes Ź NARROW[db]; ns: NormalizedStrokes Ź NormalizeStrokes[strokes]; ns.key Ź ch; RETURN [AddToDB[list, ns]]; }; TrainDBNormalized: PUBLIC PROC [db: TrainingDB, x: Normalized] RETURNS [TrainingDB] = { list: LIST OF NormalizedStrokes Ź NARROW[db]; RETURN [AddToDB[list, NARROW[x]]] }; NextNormalized: PUBLIC PROC [db: TrainingDB, x: Normalized] RETURNS [Normalized Ź NIL] = { list: LIST OF NormalizedStrokes Ź NARROW[db]; ns: NormalizedStrokes Ź NARROW[x]; IF ns=NIL THEN RETURN [list.first]; FOR l: LIST OF NormalizedStrokes Ź list, l.rest WHILE l#NIL DO IF l.first=ns AND l.rest#NIL THEN { RETURN [l.rest.first]; } ENDLOOP; }; UnTrainDB: PUBLIC PROC [db: TrainingDB, x: REF] RETURNS [TrainingDB] = { RemoveNext: ENTRY PROC [lag: LIST OF NormalizedStrokes, x: NormalizedStrokes] = { <<--Monitor protects the structure, but not the contents>> IF lag#NIL THEN { lr: LIST OF NormalizedStrokes ~ lag.rest; IF lr#NIL AND lr.first=x THEN lag.rest Ź lr.rest }; }; list: LIST OF NormalizedStrokes Ź NARROW[db]; ns: NormalizedStrokes Ź NARROW[x]; IF list=NIL THEN RETURN [NIL]; IF list.first=ns THEN RETURN [list.rest]; FOR l: LIST OF NormalizedStrokes Ź list, l.rest WHILE l#NIL DO IF l.rest#NIL AND l.rest.first = ns THEN { RemoveNext[l, ns]; RETURN [list]; } ENDLOOP; RETURN [list] }; <> <> <> <> <> dbStartKey: INT ~ -1208567; dbFinishKey: INT ~ -999; nsStartKey: INT ~ -9; strokeEndKey: INT ~ -8; PutInt: PROC [stream: IO.STREAM, i: INT] = { IO.Put1[stream, IO.int[i]]; IO.PutChar[stream, ' ]; }; GetInt: PROC [stream: IO.STREAM] RETURNS [INT] = { RETURN [IO.GetInt[stream]]; }; PutSingleStroke: PROC [stream: IO.STREAM, stroke: Stroke, dx, dy, f: INT] = { f Ź MAX[f, 1]; FOR l: Stroke Ź stroke, l.rest WHILE l#NIL DO PutInt[stream, MAX[l.first.x/f-dx+1, 0]]; PutInt[stream, MAX[l.first.y/f-dy+1, 0]]; ENDLOOP; PutInt[stream, strokeEndKey]; }; GetSingleStroke: PROC [stream: IO.STREAM] RETURNS [stroke: Stroke Ź NIL] = { x, y: INT; lag, list: Stroke; DO x Ź GetInt[stream]; IF x=strokeEndKey THEN EXIT; y Ź GetInt[stream]; list Ź LIST[[x, y]]; IF lag=NIL THEN stroke Ź list ELSE lag.rest Ź list; lag Ź list; ENDLOOP; }; PutNormalizedStrokes: PROC [stream: IO.STREAM, ns: NormalizedStrokes] = { strokes: Strokes Ź ns.strokes; PutInt[stream, ns.key]; PutInt[stream, 0]; PutInt[stream, ns.strokeCnt]; FOR i: INT IN [0..ns.strokeCnt) DO PutSingleStroke[stream, strokes.first, ns.dx, ns.dy, ns.f]; strokes Ź strokes.rest ENDLOOP }; GetNormalizedStrokes: PROC [stream: IO.STREAM] RETURNS [ns: NormalizedStrokes] = { strokes, lag: Strokes Ź NIL; key: INT Ź GetInt[stream]; unused: INT Ź GetInt[stream]; strokeCnt: INT Ź GetInt[stream]; FOR i: INT IN [0..strokeCnt) DO stroke: Stroke Ź GetSingleStroke[stream]; IF stroke#NIL THEN { list: Strokes Ź LIST[stroke]; IF lag=NIL THEN strokes Ź list ELSE lag.rest Ź list; lag Ź list; }; ENDLOOP; ns Ź NormalizeStrokes[strokes]; ns.key Ź key }; PutDB: PROC [stream: IO.STREAM, list: LIST OF NormalizedStrokes] = { PutInt[stream, dbStartKey]; FOR l: LIST OF NormalizedStrokes Ź list, l.rest WHILE l#NIL DO ns: NormalizedStrokes ~ l.first; IF ns#NIL AND ns.strokeCnt>0 THEN { PutInt[stream, nsStartKey]; PutNormalizedStrokes[stream, l.first]; }; ENDLOOP; PutInt[stream, dbFinishKey]; }; GetDB: PROC [stream: IO.STREAM] RETURNS [list: LIST OF NormalizedStrokes Ź NIL] = { lag: LIST OF NormalizedStrokes Ź NIL; i: INT Ź GetInt[stream]; IF i#dbStartKey THEN ERROR; i Ź GetInt[stream]; WHILE i=nsStartKey DO ns: NormalizedStrokes Ź GetNormalizedStrokes[stream]; IF ns#NIL THEN list Ź CONS[ns, list]; i Ź GetInt[stream]; ENDLOOP; }; ReadDB: PUBLIC PROC [name: Rope.ROPE] RETURNS [TrainingDB] = { stream: IO.STREAM Ź PFS.StreamOpen[PFS.PathFromRope[name]]; list: LIST OF NormalizedStrokes Ź GetDB[stream]; IO.Close[stream]; RETURN [list] }; WriteDB: PUBLIC PROC [name: Rope.ROPE, db: TrainingDB] = { list: LIST OF NormalizedStrokes ~ NARROW[db]; stream: IO.STREAM Ź PFS.StreamOpen[PFS.PathFromRope[name], create]; PutDB[stream, list]; IO.Close[stream]; }; MergeDB: PUBLIC PROC [into: TrainingDB Ź NIL, db: TrainingDB] RETURNS [TrainingDB] = { <> inDB: LIST OF NormalizedStrokes Ź NARROW[into]; list: LIST OF NormalizedStrokes ~ NARROW[db]; FOR l: LIST OF NormalizedStrokes Ź list, l.rest WHILE l#NIL DO ns: NormalizedStrokes ~ CopyNormalizedStrokes[l.first]; inDB Ź AddToDB[inDB, ns]; ENDLOOP; RETURN [inDB]; }; END. <<>>