
<<ImagerListImpl.mesa>>
<<>>
<<Edited by:>>
<<Doug Wyatt, July 2, 1984 1:18:47 pm PDT>>

DIRECTORY
Imager USING [ArcToP, Class, ClassRep, ConicToP, Context, CurveToP, Error, FONT, LineToP, MoveToP, PathProc, StrokeEnd, Trajectory],
ImagerBasic USING [Color, Pair, PixelArray, Transformation],
<<ImagerList USING [],>>
Rope USING [FromProc, ROPE, Substr];

ImagerListImpl: CEDAR PROGRAM
IMPORTS Imager, Rope
<<EXPORTS ImagerList>>
~ BEGIN OPEN Imager, ImagerBasic;

ROPE: TYPE ~ Rope.ROPE;

Data: TYPE ~ REF DataRep;
DataRep: TYPE ~ RECORD[head, tail: CommandList];

CommandList: TYPE ~ LIST OF Command;

Command: TYPE ~ REF CommandRep;
CommandRep: TYPE ~ RECORD[SELECT type: * FROM
DoSave, DoSaveAll => [body: CommandList],
SetPriorityImportant => [priorityImportant: BOOL],
ConcatT => [m: Transformation],
ScaleT => [s: REAL],
Scale2T => [sx, sy: REAL],
RotateT => [a: REAL],
TranslateT => [x, y: REAL],
Move, Trans => [],
SetXY => [x, y: REAL],
SetXYI => [x, y: INTEGER],
SetXYRel => [x, y: REAL],
SetXYRelI => [x, y: INTEGER],
MaskFill => [path: REF],
SetStrokeWidth => [strokeWidth: REAL],
SetStrokeEnd => [strokeEnd: StrokeEnd],
MaskStroke, MaskStrokeClosed => [path: REF],
MaskVector => [x1, y1, x2, y2: REAL],
MaskVectorI => [x1, y1, x2, y2: INTEGER],
MaskRectangle => [x, y, w, h: REAL],
MaskRectangleI => [x, y, w, h: INTEGER],
StartUnderline => [],
MaskUnderline => [dy, h: REAL],
MaskUnderlineI => [dy, h: INTEGER],
MaskPixel => [pa: PixelArray],
SetNoImage => [noImage: BOOL],
SetGray => [f: REAL],
SetColor => [color: Color],
SetSampledColor => [pa: PixelArray, pixelT: Transformation, colorOperator: ATOM],
SetSampledBlack => [pa: PixelArray, pixelT: Transformation, transparent: BOOL],
ClipOutline, ExcludeOutline => [path: REF],
ClipRectangle => [x, y, w, h: REAL],
ClipRectangleI => [x, y, w, h: INTEGER],
ExcludeRectangle => [x, y, w, h: REAL],
ExcludeRectangleI => [x, y, w, h: INTEGER],
SetFont => [font: FONT],
ShowChar => [char: CHAR],
ShowCharacters => [rope: ROPE],
CorrectMask => [],
CorrectSpace => [x, y: REAL],
SetCorrectMeasure => [x, y: REAL],
SetCorrectTolerance => [x, y: REAL],
SetCorrectShrink => [correctShrink: REAL],
SetAmplifySpace => [amplifySpace: REAL],
Space => [x: REAL],
SpaceI => [x: INTEGER],
Correct => [body: CommandList],
ENDCASE
];

Init: PROC[context: Context, info: REF] ~ {
<<context.data _ data;>>
};

Append: PROC[data: Data, command: Command] ~ {
tail: CommandList ~ LIST[command];
IF data.tail=NIL THEN data.head _ tail ELSE data.tail.rest _ tail;
data.tail _ tail;
};

SetFont: PROC[context: Context, font: FONT] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetFont] _ [
SetFont[font: font]]];
Append[data, command];
};

SetGray: PROC[context: Context, f: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetGray] _ [
SetGray[f: f]]];
Append[data, command];
};

SetColor: PROC[context: Context, color: Color] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetColor] _ [
SetColor[color: color]]];
Append[data, command];
};

SetStrokeWidth: PROC[context: Context, strokeWidth: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetStrokeWidth] _ [
SetStrokeWidth[strokeWidth: strokeWidth]]];
Append[data, command];
};

SetAmplifySpace: PROC[context: Context, amplifySpace: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetAmplifySpace] _ [
SetAmplifySpace[amplifySpace: amplifySpace]]];
Append[data, command];
};

