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

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;

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;

DrawEdge: PUBLIC PROC [p, q: Coords, thin: BOOL _ TRUE] =

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: BOOL _ TRUE] =

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;

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

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.

:
JunoImagerTest.mesa

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

Tests Imager stuff for Juno.
Important: initialization call must give width # 0, height # 0.

- - - - INITIALIZATION:

- - - - LINES, STROKES, FILLED PATHS

- - - - CHARS AND ROPES
Performs Proc while attching ctx to the viewer vv
�ʬ˜š
œ™™J™5—J™—šœ
Ïk	˜
Jšœ�œ�œ=�œ@�œ
�œ‰
�œY�œ�œ0˜ú—šœ
Ïbœ�
˜šœ
�˜Jš
œX˜XJš
œ˜——šœ
�˜šœ
�˜Jš
œW˜W—Jšœ�œ˜Jšœ	�œ˜Jšœ
�œ˜"Jšœ
�œ�œ�œ
˜Jšœ
žœ�œ�œÏc"˜BJšœ
žœŸD˜XJšœ
žœ�œŸ2˜Jš	œ
Ïnœ�œ
�œ�œ˜=J™?šœ
�˜Jš	œ
�œ�œ�œ�œ˜JJš
œ
�œ�œ
�œ�œ�œ±
Ÿœ˜ü
Jš
œK˜K—Jšœ
�œ
˜—šœ
 œ�œ
�œ�œ�œ�œ�œ	˜nšœ
�˜Jš	œ�œ�œv�œ�œd˜’—Jšœ
�œ
˜—š	œ
 œ�œ	�œ�œ	˜Gšœ
�˜Jš
ό
˜å
—Jšœ
�œ
˜—Jš
œ ˜ š	œ
 œ�œ
�œ�œ˜<šœ
�˜Jš
œC˜C—Jšœ
�œ
˜—Jšœ�œ3˜Jšœ
 œ�œ
�œ
�œ�œ˜Išœ
�˜Jš
œ˜—Jšœ
�œ
˜—šœ
 
œ�œ
�œ�œ�œ˜Ašœ
�˜Jšœ	�œb�
œ˜ˆ
—Jšœ
�œ
˜—Jšœ�œ
˜š
œ
 œ�œ
�œ�œ�œ�œ˜8šœ
�˜Jš	œ/�œ�œH�œ�œ˜¬
—Jšœ
�œ
˜—Jšœ�œ˜š
œ
 œ�œ
�œ	�œ�œ�œ˜:šœ
�˜Jš
œI˜I—Jšœ
�œ
˜—Jšœ�œ˜Jšœ�œ˜%Jšœ�œ˜Jšœ�œ˜š
œ
 œ�œ
�œ�œ�œ�œ˜8šœ
�˜Jšœ�œ
�œ#�œ4˜y—Jšœ
�œ
˜—š
œ
 œ�œ
�œ�œ�œ�œ˜<šœ
�˜Jšœ�œ�œ8˜f—Jšœ
�œ
˜—š
œ
 œ�œ
�œ�œ�œ�œ˜8šœ
�˜Jšœ�œ�œ8˜f—Jšœ
�œ
˜—šœ
 	œ�œ�œ�œ�œ˜Hšœ
�˜Jš	œM�œ�œs�œ�œn˜Î—Jšœ
�œ
˜—Jšœ�œ	˜$š
œ
 œ�œ
�œ�œ�œ�œ˜Jšœ
�˜Jš
œA˜A—Jšœ
�œ
˜——š 
œ™šœ
 	œ�œ
�œ˜&šœ
�˜Jšœ�œ�œQ˜a—Jšœ
�œ
˜——š 
œ$™%šœ
 œ�œ
�œ�œ�œ˜:šœ
�˜JšœN�œ�œ�œ˜x—Jšœ
�œ
˜—šœ
 œ�œ
�œ�œ�œ˜?šœ
�˜JšœP�œ�œ�œ˜z—Jšœ
�œ
˜—š	œ
 
œ�œ
�œ�œ˜Ršœ
�˜Jšœ
�œ�œ
�œ%˜5—Jšœ
�œ
˜—š	œ
 	œ�œ
�œ%�œ˜Wšœ
�˜Jšœ
�œ�œ
�œ,˜<—Jšœ
�œ
˜—šœ
 œ�œ
�œ˜.šœ
�˜Jš
œ˜—Jšœ
�œ
˜—šœ
 œ�œ
�œ˜0šœ
�˜Jš
œ˜—Jšœ
�œ
˜——š 
œ™š	œ
 œ�œ
�œ�œ˜5šœ
�˜Jš
œ.˜.—Jšœ
�œ
˜—š	œ
 œ�œ
�œ�œ˜5šœ
�˜Jšœ�œ�œ�œ žœ�œº
�œ�œ�œ"�œ�œ�œ˜ÏJš
œ1˜1—Jšœ
�œ
˜—Jšœ�œ
�œ�œ�œ�œ˜"š	œ
 œ�œ�œ
�œ˜J™1šœ
�˜Jšœ>�œ˜V—Jšœ
�œ
˜—šœ
žœ˜#šœ
�˜Jšœ
�œ�œ¬�œ
�œ�œ
�œ œ�œ
�œ�œj˜ó—Jšœ
�œ
˜—Jšœ!�œc˜‡
Jšœs�œ˜ˆ
Jš
œ+˜+Jšœ�œ
�œ$˜0Jš	œ�œ
�œY�œ
�œ?˜¬
Jšœ�œ
�œ˜)Jš
œ)˜)Jš
ϥ
˜•
Jš
œN˜NJš	œ*�œ
�œC�œ
�œ˜˜
Jšœ�œ�œ
�œ
�œ�œ�œ
�œ˜[JšœÁ�œ
˜Å—Jšœ
�œ
˜—…— ü*â