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.