SetCorrectShrink: PROC[context: Context, correctShrink: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetCorrectShrink] _ [
SetCorrectShrink[correctShrink: correctShrink]]];
Append[data, command];
};

SetPriorityImportant: PROC[context: Context, priorityImportant: BOOL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetPriorityImportant] _ [
SetPriorityImportant[priorityImportant: priorityImportant]]];
Append[data, command];
};

SetStrokeEnd: PROC[context: Context, strokeEnd: StrokeEnd] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetStrokeEnd] _ [
SetStrokeEnd[strokeEnd: strokeEnd]]];
Append[data, command];
};

SetSampledColor: PROC[context: Context, pa: PixelArray, pixelT: Transformation, colorOperator: ATOM] ~ {
ERROR Imager.Error[$Unimplemented];
};

SetSampledBlack: PROC[context: Context, pa: PixelArray, pixelT: Transformation, transparent: BOOLEAN] ~ {
ERROR Imager.Error[$Unimplemented];
};

GetListFromBody: PROC[data: Data, body: PROC] RETURNS[list: CommandList] ~ {
tail: CommandList ~ data.tail; -- save original tail
body[]; -- execute the body
IF tail=NIL THEN { list _ data.head; data.head _ data.tail _ NIL }
ELSE { list _ tail.rest; tail.rest _ NIL; data.tail _ tail };
};

DoSave: PROC[context: Context, body: PROC] ~ {
data: Data ~ NARROW[context.data];
list: CommandList ~ GetListFromBody[data, body];
command: Command ~ NEW[CommandRep[DoSave] _ [DoSave[body: list]]];
Append[data, command];
};

DoSaveAll: PROC[context: Context, body: PROC] ~ {
data: Data ~ NARROW[context.data];
list: CommandList ~ GetListFromBody[data, body];
command: Command ~ NEW[CommandRep[DoSaveAll] _ [DoSaveAll[body: list]]];
Append[data, command];
};

ConcatT: PROC[context: Context, m: Transformation] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[ConcatT] _ [ConcatT[m: m]]];
Append[data, command];
};

ScaleT: PROC[context: Context, s: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[ScaleT] _ [ScaleT[s: s]]];
Append[data, command];
};

Scale2T: PROC[context: Context, sx, sy: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[Scale2T] _ [Scale2T[sx: sx, sy: sy]]];
Append[data, command];
};

RotateT: PROC[context: Context, a: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[RotateT] _ [RotateT[a: a]]];
Append[data, command];
};

TranslateT: PROC[context: Context, x, y: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[TranslateT] _ [TranslateT[x: x, y: y]]];
Append[data, command];
};

Move: PROC[context: Context] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[Move] _ [Move[]]];
Append[data, command];
};

Trans: PROC[context: Context] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[Trans] _ [Trans[]]];
Append[data, command];
};

SetXY: PROC[context: Context, x, y: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetXY] _ [SetXY[x: x, y: y]]];
Append[data, command];
};

SetXYI: PROC[context: Context, x, y: INTEGER] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetXYI] _ [SetXYI[x: x, y: y]]];
Append[data, command];
};

SetXYRel: PROC[context: Context, x, y: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetXYRel] _ [SetXYRel[x: x, y: y]]];
Append[data, command];
};

SetXYRelI: PROC[context: Context, x, y: INTEGER] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetXYRelI] _ [SetXYRelI[x: x, y: y]]];
Append[data, command];
};

