DIRECTORY
Imager USING [ClassRep, Context, ContextRep],
ImagerBackdoor USING [IntKey, RealKey],
ImagerColorDefs USING [Color, ColorOperator, ConstantColor],
ImagerColorPrivate USING [ConstantColorImplRep],
ImagerFont USING [Font, MapText, XChar, XStringProc],
ImagerPath USING [ArcToProc, ConicToProc, CurveToProc, Filter, LineToProc, MoveToProc, PathProc],
ImagerPixelArray USING [PixelArray],
ImagerPrivate USING [Class, ClassRep],
ImagerToJaM USING [],
ImagerTransformation USING [Factor, FactoredTransformation, Rectangle, Scale, Transformation],
IO USING [Close, int, PutChar, PutF, PutRope, real, refAny, rope, STREAM],
Rope USING [ROPE],
Vector2 USING [VEC];
~
BEGIN
Rectangle: TYPE ~ ImagerTransformation.Rectangle;
PixelArray: TYPE ~ ImagerPixelArray.PixelArray;
RealKey: TYPE ~ ImagerBackdoor.RealKey;
IntKey: TYPE ~ ImagerBackdoor.IntKey;
Transformation: TYPE ~ ImagerTransformation.Transformation;
Font: TYPE ~ ImagerFont.Font;
Color: TYPE ~ ImagerColorDefs.Color;
VEC: TYPE ~ Vector2.VEC;
PathProc: TYPE ~ ImagerPath.PathProc;
ColorOperator: TYPE ~ ImagerColorDefs.ColorOperator;
Context:
TYPE ~ Imager.Context;
Class: TYPE ~ ImagerPrivate.Class;
ClassRep:
PUBLIC
TYPE ~ ImagerPrivate.ClassRep;
-- export to Imager.ClassRep
ConstantColorImpl: TYPE ~ REF ConstantColorImplRep;
ConstantColorImplRep:
PUBLIC
TYPE ~ ImagerColorPrivate.ConstantColorImplRep;
-- export to ImagerColorDefs.ConstantColorImplRep
firstIPForm: NAT ~ 100;
endIPForm: NAT ~ 1000;
Data: TYPE ~ REF DataRep;
DataRep:
TYPE ~
RECORD [
stream: IO.STREAM,
id: ROPE ← NIL,
getTDone: BOOL ← FALSE,
getTForm: NAT ← firstIPForm,
nest: INT ← 0
];
Create:
PUBLIC
PROC [stream:
IO.
STREAM, id:
ROPE ←
NIL]
RETURNS [context: Context] ~ {
data: Data ~
NEW[DataRep ← [
stream: stream,
id: id,
nest: 0
]];
context ← NEW[Imager.ContextRep ← [class: class, state: NIL, data: data, propList: NIL]];
};
Close:
PUBLIC
PROC [context: Context] ~ {
WITH context.data
SELECT
FROM
data: Data => {
Newline[data];
IO.Close[data.stream];
};
ENDCASE => NULL;
};
Newline:
PROC [data: Data] ~ {
IO.PutChar[data.stream, '\n];
FOR i:
INT
IN [0..data.nest)
DO
IO.PutChar[data.stream, '\t];
ENDLOOP;
};
OpenCurly:
PROC [data: Data] ~ {
IO.PutChar[data.stream, '{];
data.nest ← data.nest + 1;
};
CloseCurly:
PROC [data: Data] ~ {
IO.PutChar[data.stream, '}];
data.nest ← data.nest - 1;
};
JaMOp:
PROC [data: Data, name:
ROPE, newline:
BOOL ←
TRUE] ~ {
IO.PutRope[data.stream, name];
IF newline THEN Newline[data] ELSE IO.PutChar[data.stream, ' ];
};
ImagerOp:
PROC [data: Data, name:
ROPE, newline:
BOOL ←
TRUE] ~ {
IO.PutRope[data.stream, data.id];
IO.PutRope[data.stream, name];
IF newline THEN Newline[data] ELSE IO.PutChar[data.stream, ' ];
};
JaMInt:
PROC [data: Data, int:
INT] ~ {
IO.PutF[data.stream, "%g ", IO.int[int]];
};
JaMReal:
PROC [data: Data, real:
REAL] ~ {
IO.PutF[data.stream, "%g ", IO.real[real]];
};
DoSave:
PROC [context: Context, action:
PROC, all:
BOOL] ~ {
data: Data ~ NARROW[context.data];
OpenCurly[data];
action[];
Newline[data];
CloseCurly[data];
JaMOp[data, ".cvx", FALSE];
ImagerOp[data, IF all THEN ".dosaveall" ELSE ".dosave"];
};
MySetInt:
PROC [context: Context, key: IntKey, val:
INT] ~ {
data: Data ~ NARROW[context.data];
JaMInt[data, val];
ImagerOp[data,
SELECT key
FROM
priorityImportant => ".setpriorityimportant",
noImage => ".setnoimage",
strokeEnd => ".setstrokeend",
strokeJoint => ".setstrokejoint",
correctPass => ".setcorrectpass",
ENDCASE => ".?"];
};
MySetReal:
PROC [context: Context, key: RealKey, val:
REAL] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, val];
ImagerOp[data,
SELECT key
FROM
DCScpx => ".setdcscpx",
DCScpy => ".setdcscpy",
mediumXSize => ".setmediumxsize",
mediumYSize => ".setmediumysize",
fieldXMin => ".setfieldxmin",
fieldYMin => ".setfieldymin",
fieldXMax => ".setfieldxmax",
fieldYMax => ".setfieldymax",
strokeWidth => ".setstrokewidth",
underlineStart => ".setunderlinestart",
amplifySpace => ".setamplifyspace",
correctShrink => ".setcorrectshrink",
correctMX => ".setcorrectmx",
correctMY => ".setcorrectmy",
correctTX => ".setcorrecttx",
correctTY => ".setcorrectty",
ENDCASE => ".?"];
};
MySetT:
PROC [context: Context, m: Transformation] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, m.a];
JaMReal[data, m.b];
JaMReal[data, m.c];
JaMReal[data, m.d];
JaMReal[data, m.e];
JaMReal[data, m.f];
ImagerOp[data, ".sett"];
};
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) = endIPForm THEN data.getTForm ← firstIPForm;
};
m.form ← data.getTForm;
RETURN [m];
};
PutTransformation:
PROC [context: Context, m: Transformation] ~ {
data: Data ~ NARROW[context.data];
f: ImagerTransformation.FactoredTransformation ~ ImagerTransformation.Factor[m];
n: INT ← 0;
IF f.r1 # 0.0
THEN {
JaMReal[data, f.r1];
ImagerOp[data, ".rotate", FALSE];
n ← n + 1;
};
IF f.s.x # 1.0
OR f.s.y # 1.0
THEN {
IF f.s.x = f.s.y THEN {JaMReal[data, f.s.x]; ImagerOp[data, ".scale", FALSE]}
ELSE {JaMReal[data, f.s.x]; JaMReal[data, f.s.y]; ImagerOp[data, ".scale2", FALSE]};
n ← n + 1;
};
IF f.r2 # 0.0
THEN {
JaMReal[data, f.r2];
ImagerOp[data, ".rotate", FALSE];
n ← n + 1;
};
IF f.t.x # 0.0
OR f.t.y # 0.0
THEN {
JaMReal[data, f.t.x];
JaMReal[data, f.t.y];
ImagerOp[data, ".translate", FALSE];
n ← n + 1;
};
IF n = 0 THEN {JaMReal[data, 1]; ImagerOp[data, ".scale"]; n ← 1};
WHILE n > 1
DO
ImagerOp[data, ".concat", FALSE];
n ← n - 1;
ENDLOOP;
};
MySetFont:
PROC [context: Context, font: Font] ~ {
data: Data ~ NARROW[context.data];
IO.PutF[data.stream, "\"%g\" ", IO.rope[font.name]];
ImagerOp[data, ".findfont", FALSE];
PutTransformation[context, font.charToClient];
ImagerOp[data, ".modifyfont", FALSE];
ImagerOp[data, ".setfont"];
};
MySetColor:
PROC [context: Context, color: Color] ~ {
data: Data ~ NARROW[context.data];
WITH color
SELECT
FROM
c: ImagerColorDefs.ConstantColor => {
impl: ConstantColorImpl ~ c.impl;
WITH impl
SELECT
FROM
stipple:
REF ConstantColorImplRep.stipple => {
JaMInt[data, stipple.word];
SELECT stipple.function
FROM
replace => ImagerOp[data, ".setstipple"];
invert => ImagerOp[data, ".setstippleinvert"];
paint => ImagerOp[data, ".setstipplepaint"];
erase => ImagerOp[data, ".setstippleerase"];
ENDCASE => ERROR;
RETURN;
};
gray:
REF ConstantColorImplRep.gray => {
JaMReal[data, gray.f];
ImagerOp[data, ".setgray"];
RETURN;
};
rgb:
REF ConstantColorImplRep.rgb => {
JaMReal[data, rgb.val.R];
JaMReal[data, rgb.val.G];
JaMReal[data, rgb.val.B];
ImagerOp[data, ".rgbcolor", FALSE];
ImagerOp[data, ".setcolor"];
RETURN;
};
cie:
REF ConstantColorImplRep.cie => {
JaMReal[data, cie.val.X];
JaMReal[data, cie.val.Y];
JaMReal[data, cie.val.Z];
ImagerOp[data, ".setciecolor"];
RETURN;
};
ENDCASE => NULL;
};
ENDCASE => NULL;
IO.PutF[data.stream, "(((%g))) ", IO.refAny[color]];
ImagerOp[data, ".setcolor"];
};
MyConcatT:
PROC [context: Context, m: Transformation] ~ {
data: Data ~ NARROW[context.data];
PutTransformation[context, m];
ImagerOp[data, ".concatt"];
};
MyScale2T:
PROC [context: Context, s:
VEC] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, s.x];
JaMReal[data, s.y];
ImagerOp[data, ".scalet"];
};
MyRotateT:
PROC [context: Context, a:
REAL] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, a];
ImagerOp[data, ".rotatet"];
};
MyTranslateT:
PROC [context: Context, t:
VEC] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, t.x];
JaMReal[data, t.y];
ImagerOp[data, ".translatet"];
};
Move:
PROC [context: Context, rounded:
BOOL] ~ {
data: Data ~ NARROW[context.data];
IF rounded THEN ImagerOp[data, IF rounded THEN ".trans" ELSE ".move"]
};
MySetXY:
PROC [context: Context, p:
VEC] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, p.x];
JaMReal[data, p.y];
ImagerOp[data, ".setxy"];
};
MySetXYRel:
PROC [context: Context, v:
VEC] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, v.x];
JaMReal[data, v.y];
ImagerOp[data, ".setxyrel"];
};
MyShow:
PROC [context: Context, string: ImagerFont.XStringProc, xrel:
BOOL] ~ {
data: Data ~ NARROW[context.data];
instring: BOOL ← FALSE;
Close:
PROC ~ {
IF instring
THEN {
IO.PutChar[data.stream, '"];
IO.PutChar[data.stream, ' ];
ImagerOp[data, ".show"];
instring ← FALSE;
};
};
xCharProc:
PROC [char: ImagerFont.XChar] ~ {
IF char.set # 0
THEN {
Close[];
JaMInt[data, char.set];
JaMInt[data, char.code];
ImagerOp[data, ".showxchar"];
}
ELSE {
IF
NOT instring
THEN {
IO.PutChar[data.stream, '"];
instring ← TRUE;
};
IF char.code
IN [
ORD[' ]..
ORD['~]]
AND char.code #
ORD['\\]
AND char.code #
ORD['"]
THEN {
IO.PutChar[data.stream, VAL[char.code]];
}
ELSE {
IO.PutF[data.stream, "\\%03B", IO.int[char.code]];
};
};
};
string[xCharProc];
Close[];
};
MyShowText:
PROC [context: Context, text:
REF
READONLY
TEXT, start, len:
NAT, xrel:
BOOL] ~ {
string: ImagerFont.XStringProc ~ { ImagerFont.MapText[text, start, len, charAction] };
MyShow[context, string, xrel];
};
MyStartUnderline:
PROC [context: Context] ~ {
data: Data ~ NARROW[context.data];
ImagerOp[data, ".startunderline"];
};
MyMaskUnderline:
PROC [context: Context, dy, h:
REAL] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, dy];
JaMReal[data, h];
ImagerOp[data, ".maskunderline"];
};
MyCorrectMask:
PROC [context: Context] ~ {
data: Data ~ NARROW[context.data];
ImagerOp[data, ".correctmask"];
};
MyCorrectSpace:
PROC [context: Context, v:
VEC] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, v.x];
JaMReal[data, v.y];
ImagerOp[data, ".correctmask"];
};
MySpace:
PROC [context: Context, x:
REAL] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, x];
ImagerOp[data, ".space"];
};
MySetCorrectMeasure:
PROC [context: Context, v:
VEC] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, v.x];
JaMReal[data, v.y];
ImagerOp[data, ".setcorrectmeasure"];
};
MySetCorrectTolerance:
PROC [context: Context, v:
VEC] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, v.x];
JaMReal[data, v.y];
ImagerOp[data, ".setcorrecttolerance"];
};
MyCorrect:
PROC [context: Context, action:
PROC] ~ {
data: Data ~ NARROW[context.data];
OpenCurly[data];
action[];
Newline[data];
CloseCurly[data];
JaMOp[data, ".cvx", FALSE];
ImagerOp[data, ".correct"];
};
MySetGray:
PROC [context: Context, f:
REAL] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, f];
ImagerOp[data, ".setgray"];
};
MySetSampledColor:
PROC [context: Context, pa: PixelArray,
m: Transformation, colorOperator: ColorOperator] ~ {
data: Data ~ NARROW[context.data];
ImagerOp[data, ".unimplementedSetSampledColor"];
};
MySetSampledBlack:
PROC [context: Context, pa: PixelArray,
m: Transformation, clear:
BOOL] ~ {
data: Data ~ NARROW[context.data];
ImagerOp[data, ".unimplementedSetSampledColor"];
};
JaMPath:
PROC [data: Data, path: PathProc, close:
PROC] ~ {
moveTo: ImagerPath.MoveToProc ~ {
JaMReal[data, p.x];
JaMReal[data, p.y];
ImagerOp[data, ".moveto"];
};
lineTo: ImagerPath.LineToProc ~ {
JaMReal[data, p1.x];
JaMReal[data, p1.y];
ImagerOp[data, ".lineto"];
};
curveTo: ImagerPath.CurveToProc ~ {
JaMReal[data, p1.x];
JaMReal[data, p1.y];
JaMReal[data, p2.x];
JaMReal[data, p2.y];
JaMReal[data, p3.x];
JaMReal[data, p3.y];
ImagerOp[data, ".curveto"];
};
conicTo: ImagerPath.ConicToProc ~ {
JaMReal[data, p1.x];
JaMReal[data, p1.y];
JaMReal[data, p2.x];
JaMReal[data, p2.y];
JaMReal[data, r];
ImagerOp[data, ".conicto"];
};
arcTo: ImagerPath.ArcToProc ~ {
JaMReal[data, p1.x];
JaMReal[data, p1.y];
JaMReal[data, p2.x];
JaMReal[data, p2.y];
ImagerOp[data, ".arcto"];
};
ImagerPath.Filter[path: path, moveTo: moveTo, lineTo: lineTo,
curveTo: curveTo, conicTo: conicTo, arcTo: arcTo, close: close];
};
JaMOutline:
PROC [data: Data, path: PathProc, oddWrap:
BOOL] ~ {
nTrajectories: INT ← 0;
close: PROC ~ { nTrajectories ← nTrajectories+1 };
JaMPath[data, path, close];
JaMInt[data, nTrajectories];
ImagerOp[data, IF oddWrap THEN ".makeoutlineodd" ELSE ".makeoutline"];
};
MyMaskFill:
PROC [context: Context, path: PathProc, oddWrap:
BOOL] ~ {
data: Data ~ NARROW[context.data];
JaMOutline[data, path, oddWrap];
ImagerOp[data, ".maskfill"];
};
MyMaskRectangle:
PROC [context: Context, r: Rectangle] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, r.x];
JaMReal[data, r.y];
JaMReal[data, r.w];
JaMReal[data, r.h];
ImagerOp[data, ".maskrectangle"];
};
MyMaskRectangleI:
PROC [context: Context, x, y, w, h:
INTEGER] ~ {
data: Data ~ NARROW[context.data];
JaMInt[data, x];
JaMInt[data, y];
JaMInt[data, w];
JaMInt[data, h];
ImagerOp[data, ".maskrectangle"];
};
MyMaskStroke:
PROC [context: Context, path: PathProc, closed:
BOOL] ~ {
data: Data ~ NARROW[context.data];
close: PROC ~ { ImagerOp[data, IF closed THEN ".maskstrokeclosed" ELSE ".maskstroke"] };
JaMPath[data, path, close];
};
MyMaskVector:
PROC [context: Context, p1, p2:
VEC] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, p1.x];
JaMReal[data, p1.y];
JaMReal[data, p2.x];
JaMReal[data, p2.y];
ImagerOp[data, ".maskvector"];
};
MyMaskDashedStroke:
PROC [context: Context, path: PathProc,
patternLen:
NAT, pattern:
PROC [
NAT]
RETURNS [
REAL], offset, length:
REAL] ~ {
data: Data ~ NARROW[context.data];
close:
PROC ~ {
IO.PutRope[data.stream, "[ "];
FOR i: NAT IN[0..patternLen) DO JaMReal[data, pattern[i]] ENDLOOP;
IO.PutRope[data.stream, "] "];
JaMReal[data, offset];
JaMReal[data, length];
ImagerOp[data, ".maskdashedstroke"];
};
JaMPath[data, path, close];
};
MyMaskPixel:
PROC [context: Context, pa: PixelArray] ~ {
data: Data ~ NARROW[context.data];
ImagerOp[data, ".unimplementedMaskPixel"];
};
MyMaskBits:
PROC [context: Context, base:
LONG
POINTER, wordsPerLine:
NAT,
sMin, fMin, sSize, fSize:
NAT, tx, ty:
INTEGER] ~ {
data: Data ~ NARROW[context.data];
ImagerOp[data, ".unimplementedMaskBits"];
};
MyClip:
PROC [context: Context, path: PathProc, oddWrap:
BOOL, exclude:
BOOL] ~ {
data: Data ~ NARROW[context.data];
JaMOutline[data, path, oddWrap];
IF exclude THEN ImagerOp[data, ".excludeoutline"] ELSE ImagerOp[data, ".clipoutline"];
};
MyClipRectangle:
PROC [context: Context, r: Rectangle, exclude:
BOOL] ~ {
data: Data ~ NARROW[context.data];
JaMReal[data, r.x];
JaMReal[data, r.y];
JaMReal[data, r.w];
JaMReal[data, r.h];
ImagerOp[data, ".cliprectangle"];
};
MyClipRectangleI:
PROC [context: Context, x, y, w, h:
INTEGER, exclude:
BOOL] ~ {
data: Data ~ NARROW[context.data];
JaMInt[data, x];
JaMInt[data, y];
JaMInt[data, w];
JaMInt[data, h];
ImagerOp[data, ".cliprectangle"];
};
class: Class ~
NEW [ClassRep ← [
type: $JaM,
DoSave: DoSave,
SetInt: MySetInt,
SetReal: MySetReal,
SetT: MySetT,
SetFont: MySetFont,
SetColor: MySetColor,
SetClipper: NIL,
GetInt: NIL,
GetReal: NIL,
GetT: MyGetT,
GetFont: NIL,
GetColor: NIL,
GetClipper: NIL,
ConcatT: MyConcatT,
Scale2T: MyScale2T,
RotateT: MyRotateT,
TranslateT: MyTranslateT,
Move: Move,
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: NIL,
SetGray: MySetGray,
SetSampledColor: MySetSampledColor,
SetSampledBlack: MySetSampledBlack,
MaskFill: MyMaskFill,
MaskStroke: MyMaskStroke,
MaskRectangle: MyMaskRectangle,
MaskRectangleI: MyMaskRectangleI,
MaskVector: MyMaskVector,
MaskDashedStroke: MyMaskDashedStroke,
MaskPixel: MyMaskPixel,
MaskBits: MyMaskBits,
Clip: MyClip,
ClipRectangle: MyClipRectangle,
ClipRectangleI: MyClipRectangleI,
GetCP: NIL,
GetBoundingRectangle: NIL,
propList: NIL
]];