JunoImagerTest.mesa
Last Edited by: Stolfi, June 5, 1984 2:41:05 am PDT

Tests Imager stuff for Juno.

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];

JunoImagerTest: CEDAR PROGRAM

IMPORTS

Font,
Imager,
ViewerOps,
ImagerBridge,
Graphics,
ImagerPD,
ImagerPixelMaps,
Rope,
Real

=

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;

- - - - INITIALIZATION:

DrawPoint: PUBLIC PROC[pix: Coords] =

BEGIN

dim: REAL = MAX [1, currentWidth];
Im.MaskRectangle[ctx, pix.x-dim, pix.y-dim, dim+dim, dim+dim]

END;

- - - - LINES, STROKES, FILLED PATHS

DrawEdge: PUBLIC PROC [p, q: Coords, thin: BOOLTRUE] =

BEGIN

Im.MaskVector [context: ctx, p1: [p.x, p.y], p2: [q.x, q.y],
strokeWidth: IF thin THEN 0 ELSE Im.defaultStrokeWidth]

END;

DrawArc: PUBLIC PROC [p, r, s, q: Coords, thin: BOOLTRUE] =

BEGIN

Im.MaskStroke [context: ctx, t: Im.MoveTo[p].CurveTo[r, s, q],
strokeWidth: IF thin THEN 0 ELSE Im.defaultStrokeWidth]

END;

AppendEdge: PUBLIC PROC [t: Trajectory, p, q: Coords] RETURNS [new: Trajectory] =

BEGIN

IF t = NIL THEN t ← Im.MoveTo[p];
new ← t.LineTo[q];

END;

AppendArc: PUBLIC PROC [t: Trajectory, p, r, s, q: Coords] RETURNS [new: Trajectory] =

BEGIN

IF t = NIL THEN t ← Im.MoveTo[p];
new ← t.CurveTo[r, s, q];

END;

FillTrajectory: PUBLIC PROC [t: Trajectory] =

BEGIN

Im.MaskFill[ctx, t]

END;

StrokeTrajectory: PUBLIC PROC [t: Trajectory] =

BEGIN

Im.MaskStroke[ctx, t]

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 PROCNEW [PROCNIL];

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]

END.