GetPath: PROC[pathProc: PathProc, pathData: REF] RETURNS[list: LIST OF Trajectory _ NIL] ~ {
t: Trajectory _ NIL;
moveToP: PROC[p: Pair] ~ { IF t#NIL THEN list _ CONS[t, list]; t _ Imager.MoveToP[p] };
lineToP: PROC[p: Pair] ~ { t _ t.LineToP[p] };
curveToP: PROC[p1, p2, p3: Pair] ~ { t _ t.CurveToP[p1, p2, p3] };
conicToP: PROC[p1, p2: Pair, r: REAL] ~ { t _ t.ConicToP[p1, p2, r] };
arcToP: PROC[p1, p2: Pair] ~ { t _ t.ArcToP[p1, p2] };
pathProc[pathData, moveToP, lineToP, curveToP, conicToP, arcToP];
IF t#NIL THEN list _ CONS[t, list];
};

MaskFill: PROC[context: Context, pathProc: PathProc, pathData: REF] ~ {
data: Data ~ NARROW[context.data];
path: LIST OF Trajectory ~ GetPath[pathProc, pathData];
command: Command ~ NEW[CommandRep[MaskFill] _ [
MaskFill[path: path]]];
Append[data, command];
};

MaskStroke: PROC[context: Context, pathProc: PathProc, pathData: REF] ~ {
data: Data ~ NARROW[context.data];
path: LIST OF Trajectory ~ GetPath[pathProc, pathData];
command: Command ~ NEW[CommandRep[MaskStroke] _ [
MaskStroke[path: path]]];
Append[data, command];
};

MaskStrokeClosed: PROC[context: Context, pathProc: PathProc, pathData: REF] ~ {
data: Data ~ NARROW[context.data];
path: LIST OF Trajectory ~ GetPath[pathProc, pathData];
command: Command ~ NEW[CommandRep[MaskStrokeClosed] _ [
MaskStrokeClosed[path: path]]];
Append[data, command];
};

MaskVector: PROC [context: Context, x1, y1, x2, y2: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[MaskVector] _ [
MaskVector[x1: x1, y1: y1, x2: x2, y2: y2]]];
Append[data, command];
};

MaskVectorI: PROC[context: Context, x1, y1, x2, y2: INTEGER] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[MaskVectorI] _ [
MaskVectorI[x1: x1, y1: y1, x2: x2, y2: y2]]];
Append[data, command];
};

MaskRectangle: PROC[context: Context, x, y, w, h: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[MaskRectangle] _ [
MaskRectangle[x: x, y: y, w: w, h: h]]];
Append[data, command];
};

MaskRectangleI: PROC[context: Context, x, y, w, h: INTEGER] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[MaskRectangleI] _ [
MaskRectangleI[x: x, y: y, w: w, h: h]]];
Append[data, command];
};

StartUnderline: PROC[context: Context] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[StartUnderline] _ [
StartUnderline[]]];
Append[data, command];
};

MaskUnderline: PROC[context: Context, dy, h: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[MaskUnderline] _ [
MaskUnderline[dy: dy, h: h]]];
Append[data, command];
};

MaskUnderlineI: PROC[context: Context, dy, h: INTEGER] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[MaskUnderlineI] _ [
MaskUnderlineI[dy: dy, h: h]]];
Append[data, command];
};

MaskPixel: PROC[context: Context, pa: PixelArray] ~ {
ERROR Imager.Error[$Unimplemented];
};

SetNoImage: PROC[context: Context, noImage: BOOL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetNoImage] _ [
SetNoImage[noImage: noImage]]];
Append[data, command];
};

ClipOutline: PROC[context: Context, pathProc: PathProc, pathData: REF] ~ {
data: Data ~ NARROW[context.data];
path: LIST OF Trajectory ~ GetPath[pathProc, pathData];
command: Command ~ NEW[CommandRep[ClipOutline] _ [
ClipOutline[path: path]]];
Append[data, command];
};

ExcludeOutline: PROC[context: Context, pathProc: PathProc, pathData: REF] ~ {
data: Data ~ NARROW[context.data];
path: LIST OF Trajectory ~ GetPath[pathProc, pathData];
command: Command ~ NEW[CommandRep[ExcludeOutline] _ [
ExcludeOutline[path: path]]];
Append[data, command];
};

ClipRectangle: PROC[context: Context, x, y, w, h: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[ClipRectangle] _ [
ClipRectangle[x: x, y: y, w: w, h: h]]];
Append[data, command];
};

ClipRectangleI: PROC[context: Context, x, y, w, h: INTEGER] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[ClipRectangleI] _ [
ClipRectangleI[x: x, y: y, w: w, h: h]]];
Append[data, command];
};

ExcludeRectangle: PROC[context: Context, x, y, w, h: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[ExcludeRectangle] _ [
ExcludeRectangle[x: x, y: y, w: w, h: h]]];
Append[data, command];
};

ExcludeRectangleI: PROC[context: Context, x, y, w, h: INTEGER] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[ExcludeRectangleI] _ [
ExcludeRectangleI[x: x, y: y, w: w, h: h]]];
Append[data, command];
};

ShowChar: PROC[context: Context, char: CHAR] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[ShowChar] _ [
ShowChar[char: char]]];
Append[data, command];
};

