ImagerBetweenImpl.mesa
Copyright © 1984, Xerox Corporation. All rights reserved.
Doug Wyatt, December 4, 1984 9:34:48 am PST
Eric Nickell, July 17, 1985 5:03:14 pm PDT
Michael Plass, March 12, 1986 12:54:18 pm PST
Pier, October 8, 1985 2:28:23 pm PDT
DIRECTORY
Basics, CountedVM, Imager, ImagerBackdoor, ImagerColorOperator, ImagerFont, ImagerPath, ImagerPrivate, ImagerTransformation, PrincOpsUtils, Rope, FS, Interpress, ImagerBetween;
ImagerBetweenImpl: CEDAR PROGRAM
IMPORTS Basics, CountedVM, Imager, ImagerBackdoor, ImagerColorOperator, ImagerFont, ImagerTransformation, PrincOpsUtils, Rope, FS, Interpress
EXPORTS Imager, ImagerBetween
SHARES Rope -- For QFetch
~ BEGIN
OPEN Imager;
IntKey: TYPE ~ ImagerBackdoor.IntKey;
RealKey: TYPE ~ ImagerBackdoor.RealKey;
Clipper: TYPE ~ ImagerBackdoor.Clipper;
ROPE: TYPE ~ Rope.ROPE;
firstMemForm: NAT ~ 1000;
Inconsistent:
PUBLIC
ERROR ~
CODE;
Data: TYPE ~ REF DataRep;
DataRep: TYPE ~ RECORD[head, tail: CommandList, current: CommandList ← NIL, pass: NAT ← 0, getTDone: BOOL ← FALSE, getTForm: NAT ← firstMemForm];
Class: TYPE ~ ImagerPrivate.Class;
ClassRep: PUBLIC TYPE ~ ImagerPrivate.ClassRep; --export to Imager
CommandList: TYPE ~ LIST OF CommandRep;
checkSize: [0..20] ~
SIZE[CommandRep];
-- want to keep the size of CommandRep small.
Reals: TYPE ~ ARRAY [0..4) OF REAL;
MakeR: PROC [real: REAL] RETURNS [Reals] ~ {RETURN [ALL[real]]};
RollR:
PROC [r: Reals]
RETURNS [Reals] ~ {
t: REAL ← r[0];
r[0] ← r[1]; r[1]← r[2]; r[2] ← r[3]; r[3] ← t;
RETURN [r]
};
TimeSpec: TYPE ~ ImagerBetween.TimeSpec;
BetweenReals:
PROC [reals: Reals, t: TimeSpec]
RETURNS [
REAL] ~ {
d0: NAT ~ IF t.d0 = LAST[NAT] THEN t.d1 ELSE t.d0;
d1: NAT ~ t.d1;
d2: NAT ~ IF t.d2 = LAST[NAT] THEN t.d1 ELSE t.d2;
r0: REAL ~ IF t.d0 = LAST[NAT] THEN reals[1] - (reals[2]-reals[1]) ELSE reals[0];
r1: REAL ~ reals[1];
r2: REAL ~ reals[2];
r3: REAL ~ IF t.d2 = LAST[NAT] THEN reals[2] + (reals[2]-reals[1]) ELSE reals[3];
b0: REAL ~ r1;
b1: REAL ~ r1+(r2-r0)*d1/d0/6;
b2: REAL ~ r2+(r1-r3)*d1/d2/6;
b3: REAL ~ r2;
s: REAL ~ REAL[t.n1]/REAL[t.d1];
S: REAL ~ 1-s;
b01: REAL ~ b0*S+b1*s;
b12: REAL ~ b1*S+b2*s;
b23: REAL ~ b2*S+b3*s;
b012: REAL ~ b01*S+b12*s;
b123: REAL ~ b12*S+b23*s;
b0123: REAL ~ b012*S+b123*s;
RETURN [b0123]
RETURN [reals[1]*(1-s)+reals[2]*s]
};
Vecs: TYPE ~ ARRAY [0..4) OF Imager.VEC;
MakeV: PROC [vec: Imager.VEC] RETURNS [Vecs] ~ {RETURN [ALL[vec]]};
RollV:
PROC [r: Vecs]
RETURNS [Vecs] ~ {
t: Imager.VEC ← r[0];
r[0] ← r[1]; r[1]← r[2]; r[2] ← r[3]; r[3] ← t;
RETURN [r]
};
BetweenVecs:
PROC [vecs: Vecs, t: TimeSpec]
RETURNS [Imager.
VEC] ~ {
RETURN [[
x: BetweenReals[[vecs[0].x, vecs[1].x, vecs[2].x, vecs[3].x], t],
y: BetweenReals[[vecs[0].y, vecs[1].y, vecs[2].y, vecs[3].y], t]
]]
};
Ts: TYPE ~ ARRAY [0..4) OF ImagerTransformation.Transformation;
MakeTs: PROC [m: ImagerTransformation.Transformation] RETURNS [Ts] ~ {RETURN [ALL[m]]};
RollTs:
PROC [r: Ts]
RETURNS [Ts] ~ {
t: ImagerTransformation.Transformation ← r[0];
r[0] ← r[1]; r[1]← r[2]; r[2] ← r[3]; r[3] ← t;
RETURN [r]
};
BetweenTs:
PROC [ts: Ts, t: TimeSpec]
RETURNS [ImagerTransformation.Transformation] ~ {
RETURN [ImagerTransformation.Create[
a: BetweenReals[[ts[0].a, ts[1].a, ts[2].a, ts[3].a], t],
b: BetweenReals[[ts[0].b, ts[1].b, ts[2].b, ts[3].b], t],
c: BetweenReals[[ts[0].c, ts[1].c, ts[2].c, ts[3].c], t],
d: BetweenReals[[ts[0].d, ts[1].d, ts[2].d, ts[3].d], t],
e: BetweenReals[[ts[0].e, ts[1].e, ts[2].e, ts[3].e], t],
f: BetweenReals[[ts[0].f, ts[1].f, ts[2].f, ts[3].f], t]
]]
};
RollRecs:
PROC [r:
ARRAY [0..4)
OF
REF Imager.Rectangle]
RETURNS [
ARRAY [0..4)
OF
REF Imager.Rectangle] ~ {
t: REF Imager.Rectangle ← r[0];
r[0] ← r[1]; r[1]← r[2]; r[2] ← r[3]; r[3] ← t;
RETURN [r]
};
BetweenRecs:
PROC [r:
ARRAY [0..4)
OF
REF Imager.Rectangle, t: TimeSpec]
RETURNS [Imager.Rectangle] ~ {
RETURN [[
x: BetweenReals[[r[0].x, r[1].x, r[2].x, r[3].x], t],
y: BetweenReals[[r[0].y, r[1].y, r[2].y, r[3].y], t],
w: BetweenReals[[r[0].w, r[1].w, r[2].w, r[3].w], t],
h: BetweenReals[[r[0].h, r[1].h, r[2].h, r[3].h], t]
]]
};
Roll:
PUBLIC
PROC [context: Imager.Context] ~ {
data: Data ~ NARROW[context.data];
RollBody[data.head];
};
CommandRep:
TYPE ~
RECORD[
SELECT type: *
FROM
DoSave => [body: CommandList, all: BOOL],
SetInt => [key: IntKey, val: INT],
SetReal => [key: RealKey, val: Reals],
SetT => [m: Ts],
SetFont => [font: Font],
SetColor => [color: Color],
SetClipper => [clipper: Clipper],
ConcatT => [m: Ts],
Scale2T => [s: Vecs],
RotateT => [a: Reals],
TranslateT => [t: Vecs],
Move => [rounded: BOOL],
SetXY => [p: Vecs],
SetXYRel => [v: Vecs],
Show => [string: XStringSeq, xrel: BOOL],
ShowShort => [text: Rope.Text, xrel: BOOL],
StartUnderline => [],
MaskUnderline => [dy, h: Reals],
CorrectMask => [],
CorrectSpace => [v: Vecs],
Space => [x: Reals],
SetCorrectMeasure => [v: Vecs],
SetCorrectTolerance => [v: Vecs],
Correct => [body: CommandList],
DontCorrect => [body: CommandList, saveCP: BOOL],
SetGray => [f: Reals],
SetSampledColor => [d: REF SetSampledColorData],
SetSampledBlack => [d: REF SetSampledBlackData],
MaskFill => [path: Path, parity: BOOL],
MaskRectangle => [r: ARRAY [0..4) OF REF Rectangle],
MaskStroke => [path: Path, closed: BOOL],
MaskVector => [p: REF ARRAY [0..2) OF Vecs],
MaskPixel => [pa: PixelArray],
MaskBits => [bits: Bits],
DrawBits => [bits: Bits],
Clip => [path: Path, parity: BOOL, exclude: BOOL],
ClipRectangle => [r: ARRAY [0..4) OF REF Rectangle, exclude: BOOL]
ENDCASE
];
SetSampledColorData:
TYPE ~
RECORD [
pa: PixelArray,
m: ImagerTransformation.Transformation,
colorOperator: ColorOperator
];
SetSampledBlackData:
TYPE ~
RECORD [
pa: PixelArray,
m: ImagerTransformation.Transformation,
clear: BOOL
];
XStringSeq: TYPE ~ REF XStringSeqRec;
XStringSeqRec:
TYPE ~
RECORD [
SEQUENCE n: CARDINAL OF XChar
];
Path: TYPE ~ REF PointSequence;
PointSequence:
TYPE ~
RECORD [
rest: REF PointSequence ← NIL,
seq: SEQUENCE k: NAT OF PointRec
];
PointRec:
TYPE ~
RECORD [
SELECT type: *
FROM
move => [p0: Vecs],
line => [p1: Vecs],
push => [p: Vecs],
curve => [p3: Vecs], -- preceeded by two pushes
conic => [r: Reals], -- preceeded by two pushes
arc => [p2: Vecs] -- preceeded by one push
ENDCASE
];
Utility Procedures
DoPath:
PROC [path: Path, t: TimeSpec, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc, curveTo: ImagerPath.CurveToProc, conicTo: ImagerPath.ConicToProc, arcTo: ImagerPath.ArcToProc] ~ {
stack: ARRAY [0..2) OF VEC;
s: [0..2] ← 0;
UNTIL path =
NIL
DO
FOR i:
NAT
IN [0..path.k)
DO
pointRec: PointRec ~ path[i];
WITH x: pointRec
SELECT
FROM
move => {check: [0..0] ~ s; moveTo[BetweenVecs[x.p0, t]]};
line => {check: [0..0] ~ s; lineTo[BetweenVecs[x.p1, t]]};
push => {stack[s] ← BetweenVecs[x.p, t]; s ← s+1};
curve => {check: [2..2] ~ s; curveTo[stack[0], stack[1], BetweenVecs[x.p3, t]]; s ← 0};
conic => {check: [2..2] ~ s; conicTo[stack[0], stack[1], BetweenReals[x.r, t]]; s ← 0};
arc => {check: [1..1] ~ s; arcTo[stack[0], BetweenVecs[x.p2, t]]; s ← 0};
ENDCASE => ERROR Inconsistent;
ENDLOOP;
path ← path.rest;
ENDLOOP;
};
UpdatePath:
PROC [old, new: Path, pass:
NAT] ~ {
UNTIL old =
NIL
OR new =
NIL
DO
IF old.k # new.k THEN ERROR Inconsistent;
FOR i:
NAT
IN [0..old.k)
DO
newPt: PointRec ~ new[i];
WITH o: old[i]
SELECT
FROM
move => {WITH n: newPt SELECT FROM move => o.p0[pass] ← n.p0[pass] ENDCASE};
line => {WITH n: newPt SELECT FROM line => o.p1[pass] ← n.p1[pass] ENDCASE};
push => {WITH n: newPt SELECT FROM push => o.p[pass] ← n.p[pass] ENDCASE};
curve => {WITH n: newPt SELECT FROM curve => o.p3[pass] ← n.p3[pass] ENDCASE};
conic => {WITH n: newPt SELECT FROM conic => o.r[pass] ← n.r[pass] ENDCASE};
arc => {WITH n: newPt SELECT FROM arc => o.p2[pass] ← n.p2[pass] ENDCASE};
ENDCASE => ERROR Inconsistent;
ENDLOOP;
old ← old.rest;
new ← new.rest;
ENDLOOP;
IF old # new THEN ERROR Inconsistent;
};
RollPath:
PROC [path: Path] ~ {
UNTIL path =
NIL
DO
FOR i:
NAT
IN [0..path.k)
DO
WITH o: path[i]
SELECT
FROM
move => {o.p0 ← RollV[o.p0]};
line => {o.p1 ← RollV[o.p1]};
push => {o.p ← RollV[o.p]};
curve => {o.p3 ← RollV[o.p3]};
conic => {o.r ← RollR[o.r]};
arc => {o.p2 ← RollV[o.p2]};
ENDCASE => ERROR Inconsistent;
ENDLOOP;
path ← path.rest;
ENDLOOP;
};
RollBody:
PROC [cList: CommandList] ~
TRUSTED {
FOR each: CommandList ← cList, each.rest
UNTIL each=
NIL
DO
WITH cmd: each.first
SELECT
FROM
DoSave => {RollBody[cmd.body]};
SetInt => NULL;
SetReal => {cmd.val ← RollR[cmd.val]};
SetT => {cmd.m ← RollTs[cmd.m]};
SetFont => NULL;
SetColor => NULL;
SetClipper => NULL;
ConcatT => {cmd.m ← RollTs[cmd.m]};
Scale2T => {cmd.s ← RollV[cmd.s]};
RotateT => {cmd.a ← RollR[cmd.a]};
TranslateT => {cmd.t ← RollV[cmd.t]};
Move => NULL;
SetXY => {cmd.p ← RollV[cmd.p]};
SetXYRel => {cmd.v ← RollV[cmd.v]};
Show => NULL;
ShowShort => NULL;
StartUnderline => NULL;
MaskUnderline => {cmd.dy ← RollR[cmd.dy]; cmd.h ← RollR[cmd.h]};
CorrectMask => NULL;
CorrectSpace => {cmd.v ← RollV[cmd.v]};
Space => {cmd.x ← RollR[cmd.x]};
SetCorrectMeasure => {cmd.v ← RollV[cmd.v]};
SetCorrectTolerance => {cmd.v ← RollV[cmd.v]};
Correct => {RollBody[cmd.body]};
DontCorrect => {RollBody[cmd.body]};
SetGray => {cmd.f ← RollR[cmd.f]};
SetSampledColor => NULL;
SetSampledBlack => NULL;
MaskFill => {RollPath[cmd.path]};
MaskRectangle => {cmd.r ← RollRecs[cmd.r]};
MaskStroke => {RollPath[cmd.path]};
MaskVector => {cmd.p[0] ← RollV[cmd.p[0]]; cmd.p[1] ← RollV[cmd.p[1]]};
MaskPixel => NULL;
MaskBits => NULL;
DrawBits => NULL;
Clip => {RollPath[cmd.path]};
ClipRectangle => {cmd.r ← RollRecs[cmd.r]};
ENDCASE => ERROR;
ENDLOOP;
};
GetPath:
PROC [pathProc: PathProc]
RETURNS [path: Path] ~ {
bufSize: NAT ~ 40;
buf: ARRAY [0..bufSize) OF PointRec;
k: NAT ← 0;
Flush:
PROC ~ {
rest: REF PointSequence ← NEW[PointSequence[k]];
FOR i:
NAT
IN [0..k)
DO
TRUSTED {rest[i] ← buf[i]};
ENDLOOP;
IF pathTail = NIL THEN path ← rest ELSE pathTail.rest ← rest;
pathTail ← rest;
k ← 0;
};
AppendToPath:
PROC [pointRec: PointRec] ~ {
IF k = bufSize THEN Flush[];
TRUSTED {buf[k] ← pointRec};
k ← k + 1;
};
MoveTo: ImagerPath.MoveToProc ~ {
AppendToPath[[move [MakeV[p]]]]
};
LineTo: ImagerPath.LineToProc ~ {
AppendToPath[[line [MakeV[p1]]]]
};
CurveTo: ImagerPath.CurveToProc ~ {
AppendToPath[[push [MakeV[p1]]]];
AppendToPath[[push [MakeV[p2]]]];
AppendToPath[[curve [MakeV[p3]]]]
};
ConicTo: ImagerPath.ConicToProc ~ {
AppendToPath[[push [MakeV[p1]]]];
AppendToPath[[push [MakeV[p2]]]];
AppendToPath[[conic [MakeR[r]]]]
};
ArcTo: ImagerPath.ArcToProc ~ {
AppendToPath[[push [MakeV[p1]]]];
AppendToPath[[arc [MakeV[p2]]]]
};
pathTail: Path ← path ← NIL;
pathProc[MoveTo, LineTo, CurveTo, ConicTo, ArcTo];
Flush[];
};
GetBody:
PROC [context: Context, action:
PROC]
RETURNS [body: CommandList] ~ {
savedData: Data ~ NARROW[context.data];
data: Data;
context.data ← NEW[DataRep ← [NIL, NIL]]; --Start with a fresh trail
action[]; --Perform the action
data ← NARROW[context.data];
context.data ← savedData;
RETURN [data.head]
};
UpdateBody:
PROC [context: Context, action:
PROC, body: CommandList, i:
NAT] ~ {
savedData: Data ~ NARROW[context.data];
data: Data ← NEW[DataRep ← [NIL, NIL]];
data.head ← data.current ← body;
data.tail ← NIL;
data.pass ← i;
context.data ← data;
action[];
context.data ← savedData;
};
Append:
PROC[context: Context, command: CommandRep] ~ {
WITH context.data
SELECT
FROM
data: Data => {
IF data.current =
NIL
THEN {
tail: CommandList ~ LIST[command];
IF data.tail=NIL THEN data.head ← tail ELSE data.tail.rest ← tail;
data.tail ← tail;
}
ELSE {
i: NAT ~ data.pass;
current: LIST OF CommandRep ← data.current;
IF current.first.type # command.type THEN ERROR Inconsistent
ELSE
TRUSTED {
WITH cmd: command
SELECT
FROM
DoSave => ERROR;
SetInt => NULL;
SetReal =>
WITH old: current.first
SELECT
FROM SetReal => {
old.val[i] ← cmd.val[i];
} ENDCASE;
SetT =>
WITH old: current.first
SELECT
FROM SetT => {
old.m[i] ← cmd.m[i];
} ENDCASE;
SetFont => NULL;
SetColor => NULL; -- might like to interpolate colors.
SetClipper => NULL;
ConcatT =>
WITH old: current.first
SELECT
FROM ConcatT => {
old.m[i] ← cmd.m[i];
} ENDCASE;
Scale2T =>
WITH old: current.first
SELECT
FROM Scale2T => {
old.s[i] ← cmd.s[i];
} ENDCASE;
RotateT =>
WITH old: current.first
SELECT
FROM RotateT => {
old.a[i] ← cmd.a[i];
} ENDCASE;
TranslateT =>
WITH old: current.first
SELECT
FROM TranslateT => {
old.t[i] ← cmd.t[i];
} ENDCASE;
Move => NULL;
SetXY =>
WITH old: current.first
SELECT
FROM SetXY => {
old.p[i] ← cmd.p[i];
} ENDCASE;
SetXYRel =>
WITH old: current.first
SELECT
FROM SetXYRel => {
old.v[i] ← cmd.v[i];
} ENDCASE;
Show => NULL;
ShowShort => NULL;
StartUnderline => NULL;
MaskUnderline =>
WITH old: current.first
SELECT
FROM MaskUnderline => {
old.dy[i] ← cmd.dy[i];
old.h[i] ← cmd.h[i];
} ENDCASE;
CorrectMask => NULL;
CorrectSpace =>
WITH old: current.first
SELECT
FROM CorrectSpace => {
old.v[i] ← cmd.v[i];
} ENDCASE;
Space =>
WITH old: current.first
SELECT
FROM Space => {
old.x[i] ← cmd.x[i];
} ENDCASE;
SetCorrectMeasure =>
WITH old: current.first
SELECT
FROM SetCorrectMeasure => {
old.v[i] ← cmd.v[i];
} ENDCASE;
SetCorrectTolerance =>
WITH old: current.first
SELECT
FROM SetCorrectTolerance => {
old.v[i] ← cmd.v[i];
} ENDCASE;
Correct => ERROR;
DontCorrect => ERROR;
SetGray =>
WITH old: current.first
SELECT
FROM SetGray => {
old.f[i] ← cmd.f[i];
} ENDCASE;
SetSampledColor => NULL;
SetSampledBlack => NULL;
MaskFill =>
WITH old: current.first
SELECT
FROM MaskFill => {
UpdatePath[old.path, cmd.path, i];
} ENDCASE;
MaskRectangle =>
WITH old: current.first
SELECT
FROM MaskRectangle => {
old.r[i] ← cmd.r[i];
} ENDCASE;
MaskStroke =>
WITH old: current.first
SELECT
FROM MaskStroke => {
UpdatePath[old.path, cmd.path, i];
} ENDCASE;
MaskVector =>
WITH old: current.first
SELECT
FROM MaskVector => {
old.p[0][i] ← cmd.p[0][i];
old.p[1][i] ← cmd.p[1][i];
} ENDCASE;
MaskPixel => NULL;
MaskBits => NULL;
DrawBits => NULL;
Clip =>
WITH old: current.first
SELECT
FROM Clip => {
UpdatePath[old.path, cmd.path, i];
} ENDCASE;
ClipRectangle =>
WITH old: current.first
SELECT
FROM ClipRectangle => {
old.r[i] ← cmd.r[i];
} ENDCASE;
ENDCASE => ERROR;
data.current ← data.current.rest;
};
};
};
ENDCASE => ERROR;
};
ReplayList:
PROC [cList: CommandList, t: TimeSpec, into: Context] ~
TRUSTED {
FOR each: CommandList ← cList, each.rest
UNTIL each=
NIL
DO
We use this form of discrimination because it generates a jump table rather than a series of sequential tests. Unfortunately, it needs to be trusted. . .
WITH cmd: each.first
SELECT
FROM
DoSave =>
CHECKED {
Action:
PROC ~ {
ReplayList[cmd.body, t, into];
};
IF cmd.all THEN Imager.DoSaveAll[into, Action] ELSE Imager.DoSave[into, Action];
};
SetInt => ImagerBackdoor.SetInt[into, cmd.key, cmd.val];
SetReal => ImagerBackdoor.SetReal[into, cmd.key, BetweenReals[cmd.val, t]];
SetT => ImagerBackdoor.SetT[into, BetweenTs[cmd.m, t]];
SetFont => Imager.SetFont[into, cmd.font];
SetColor => Imager.SetColor[into, cmd.color];
SetClipper => ImagerBackdoor.SetClipper[into, cmd.clipper];
ConcatT => Imager.ConcatT[into, BetweenTs[cmd.m, t]];
Scale2T => Imager.Scale2T[into, BetweenVecs[cmd.s, t]];
RotateT => Imager.RotateT[into, BetweenReals[cmd.a, t]];
TranslateT => Imager.TranslateT[into, BetweenVecs[cmd.t, t]];
Move => {
IF cmd.rounded THEN Imager.Trans[into] ELSE Imager.Move[into];
};
SetXY => Imager.SetXY[into, BetweenVecs[cmd.p, t]];
SetXYRel => Imager.SetXYRel[into, BetweenVecs[cmd.v, t]];
Show =>
CHECKED {
FeedChar: Imager.XStringProc ~ {
~ PROC [charAction: XCharProc]
XCharProc: TYPE ~ PROC [char: XChar];
FOR i:
CARDINAL
IN [0..cmd.string.n)
DO
charAction[cmd.string[i]];
ENDLOOP;
};
Imager.Show[into, FeedChar, cmd.xrel];
};
ShowShort =>
CHECKED {
FeedChar: Imager.XStringProc ~ {
~ PROC [charAction: XCharProc]
XCharProc: TYPE ~ PROC [char: XChar];
text: Rope.Text ~ cmd.text;
FOR i:
CARDINAL
IN [0..text.length)
DO
charAction[[0, Rope.QFetch[text, i]-'\000]];
ENDLOOP;
};
Imager.Show[into, FeedChar, cmd.xrel];
};
StartUnderline => Imager.StartUnderline[into];
MaskUnderline => Imager.MaskUnderline[into, BetweenReals[cmd.dy, t], BetweenReals[cmd.h, t]];
CorrectMask => Imager.CorrectMask[into];
CorrectSpace => Imager.CorrectSpace[into, BetweenVecs[cmd.v, t]];
Space => Imager.Space[into, BetweenReals[cmd.x, t]];
SetCorrectMeasure => Imager.SetCorrectMeasure[into, BetweenVecs[cmd.v, t]];
SetCorrectTolerance => Imager.SetCorrectTolerance[into, BetweenVecs[cmd.v, t]];
Correct =>
CHECKED {
Action:
PROC ~ {
ReplayList[cmd.body, t, into];
};
Imager.Correct[into, Action];
};
DontCorrect =>
CHECKED {
Action:
PROC ~ {
ReplayList[cmd.body, t, into];
};
Imager.DontCorrect[into, Action, cmd.saveCP];
};
SetGray => Imager.SetGray[into, BetweenReals[cmd.f, t]];
SetSampledColor => Imager.SetSampledColor[into, cmd.d.pa, cmd.d.m, cmd.d.colorOperator];
SetSampledBlack => Imager.SetSampledBlack[into, cmd.d.pa, cmd.d.m, cmd.d.clear];
MaskFill =>
CHECKED {
PathProc: Imager.PathProc ~ {
DoPath[cmd.path, t, moveTo, lineTo, curveTo, conicTo, arcTo];
};
Imager.MaskFill[into, PathProc, cmd.parity];
};
MaskRectangle => Imager.MaskRectangle[into, BetweenRecs[cmd.r, t]];
MaskStroke =>
CHECKED {
PathProc: Imager.PathProc ~ {
DoPath[cmd.path, t, moveTo, lineTo, curveTo, conicTo, arcTo];
};
Imager.MaskStroke[into, PathProc, cmd.closed];
};
MaskVector => Imager.MaskVector[into, BetweenVecs[cmd.p[0], t], BetweenVecs[cmd.p[1], t]];
MaskPixel => Imager.MaskPixel[into, cmd.pa];
MaskBits => Imager.MaskBits[into, cmd.bits.vm.pointer, cmd.bits.wordsPerLine, cmd.bits.sMin, cmd.bits.fMin, cmd.bits.sSize, cmd.bits.fSize, cmd.bits.tx, cmd.bits.ty];
DrawBits => ImagerBackdoor.DrawBits[into, cmd.bits.vm.pointer, cmd.bits.wordsPerLine, cmd.bits.sMin, cmd.bits.fMin, cmd.bits.sSize, cmd.bits.fSize, cmd.bits.tx, cmd.bits.ty];
Clip =>
CHECKED {
PathProc: Imager.PathProc ~ {
DoPath[cmd.path, t, moveTo, lineTo, curveTo, conicTo, arcTo];
};
Imager.Clip[into, PathProc, cmd.parity, cmd.exclude];
};
ClipRectangle => Imager.ClipRectangle[into, BetweenRecs[cmd.r, t], cmd.exclude];
ENDCASE => ERROR;
ENDLOOP;
};
ReplayListSize:
PROC [cList: CommandList]
RETURNS [size:
INT] ~
TRUSTED {
size ← 0;
FOR each: CommandList ← cList, each.rest
UNTIL each=
NIL
DO
We use this form of discrimination because it generates a jump table rather than a series of sequential tests. Unfortunately, it needs to be trusted. . .
WITH cmd: each.first
SELECT
FROM
DoSave => CHECKED {size ← size+ReplayListSize[cmd.body];};
SetInt => size ← size+SIZE[CommandRep[SetInt]];
SetReal => size ← size+SIZE[CommandRep[SetReal]];
SetT => size ← size+SIZE[CommandRep[SetT]];
SetFont => size ← size+SIZE[CommandRep[SetFont]];
SetColor => size ← size+SIZE[CommandRep[SetColor]];
SetClipper => size ← size+SIZE[CommandRep[SetClipper]];
ConcatT => size ← size+SIZE[CommandRep[ConcatT]];
Scale2T => size ← size+SIZE[CommandRep[Scale2T]];
RotateT => size ← size+SIZE[CommandRep[RotateT]];
TranslateT => size ← size+SIZE[CommandRep[TranslateT]];
Move => size ← size+SIZE[CommandRep[Move]];
SetXY => size ← size+SIZE[CommandRep[SetXY]];
SetXYRel => size ← size+SIZE[CommandRep[SetXYRel]];
Show => size ← size+SIZE[XStringSeq]+1;
ShowShort => size ← size+SIZE[Rope.Text]+1;
StartUnderline => size ← size+SIZE[CommandRep[StartUnderline]];
MaskUnderline => size ← size+SIZE[CommandRep[MaskUnderline]];
CorrectMask => size ← size+SIZE[CommandRep[CorrectMask]];
CorrectSpace => size ← size+SIZE[CommandRep[CorrectSpace]];
Space => size ← size+SIZE[CommandRep[Space]];
SetCorrectMeasure => size ← size+SIZE[CommandRep[SetCorrectMeasure]];
SetCorrectTolerance => size ← size+SIZE[CommandRep[SetCorrectTolerance]];
Correct => CHECKED {size ← size+ReplayListSize[cmd.body];};
DontCorrect => CHECKED {size ← size+ReplayListSize[cmd.body];};
SetGray => size ← size+SIZE[CommandRep[SetGray]];
SetSampledColor => size ← size+SIZE[CommandRep[SetSampledColor]];
SetSampledBlack => size ← size+SIZE[CommandRep[SetSampledBlack]];
MaskFill => size ← size+SIZE[CommandRep[MaskFill]];
MaskRectangle => size ← size+SIZE[CommandRep[MaskRectangle]];
MaskStroke => size ← size+SIZE[CommandRep[MaskStroke]];
MaskVector => size ← size+SIZE[CommandRep[MaskVector]];
MaskPixel => size ← size+SIZE[CommandRep[MaskPixel]];
MaskBits => size ← size+SIZE[CommandRep[MaskBits]];
DrawBits => size ← size+SIZE[CommandRep[DrawBits]];
Clip => size ← size+SIZE[CommandRep[Clip]];
ClipRectangle => size ← size+SIZE[CommandRep[ClipRectangle]];
ENDCASE => ERROR;
ENDLOOP;
};
Public Procs
Create:
PUBLIC
PROC
RETURNS [Context] ~ {
RETURN [NEW[Imager.ContextRep ← [class: myClass, data: NEW[DataRep ← [NIL, NIL]]]]];
};
SetPass:
PUBLIC
PROC [self: Context, pass: [0..4]]
~ {
data: Data ~ NARROW[self.data];
IF pass = 0 THEN data^ ← [NIL, NIL]
ELSE {data^ ← [head: data.head, tail: NIL, current: data.head, pass: pass]};
};
Replay:
PUBLIC
PROC [self, into: Context, t: TimeSpec] ~ {
cList: CommandList ~ NARROW[self.data, Data].head;
ReplayList[cList, t, into];
};
GetContextSize:
PUBLIC
PROC [self: Context]
RETURNS [size:
INT] ~ {
cList: CommandList ~ NARROW[self.data, Data].head;
RETURN[ReplayListSize[cList]];
};
Context Procs
Bits: TYPE ~ REF BitsRep;
BitsRep:
TYPE ~
RECORD [
wordsPerLine, sMin, fMin, sSize, fSize: NAT,
tx, ty: INTEGER,
vm: CountedVM.Handle
];
MakeBits:
PROC [base:
LONG
POINTER, wordsPerLine:
NAT, sMin, fMin, sSize, fSize:
NAT, tx, ty:
INTEGER]
RETURNS [bits: Bits] ~ {
nwords: INT ← Basics.LongMult[wordsPerLine, sSize];
vm: CountedVM.Handle ← CountedVM.SimpleAllocate[nwords];
bits ← NEW[BitsRep ← [wordsPerLine, sMin, fMin, sSize, fSize, tx, ty, vm]];
TRUSTED {PrincOpsUtils.LongCopy[from: base, to: vm.pointer, nwords: nwords]}
};
MyDoSave:
PROC[context: Context, action:
PROC, all:
BOOL] ~ {
data: Data ~ NARROW[context.data];
IF data.current =
NIL
THEN {
body: CommandList ~ GetBody[context, action];
Append[context, [DoSave [body, all]]];
}
ELSE
TRUSTED {
current: LIST OF CommandRep ~ data.current;
WITH cmd: current.first
SELECT
FROM
DoSave => UpdateBody[context, action, cmd.body, data.pass];
ENDCASE => ERROR Inconsistent;
data.current ← current.rest;
};
};
MySetInt:
PROC[context: Context, key: IntKey, val:
INT] ~ {
Append[context, [SetInt [key, val]]];
};
MySetReal:
PROC[context: Context, key: RealKey, val:
REAL] ~ {
Append[context, [SetReal [key, MakeR[val]]]];
};
MyGetT:
PROC[context: Context]
RETURNS[Transformation] ~ {
m: Transformation ← ImagerTransformation.Scale[1.0];
data: Data ~ NARROW[context.data];
IF
NOT data.getTDone
THEN {
data.getTDone ← TRUE;
IF (data.getTForm ← data.getTForm + 1) = endMemForm THEN data.getTForm ← firstMemForm;
};
m.form ← data.getTForm;
RETURN [m];
};
MySetT:
PROC[context: Context, m: Transformation] ~ {
Append[context, [SetT [MakeTs[m]]]];
};
MySetFont:
PROC[context: Context, font: Font] ~ {
Append[context, [SetFont [font]]];
};
MySetColor:
PROC[context: Context, color: Color] ~ {
WITH color
SELECT
FROM
sampledColor: SampledColor => {
data: Data ~ NARROW[context.data];
IF data.getTDone
AND sampledColor.um.form = data.getTForm
THEN {
opClass: ATOM ~ ImagerColorOperator.GetColorOperatorClass[sampledColor.colorOperator];
um: Transformation ← ImagerTransformation.Copy[sampledColor.um];
um.form ← 0;
ImagerTransformation.ApplyPreScale[um, 1];
IF opClass = $SampledBlack
OR opClass = $SampledBlackClear
THEN
MySetSampledBlack[context, sampledColor.pa, um, opClass=$SampledBlackClear]
ELSE MySetSampledColor[context, sampledColor.pa, um, sampledColor.colorOperator];
RETURN;
};
};
ENDCASE => NULL;
Append[context, [SetColor [color]]];
};
MySetClipper:
PROC[context: Context, clipper: Clipper] ~ {
Append[context, [SetClipper [clipper]]];
};
MyGetInt:
PROC[context: Context, key: IntKey]
RETURNS[
INT] ~ {
Imager.Error[[$unimplemented, "Not implemented"]]};
MyGetReal:
PROC[context: Context, key: RealKey]
RETURNS[
REAL] ~ {
Imager.Error[[$unimplemented, "Not implemented"]]};
MyGetFont:
PROC[context: Context]
RETURNS[Font] ~ {
Imager.Error[[$unimplemented, "Not implemented"]]};
MyGetColor:
PROC[context: Context]
RETURNS[Color] ~ {
Imager.Error[[$unimplemented, "Not implemented"]]};
MyGetClipper:
PROC[context: Context]
RETURNS[Clipper] ~ {
Imager.Error[[$unimplemented, "Not implemented"]]};
MyConcatT:
PROC[context: Context, m: Transformation] ~ {
Append[context, [ConcatT [MakeTs[m]]]];
};
MyScale2T:
PROC[context: Context, s:
VEC] ~ {
Append[context, [Scale2T [MakeV[s]]]];
};
MyRotateT:
PROC[context: Context, a:
REAL] ~ {
Append[context, [RotateT [MakeR[a]]]];
};
MyTranslateT:
PROC[context: Context, t:
VEC] ~ {
Append[context, [TranslateT [MakeV[t]]]];
};
MyMove:
PROC[context: Context, rounded:
BOOL] ~ {
Append[context, [Move [rounded]]];
};
MySetXY:
PROC[context: Context, p:
VEC] ~ {
Append[context, [SetXY [MakeV[p]]]];
};
MySetXYRel:
PROC[context: Context, v:
VEC] ~ {
Append[context, [SetXYRel [MakeV[v]]]];
};
MyShow:
PROC[context: Context, string: XStringProc, xrel:
BOOL] ~ {
eightbit: BOOL ← TRUE;
n: INT ← 0;
CountXChars: ImagerFont.XCharProc ~ {
IF char.set # 0 THEN eightbit ← FALSE;
n ← n+1;
};
InstallXChar: ImagerFont.XCharProc ~ {
xString[n] ← char;
n ← n+1;
};
xString: XStringSeq;
string[CountXChars]; -- Count number of chars fed back, set eightbit
IF eightbit
THEN {
text: Rope.Text ~ Rope.NewText[n];
i: NAT ← 0;
InstallChar: ImagerFont.XCharProc ~ {
text[i] ← VAL[char.code];
i ← i+1;
};
text.length ← n;
string[InstallChar]; -- Install each character
Append[context, [ShowShort [text: text, xrel: xrel]]];
}
ELSE {
xString: XStringSeq ~ NEW[XStringSeqRec[n]];
i: INT ← 0;
InstallXChar: ImagerFont.XCharProc ~ {
xString[i] ← char;
i ← i+1;
};
string[InstallXChar]; -- Install each character
Append[context, [Show [string: xString, xrel: xrel]]];
};
};
MyShowText:
PROC[context: Context, text:
REF
READONLY
TEXT, start, len:
NAT, xrel:
BOOL] ~ {
class: Class ~ context.class;
string: XStringProc ~ { ImagerFont.MapText[text, start, len, charAction] };
class.Show[context, string, xrel];
};
MyStartUnderline:
PROC[context: Context] ~ {
Append[context, [StartUnderline []]]};
MyMaskUnderline:
PROC[context: Context, dy, h:
REAL] ~ {
Append[context, [MaskUnderline [MakeR[dy], MakeR[h]]]];
};
MyCorrectMask:
PROC[context: Context] ~ {
Append[context, [CorrectMask []]]};
MyCorrectSpace:
PROC[context: Context, v:
VEC] ~ {
Append[context, [CorrectSpace [MakeV[v]]]];
};
MySpace:
PROC[context: Context, x:
REAL] ~ {
Append[context, [Space [MakeR[x]]]];
};
MySetCorrectMeasure:
PROC[context: Context, v:
VEC] ~ {
Append[context, [SetCorrectMeasure [MakeV[v]]]];
};
MySetCorrectTolerance:
PROC[context: Context, v:
VEC] ~ {
Append[context, [SetCorrectTolerance [MakeV[v]]]];
};
MyCorrect:
PROC[context: Context, action:
PROC] ~ {
data: Data ~ NARROW[context.data];
IF data.current =
NIL
THEN {
body: CommandList ~ GetBody[context, action];
Append[context, [Correct [body]]];
}
ELSE
TRUSTED {
current: LIST OF CommandRep ~ data.current;
WITH cmd: current.first
SELECT
FROM
Correct => UpdateBody[context, action, cmd.body, data.pass];
ENDCASE => ERROR Inconsistent;
data.current ← current.rest;
};
};
MyDontCorrect:
PROC[context: Context, action:
PROC, saveCP:
BOOL] ~ {
data: Data ~ NARROW[context.data];
IF data.current =
NIL
THEN {
body: CommandList ~ GetBody[context, action];
Append[context, [DontCorrect [body, saveCP]]];
}
ELSE
TRUSTED {
current: LIST OF CommandRep ~ data.current;
WITH cmd: current.first
SELECT
FROM
DontCorrect => UpdateBody[context, action, cmd.body, data.pass];
ENDCASE => ERROR Inconsistent;
data.current ← current.rest;
};
};
MySetGray:
PROC[context: Context, f:
REAL] ~ {
Append[context, [SetGray [MakeR[f]]]];
};
MySetSampledColor:
PROC[context: Context, pa: PixelArray, m: Transformation, colorOperator: ColorOperator] ~ {
Append[context, [SetSampledColor [NEW[SetSampledColorData ← [pa, m, colorOperator]]]]];
};
MySetSampledBlack:
PROC[context: Context, pa: PixelArray, m: Transformation, clear:
BOOL] ~ {
Append[context, [SetSampledBlack [NEW[SetSampledBlackData ← [pa, m, clear]]]]];
};
MyMaskFill:
PROC[context: Context, path: PathProc, parity:
BOOL] ~ {
pathList: Path ~ GetPath[path];
Append[context, [MaskFill [pathList, parity]]];
};
MyMaskRectangle:
PROC[context: Context, r: Rectangle] ~ {
Append[context, [MaskRectangle [ALL[NEW[Rectangle ← r]]]]];
};
MyMaskRectangleI:
PROC[context: Context, x, y, w, h:
INTEGER] ~ {
MyMaskRectangle[context, [x, y, w, h]];
};
MyMaskStroke:
PROC[context: Context, path: PathProc, closed:
BOOL] ~ {
pathList: Path ~ GetPath[path];
Append[context, [MaskStroke [pathList, closed]]];
};
MyMaskVector:
PROC[context: Context, p1, p2:
VEC] ~ {
Append[context, [MaskVector [NEW[ARRAY [0..2) OF Vecs ← [MakeV[p1], MakeV[p2]]]]]];
};
MyMaskPixel:
PROC[context: Context, pa: PixelArray] ~ {
Append[context, [MaskPixel [pa]]];
};
MyMaskBits:
PROC[context: Context, base:
LONG
POINTER, wordsPerLine:
NAT, sMin, fMin, sSize, fSize:
NAT, tx, ty:
INTEGER] ~ {
bits: Bits ~ MakeBits[base, wordsPerLine, sMin, fMin, sSize, fSize, tx, ty];
Append[context, [MaskBits [bits]]];
};
MyDrawBits:
PROC[context: Context, base:
LONG
POINTER, wordsPerLine:
NAT, sMin, fMin, sSize, fSize:
NAT, tx, ty:
INTEGER] ~ {
bits: Bits ~ MakeBits[base, wordsPerLine, sMin, fMin, sSize, fSize, tx, ty];
Append[context, [DrawBits [bits]]];
};
MyClip:
PROC[context: Context, path: PathProc, parity:
BOOL, exclude:
BOOL] ~ {
pathList: Path ~ GetPath[path];
Append[context, [Clip [pathList, parity, exclude]]];
};
MyClipRectangle:
PROC[context: Context, r: Rectangle, exclude:
BOOL] ~ {
Append[context, [ClipRectangle [ALL[NEW[Rectangle ← r]], exclude]]];
};
MyClipRectangleI:
PROC[context: Context, x, y, w, h:
INTEGER, exclude:
BOOL] ~ {
MyClipRectangle[context, [x, y, w, h], exclude];
};
MyGetCP:
PROC[context: Context, rounded:
BOOL]
RETURNS[
VEC] ~ {
Imager.Error[[$unimplemented, "Not implemented"]]};
MyGetBoundingRectangle:
PROC[context: Context]
RETURNS[Rectangle] ~ {
Imager.Error[[$unimplemented, "Not implemented"]]};
myClass: Class ~
NEW[ClassRep ← [
type: $Between,
DoSave: MyDoSave,
SetInt: MySetInt,
SetReal: MySetReal,
SetT: MySetT,
SetFont: MySetFont,
SetColor: MySetColor,
SetClipper: MySetClipper,
SetStrokeDashes: NIL,
GetInt: MyGetInt,
GetReal: MyGetReal,
GetT: MyGetT,
GetFont: MyGetFont,
GetColor: MyGetColor,
GetClipper: MyGetClipper,
GetStrokeDashes: NIL,
ConcatT: MyConcatT,
Scale2T: MyScale2T,
RotateT: MyRotateT,
TranslateT: MyTranslateT,
Move: MyMove,
SetXY: MySetXY,
SetXYRel: MySetXYRel,
Show: MyShow,
ShowText: MyShowText,
StartUnderline: MyStartUnderline,
MaskUnderline: MyMaskUnderline,
CorrectMask: MyCorrectMask,
CorrectSpace: MyCorrectSpace,
Space: MySpace,
SetCorrectMeasure: MySetCorrectMeasure,
SetCorrectTolerance: MySetCorrectTolerance,
Correct: MyCorrect,
DontCorrect: MyDontCorrect,
SetGray: MySetGray,
SetSampledColor: MySetSampledColor,
SetSampledBlack: MySetSampledBlack,
MaskFill: MyMaskFill,
MaskRectangle: MyMaskRectangle,
MaskRectangleI: MyMaskRectangleI,
MaskStroke: MyMaskStroke,
MaskVector: MyMaskVector,
MaskPixel: MyMaskPixel,
MaskBits: MyMaskBits,
DrawBits: MyDrawBits,
Clip: MyClip,
ClipRectangle: MyClipRectangle,
ClipRectangleI: MyClipRectangleI,
GetCP: MyGetCP,
GetBoundingRectangle: MyGetBoundingRectangle
]];
ExpandFilenameList:
PROC [ipNamePatterns:
LIST
OF
ROPE]
RETURNS [
LIST
OF
ROPE] ~ {
ipNames: LIST OF ROPE ← LIST[NIL];
tail: LIST OF ROPE ← ipNames;
nameProc:
FS.NameProc ~ {
tail.rest ← LIST[fullFName];
tail ← tail.rest;
continue ← TRUE;
};
WHILE ipNamePatterns #
NIL
DO
FS.EnumerateForNames[ipNamePatterns.first, nameProc];
ipNamePatterns ← ipNamePatterns.rest;
ENDLOOP;
RETURN [ipNames.rest];
};
Play:
PROC [context: Imager.Context, ipNamePatterns:
LIST
OF
ROPE, nBetween:
NAT ← 20] ~ {
ipNames: LIST OF ROPE ← ExpandFilenameList[ipNamePatterns];
between: Imager.Context ~ Create[];
i: NAT ← 0;
WHILE ipNames #
NIL
DO
m: Interpress.OpenMaster ~ Interpress.Open[ipNames.first, NIL, NIL];
SetPass[between, i];
Interpress.DoPage[m, 1, between];
IF i < 3 THEN i ← i + 1
ELSE {
FOR i:
NAT
IN [0..nBetween)
DO
action:
PROC ~ {
Imager.SetGray[context, 0];
Imager.MaskRectangle[context, [0, 0, 10000, 10000]];
Imager.SetGray[context, 1];
Replay[self: between, into: context, t: [nBetween, nBetween, nBetween, i]];
};
Imager.DoSave[context, action];
ENDLOOP;
Roll[between];
};
ipNames ← ipNames.rest;
ENDLOOP;
};
END.