DIRECTORY
Font USING [WidthVector],
ViewerClasses USING [Viewer, PaintProc, ViewerClass, ViewerClassRec],
ViewerOps USING [RegisterViewerClass, CreateViewer, PaintViewer],
Imager,
Rope USING [Length, ROPE, ActionType, Cat, Map, Equal],
Real,
Graphics USING [Path, NewPath, MoveTo, LineTo, CurveTo, DrawStroke, SetPaintMode],
ImagerPixelMaps USING [PixelMap, Create, Clear],
ImagerBridge USING [SetViewFromGraphicsContext],
ImagerBasic USING [ColorRep],
ImagerPD USING [PDFileDescription, Raven, Puffin, PlateMaker];
BEGIN
OPEN
Gr: Graphics,
Im: Imager,
ImBas: ImagerBasic,
ImMaps: ImagerPixelMaps,
ImPD: ImagerPD;
Color: TYPE = Im.Color;
Coords: TYPE = Im.Pair;
Trajectory: TYPE = Im.Trajectory;
ROPE: TYPE = Rope.ROPE;
bm: REF ImMaps.PixelMap ← NIL; -- Internal bitmap (screen buffer)
bmCtx: Im.Context; -- A context that paints into bm. Origin at bottom left, 1 dot/unit
ctx: Im.Context ← NIL; -- Either bmCtx or a PD context (or NIL at first).
SetScreenContext:
PUBLIC
PROC [width, height:
INTEGER ← 0] =
Important: initialization call must give width # 0, height # 0.
BEGIN
IF width = 0 THEN width ← bm.fSize;
IF height = 0 THEN height ← bm.sSize;
IF bm=NIL OR width # bm.fSize OR height # bm.sSize THEN
{bm ← NEW [ImMaps.PixelMap ← ImMaps.Create
[lgBitsPerPixel: 0,
bounds:[sMin:0, fMin:0, sSize: height, fSize: width]]];
bmCtx ← Im.Create[deviceType: $LFDisplay -- , data: bm --]};
ctx ← bmCtx;
ImMaps.Clear[bm^];
ResetContextProps[width: 0, color: invert]
END;
SetPaperContext:
PUBLIC
PROC
[device:
ATOM, fileName: Rope.
ROPE, width, height:
INTEGER, mag:
REAL ← 1.0] =
BEGIN
ctx ← Im.Create[$PD, SELECT device FROM
$Raven => ImPD.Raven[fileName],
$Puffin => ImPD.Puffin[fileName],
$PlateMaker => ImPD.PlateMaker[fileName],
ENDCASE => ERROR];
ResetContextProps[width: 0.4, color: black, mag: mag];
Im.ClipRectangle[ctx, 0, 0, width, height]
END;
ResetContextProps:
PROC [width:
REAL, color: Color, mag:
REAL ← 1.0] =
BEGIN
Im.ScaleT[ctx, 0.0254/72/mag];
Im.SetPriorityImportant[ctx, TRUE];
DoSetFont[ctx: ctx, name: "TimesRoman", face: $regular, size: 10];
[] ← SetEnds[$round];
[] ← SetColor[color];
[] ← SetWidth[width];
[] ← SetJustification[$left]
END;
currentColor: Color ← Im.black;
SetColor:
PUBLIC
PROC [color: Color]
RETURNS [old: Color] =
BEGIN
old ← currentColor;
Im.SetColor[ctx, color];
currentColor ← color
END;
invert: Color ← Im.XOR;
black: Color ← Im.black;
white: Color ← Im.white;
IntensityToColor:
PUBLIC
PROC [intensity:
REAL]
RETURNS [color: Color] =
BEGIN
color ← Im.MakeGray[intensity]
END;
RGBToColor:
PUBLIC
PROC [r, g, b:
REAL]
RETURNS [color: Color] =
BEGIN
color ← NEW [ImBas.ColorRep[constant] ←
[constant[x: Real.RoundI[r*10000],
y: Real.RoundI[g*10000],
Y: Real.RoundI[b*10000]]]]
END;
currentEnds: ATOM ← $round;
SetEnds:
PUBLIC
PROC [ends:
ATOM]
RETURNS [old:
ATOM] =
BEGIN
old ← currentEnds;
Im.SetStrokeEnd
[ctx,
SELECT ends FROM
$round => round,
$square => square,
$butt => butt,
ENDCASE => ERROR];
currentEnds ← ends
END;
currentWidth: REAL ← 0;
SetWidth:
PUBLIC
PROC [width:
REAL]
RETURNS [old:
REAL] =
BEGIN
old ← currentWidth;
Im.SetStrokeWidth [ctx, width];
currentWidth ← width
END;
currentFont: Im.FONT;
currentFontName: ROPE ← "Helvetica";
currentSize: REAL ← 12;
currentFace: ATOM ← $regular;
SetFont:
PUBLIC
PROC [name:
ROPE]
RETURNS [old:
ROPE] =
BEGIN
old ← currentFontName;
IF NOT Rope.Equal[currentFontName, name] THEN
{DoSetFont [ctx, name, currentFace, currentSize]}
END;
SetFontSize:
PUBLIC
PROC [size:
REAL]
RETURNS [old:
REAL] =
BEGIN
old ← currentSize;
IF currentSize # size THEN
{DoSetFont [ctx, currentFontName, currentFace, size]}
END;
SetFace:
PUBLIC
PROC [face:
ATOM]
RETURNS [old:
ATOM] =
BEGIN
old ← currentFace;
IF currentFace # face THEN
{DoSetFont [ctx, currentFontName, face, currentSize]}
END;
DoSetFont:
PROC [ctx: Im.Context, name:
ROPE, face:
ATOM, size:
REAL] =
BEGIN
currentFont ← Im.MakeFont
[name: Rope.Cat["Xerox/PressFonts/", name,
SELECT face FROM
$regular => "/MRR",
$italic => "/MIR",
$bold => "/BRR",
$boldItalic => "/BIR",
ENDCASE => ERROR], size: size];
currentFontName ← name;
currentFace ← face;
currentSize ← size;
Im.SetFont [ctx, currentFont]
END;
currentJustification: ATOM ← $left;
SetJustification:
PUBLIC
PROC [justification:
ATOM]
RETURNS [old:
ATOM] =
BEGIN
old ← currentJustification;
currentJustification ← justification
END;
- - - - CHARS AND ROPES
DrawChar:
PUBLIC
PROC [coords: Coords, char:
CHAR] =
BEGIN
Im.SetXY[ctx, coords];
Im.ShowChar[ctx, char]
END;
DrawRope:
PUBLIC
PROC [coords: Coords, rope:
ROPE] =
BEGIN
lft: Im.Pair;
IF currentJustification = $left THEN
{lft ← coords}
ELSE
{vec: Im.Pair ← [0,0];
{Act: Rope.ActionType = TRUSTED
{w: Im.Pair =Font.WidthVector[currentFont, c];
vec ← [vec.x+w.x, vec.y+w.y]};
[] ← Rope.Map[base: rope, len: rope.Length[], action: Act]};
lft.x ← coords.x - (IF currentJustification = $right THEN vec.x ELSE vec.x/2);
lft.y ← coords.y - (IF currentJustification = $right THEN vec.y ELSE vec.y/2)};
Im.SetXY[ctx, lft];
Im.ShowCharacters[ctx, rope]
END;
prc: REF PROC ← NEW [PROC ← NIL];
Do:
PROC [prc:
REF
PROC] =
Performs Proc while attching ctx to the viewer vv
BEGIN
ViewerOps.PaintViewer[viewer: vv, hint: client, clearClient: FALSE, whatChanged: prc]
END;
PaintMe: ViewerClasses.PaintProc =
BEGIN
IF whatChanged = $TestGraphics THEN
{path: Gr.Path ← Gr.NewPath[];
Gr.MoveTo[path, 400, 600];
Gr.LineTo[path, 400, 500];
Gr.LineTo[path, 500, 500];
Gr.CurveTo[path, 450, 500, 400, 450, 400, 400];
[] ← Gr.SetPaintMode[self: context, mode: invert];
Gr.DrawStroke[self: context, path: path, width: 15, ends: round]}
ELSE IF whatChanged # NIL THEN
{Proc: REF PROC = NARROW [whatChanged];
ImagerBridge.SetViewFromGraphicsContext [imager: bmCtx, graphics: context];
Proc^[]}
END;
vc: ViewerClasses.ViewerClass = NEW [ViewerClasses.ViewerClassRec ← [paint: PaintMe]];
vv: ViewerClasses.Viewer;
t: Trajectory ← NIL;
ViewerOps.RegisterViewerClass[flavor: $Crap, class: vc];
vv ← ViewerOps.CreateViewer[flavor: $Crap, info: [iconic:FALSE, name:"Crap"]];
SetScreenContext[width: 600, height: 800];
Do[NEW[PROC ← {DrawEdge[[50,50], [200,200]]}]];
Do[NEW[PROC ← {DrawRope[[250,250], "Fee Fi Foo Fum\n(this is fun...)"]}]];
[] ← SetFontSize[12];
Do[NEW[PROC ← {DrawRope[[300,300], "Fee Fi Foo Fum\n(this is fun...)"]}]];
Do[NEW[PROC ← {DrawPoint[[150, 150]]}]];
[] ← SetWidth[15];
[] ← SetEnds[$round];
t ← AppendEdge[t, [100,300], [100, 200]];
t ← AppendEdge[t, [100,200], [200,200]];
t ← AppendArc [t, [200,200], [150, 200], [100, 150], [100, 100]];
ViewerOps.PaintViewer[viewer: vv, hint: client, whatChanged: $TestGraphics];
[] ← SetColor[IntensityToColor[0.4]];
Do[NEW[PROC ← {FillTrajectory[t]}]];
[] ← SetColor[IntensityToColor[0.8]];
Do[NEW[PROC ← {StrokeTrajectory[t]}]];
{r: INTEGER ← 0;
THROUGH [1..500] DO THROUGH [1..1000] DO r ← r + r - r ENDLOOP ENDLOOP};
SetPaperContext[device: $Raven, width: 600, height: 800, fileName: "ImagerTest.PD"];
DrawEdge[[50,50], [200,200]];
DrawRope[[250,250], "Fee Fi Foo Fum\n(this is fun...)"];
[] ← SetColor[IntensityToColor[0.4]];
FillTrajectory[t];
[] ← SetColor[IntensityToColor[0.8]];
StrokeTrajectory[t];
[] ← Im.SpecialOp[ctx, $Close, NIL]