RopeFromCharacters: PROC[characters: REF, start: INT, length: INT] RETURNS[ROPE] ~ {
IF start<0 OR length<0 THEN ERROR Imager.Error[$BoundsFault];
WITH characters SELECT FROM
rope: ROPE => RETURN[rope.Substr[start, length]];
text: REF TEXT => {
i: NAT _ MIN[start, text.length];
len: NAT ~ MIN[length, text.length-i];
p: PROC RETURNS[c: CHAR] ~ { c _ text[i]; i _ i+1 };
RETURN[Rope.FromProc[len, p]];
};
ENDCASE => ERROR Imager.Error[$MustBeRopeOrRefText];
};

ShowCharacters: PROC[context: Context, characters: REF, start: INT, length: INT] ~ {
data: Data ~ NARROW[context.data];
rope: ROPE ~ RopeFromCharacters[characters, start, length];
command: Command ~ NEW[CommandRep[ShowCharacters] _ [
ShowCharacters[rope: rope]]];
Append[data, command];
};

CorrectMask: PROC[context: Context] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[CorrectMask] _ [
CorrectMask[]]];
Append[data, command];
};

CorrectSpace: PROC[context: Context, x, y: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[CorrectSpace] _ [
CorrectSpace[x: x, y: y]]];
Append[data, command];
};

SetCorrectMeasure: PROC[context: Context, x, y: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetCorrectMeasure] _ [
SetCorrectMeasure[x: x, y: y]]];
Append[data, command];
};

SetCorrectTolerance: PROC [context: Context, x, y: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SetCorrectTolerance] _ [
SetCorrectTolerance[x: x, y: y]]];
Append[data, command];
};

Space: PROC [context: Context, x: REAL] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[Space] _ [
Space[x: x]]];
Append[data, command];
};

SpaceI: PROC [context: Context, x: INTEGER] ~ {
data: Data ~ NARROW[context.data];
command: Command ~ NEW[CommandRep[SpaceI] _ [
SpaceI[x: x]]];
Append[data, command];
};

Correct: PROC[context: Context, body: PROC] ~ {
data: Data ~ NARROW[context.data];
list: CommandList ~ GetListFromBody[data, body];
command: Command ~ NEW[CommandRep[Correct] _ [Correct[body: list]]];
Append[data, command];
};

listClass: Imager.Class ~ NEW[Imager.ClassRep _ [
deviceType: $List,
Init: Init,
DoSave: DoSave,
DoSaveAll: DoSaveAll,
SetPriorityImportant: SetPriorityImportant,
ConcatT: ConcatT,
ScaleT: ScaleT,
Scale2T: Scale2T,
RotateT: RotateT,
TranslateT: TranslateT,
Move: Move,
Trans: Trans,
SetXY: SetXY,
SetXYI: SetXYI,
SetXYRel: SetXYRel,
SetXYRelI: SetXYRelI,
MaskFill: MaskFill,
SetStrokeWidth: SetStrokeWidth,
SetStrokeEnd: SetStrokeEnd,
MaskStroke: MaskStroke,
MaskStrokeClosed: MaskStrokeClosed,
MaskVector: MaskVector,
MaskVectorI: MaskVectorI,
MaskRectangle: MaskRectangle,
MaskRectangleI: MaskRectangleI,
StartUnderline: StartUnderline,
MaskUnderline: MaskUnderline,
MaskUnderlineI: MaskUnderlineI,
MaskPixel: MaskPixel,
SetNoImage: SetNoImage,
SetGray: SetGray,
SetColor: SetColor,
SetSampledColor: SetSampledColor,
SetSampledBlack: SetSampledBlack,
ClipOutline: ClipOutline,
ExcludeOutline: ExcludeOutline,
ClipRectangle: ClipRectangle,
ClipRectangleI: ClipRectangleI,
ExcludeRectangle: ExcludeRectangle,
ExcludeRectangleI: ExcludeRectangleI,
SetFont: SetFont,
ShowChar: ShowChar,
ShowCharacters: ShowCharacters,
CorrectMask: CorrectMask,
CorrectSpace: CorrectSpace,
SetCorrectMeasure: SetCorrectMeasure,
SetCorrectTolerance: SetCorrectTolerance,
SetCorrectShrink: SetCorrectShrink,
SetAmplifySpace: SetAmplifySpace,
Space: Space,
SpaceI: SpaceI,
Correct: Correct
]];

<<ImagerPrivate.RegisterDevice[interpressClass];>>

END.