juno-app/src/PSImpl.m3


 Copyright (C) 1992, Digital Equipment Corporation                         
 All rights reserved.                                                      
 See the file COPYRIGHT for a full description.                            
                                                                           
 Last modified on Thu Mar 28 17:34:10 PST 1996 by heydon                   

MODULE PSImpl;

IMPORT JunoConfig, Drawing, JunoPt, JunoRect, PSFont, JunoRsrc, View;
IMPORT   ExternalProc;
IMPORT JunoScope;
IMPORT JunoRT, RTVal, JunoValue, JunoArgs;
IMPORT VBT, VBTExtras, Filter, PaintOp, Font, Path, Point, Rect, DblBufferVBT;
IMPORT Atom, Rd, Wr, Fmt, Thread, Text, TextRefTbl, Time, Date;
IMPORT   Process, Pickle, Rsrc;
FROM ExternalProc IMPORT Closure, Bind;
FROM Stdio IMPORT stderr;

<* FATAL Thread.Alerted *>

EXCEPTION Error;			 (* internal error *)
<* FATAL Error *>			 (* should never be raised *)

CONST
  MaxCacheSize = 40;  (* # of external procs replaced by StartToFile(). *)
  FindFontProc = "FindFontISO";

TYPE
  ToFileClosure = Closure BRANDED "PSImpl.ToFileClosure" OBJECT
    i: Impl
  END;
  CacheRec = RECORD
    slot: CARDINAL;
    proc: Closure;
  END;

REVEAL
  View.PSImpl = Public BRANDED "View.PSImpl" OBJECT OVERRIDES
    init := Init
  END;

  Impl = ImplPublic BRANDED "PSImpl.Impl" OBJECT
    rt: View.Root;
    wr: Wr.T := NIL;
    extCnt: CARDINAL;
    page: CARDINAL;
    cache: ARRAY [0..MaxCacheSize - 1] OF CacheRec;
  OVERRIDES
    startToFile := StartToFile;
    prologue := Prologue;
    epilogue := Epilogue;
    endToFile := EndToFile;
  END;
StartToFile replaces the external PostScript procedures that change the PostScript state by ToFileClosure objects. For Impl i, the method call i.startToFile(wr) sets i.wr to wr, i.extCnt to the number of replaced external procedures, and stores the replaced procedures and the slots from which they came in i.cache.

PROCEDURE Init(d: T; ch: Drawing.ChildPublic; root: View.Root): T =
  BEGIN
    d.root := root;
    EVAL View.T.init(d, ch);
    d.ps.path := NEW(Path.T);
    d.psStack := NEW(REF ARRAY OF State, 10);
    RETURN d
  END Init;

CONST
  DefaultColor = Color{r := 0.0, g := 0.0, b := 0.0};
  DefaultColorOp = PaintOp.Fg;
  DefaultTextColorOp = PaintOp.TransparentFg;
  DefaultWidth = 1.0;
  DefaultEndStyle = VBT.EndStyle.Butt;
  DefaultJointStyle = VBT.JoinStyle.Miter;
  DefaultWindingStyle = VBT.WindingCondition.NonZero;
  DefaultFaceName = "Times-Roman";
  DefaultFontSize = 4;			 (* PS.Large *)

VAR (* CONST *)
  fontTbl: TextRefTbl.T;
  metricTbl: TextRefTbl.T;
  defaultXFont: Font.T;			 (* cached copy of default X font *)
  defaultXFontPtSize: JunoValue.Real;	 (* cached value of it's point size *)
  defaultPSMetric: PSFont.Metric;	 (* cached metric of default font *)

<* INLINE *>
PROCEDURE ResetPath(VAR (*INOUT*) ps: State) =
  BEGIN
    Path.Reset(ps.path);
    ps.moveto := FALSE
  END ResetPath;

CONST
  PageWidth = 8.5 * 72.0;
  PageHeight = 11.0 * 72.0;
  HalfWidth = PageWidth / 2.0;
  HalfHeight = PageHeight / 2.0;

PROCEDURE DefaultBBox(d: T): JunoRect.T =
  TYPE
    OrientBBox = ARRAY JunoConfig.Orientation OF JunoRect.T;
  CONST
    BBoxSW = OrientBBox{
      JunoRect.T{0.0, PageWidth, PageHeight, 0.0},  (* Portrait *)
      JunoRect.T{0.0, PageHeight, PageWidth, 0.0}}; (* Landscape *)
    BBoxCenter = OrientBBox{
      JunoRect.T{-HalfWidth, HalfWidth, HalfHeight, -HalfHeight},
      JunoRect.T{-HalfHeight, HalfHeight, HalfWidth, -HalfWidth}};
    BBox = ARRAY JunoConfig.Origin OF OrientBBox{BBoxCenter, BBoxSW};
  VAR ch: Drawing.ChildPublic := Filter.Child(d); BEGIN
    RETURN BBox[ch.getOrigin(), JunoConfig.orientation]
  END DefaultBBox;

PROCEDURE Reset(d: T; <*UNUSED*> inExec := TRUE) =
  BEGIN
    WITH ps = d.ps DO
      ps.color := DefaultColor;
      ps.width := DefaultWidth;
      ps.end := DefaultEndStyle;
      ps.join := DefaultJointStyle;
      ps.wind := DefaultWindingStyle;
      ResetPath(ps);
      ps.face := DefaultFaceName;
      ps.size := DefaultFontSize;
      ps.ptSize := defaultXFontPtSize;
      ps.bbox := DefaultBBox(d);
      ps.colorOp := DefaultColorOp;
      ps.textColorOp := DefaultTextColorOp;
      ps.xFont := defaultXFont;
      ps.psMetric := defaultPSMetric
    END
  END Reset;

VAR (*CONST*)
  PSAtom   := Atom.FromText("PS");
  Save     := Atom.FromText("Save");
  Restore  := Atom.FromText("Restore");
  NewPath  := Atom.FromText("NewPath");
  MoveTo   := Atom.FromText("MoveTo");
  LineTo   := Atom.FromText("LineTo");
  CurveTo  := Atom.FromText("CurveTo");
  Close    := Atom.FromText("Close");
  Stroke   := Atom.FromText("Stroke");
  Fill     := Atom.FromText("Fill");
  Type     := Atom.FromText("Type");
  SetWidth := Atom.FromText("SetWidth");
  SetEnd   := Atom.FromText("SetEndStyle");
  SetJoin  := Atom.FromText("SetJointStyle");
  GetWidth := Atom.FromText("GetWidth");
  GetEnd   := Atom.FromText("GetEndStyle");
  GetJoin  := Atom.FromText("GetJointStyle");
  SetColor := Atom.FromText("SetColor");
  SetWind  := Atom.FromText("SetWinding");
  GetColor := Atom.FromText("GetColor");
  GetWind  := Atom.FromText("GetWinding");
  SetFace  := Atom.FromText("SetFontFace");
  SetSize  := Atom.FromText("SetFontSize");
  SetFont  := Atom.FromText("SetFont");
  GetFace  := Atom.FromText("GetFontFace");
  GetSize  := Atom.FromText("GetFontSize");
  GetFont  := Atom.FromText("GetFont");
  GetPtSz  := Atom.FromText("GetFontPtSize");
  FontH    := Atom.FromText("FontHeight");
  StringW  := Atom.FromText("StringWidth");
  StringBB := Atom.FromText("StringBBox");
  CurrPt   := Atom.FromText("CurrentPoint");
  CurrPath := Atom.FromText("CurrentPath");
  SetBBox  := Atom.FromText("SetBBox");
  GetBBox  := Atom.FromText("GetBBox");
  ShowPage := Atom.FromText("ShowPage");
  ResetSym := Atom.FromText("Reset");
  SavePage := Atom.FromText("SavePage");
  RestPage := Atom.FromText("RestorePage");

CONST
  ButtEndsVal    = 0;
  RoundEndsVal   = 1;
  SquareEndsVal  = 2;
  MiterJointsVal = 0;
  RoundJointsVal = 1;
  BevelJointsVal = 2;
  NZWindingVal   = 0;
  OddWindingVal  = 1;

PROCEDURE New(rt: View.Root): Impl =
  VAR
    scp := JunoScope.New(NIL, size := 24);
    res := NEW(Impl, rt := rt, public_scp := scp, scp := scp);
  BEGIN
    ExternalProc.SetupBind(PSAtom, scp, rt);
    Bind(Save,	   NEW(Closure, invoke := SaveProc),	     in := 0);
    Bind(Restore,  NEW(Closure, invoke := RestoreProc),	     in := 0);
    Bind(NewPath,  NEW(Closure, invoke := NewPathProc),	     in := 0);
    Bind(MoveTo,   NEW(Closure, invoke := MoveToProc),	     in := 1);
    Bind(LineTo,   NEW(Closure, invoke := LineToProc),	     in := 1);
    Bind(CurveTo,  NEW(Closure, invoke := CurveToProc),	     in := 3);
    Bind(Close,	   NEW(Closure, invoke := CloseProc),	     in := 0);
    Bind(Fill,	   NEW(Closure, invoke := FillProc),	     in := 0);
    Bind(Stroke,   NEW(Closure, invoke := StrokeProc),	     in := 0);
    Bind(Type,     NEW(Closure, invoke := TypeProc),	     in := 2);
    Bind(SetWidth, NEW(Closure, invoke := SetWidthProc),     in := 1);
    Bind(SetEnd,   NEW(Closure, invoke := SetEndStyleProc),  in := 1);
    Bind(SetJoin,  NEW(Closure, invoke := SetJoinStyleProc), in := 1);
    Bind(SetColor, NEW(Closure, invoke := SetColorProc),     in := 1);
    Bind(SetWind,  NEW(Closure, invoke := SetWindingProc),   in := 1);
    Bind(SetFace,  NEW(Closure, invoke := SetFaceProc),	     in := 1);
    Bind(SetSize,  NEW(Closure, invoke := SetSizeProc),	     in := 1);
    Bind(SetFont,  NEW(Closure, invoke := SetFontProc),	     in := 2);
    Bind(SetBBox,  NEW(Closure, invoke := SetBBoxProc),	     in := 2);
    Bind(ShowPage, NEW(Closure, invoke := ShowPageProc),     in := 0);
    Bind(ResetSym, NEW(Closure, invoke := ResetProc),        in := 0);
    Bind(SavePage, NEW(Closure, invoke := SavePageProc),     in := 0);
    Bind(RestPage, NEW(Closure, invoke := RestorePageProc),  in := 0);
    Bind(GetWidth, NEW(Closure, invoke := GetWidthProc),
      in := 0, out := 1);
    Bind(GetEnd,   NEW(Closure, invoke := GetEndStyleProc),
      in := 0, out := 1);
    Bind(GetJoin,  NEW(Closure, invoke := GetJoinStyleProc),
      in := 0, out := 1);
    Bind(GetColor, NEW(Closure, invoke := GetColorProc),
      in := 0, out := 1);
    Bind(GetWind,  NEW(Closure, invoke := GetWindingProc),
      in := 0, out := 1);
    Bind(GetFace,  NEW(Closure, invoke := GetFaceProc),
      in := 0, out := 1);
    Bind(GetSize,  NEW(Closure, invoke := GetSizeProc),
      in := 0, out := 1);
    Bind(GetFont,  NEW(Closure, invoke := GetFontProc),
      in := 0, out := 2);
    Bind(GetPtSz,  NEW(Closure, invoke := GetPtSizeProc),
      in := 0, out := 1);
    Bind(FontH,    NEW(Closure, invoke := FontHProc),
      in := 0, out := 2);
    Bind(StringW,  NEW(Closure, invoke := StringWProc),
      in := 1, out := 1);
    Bind(StringBB, NEW(Closure, invoke := StringBBProc),
      in := 1, out := 1);
    Bind(CurrPt,  NEW(Closure, invoke := CurrPtProc),
      in := 0, out := 1);
    Bind(CurrPath, NEW(Closure, invoke := CurrPathProc),
      in := 0, out := 1);
    Bind(GetBBox,  NEW(Closure, invoke := GetBBoxProc),
      in := 0, out := 2);
    RETURN res
  END New;

PROCEDURE StartToFile(impl: Impl; wr: Wr.T) =
An implementation of the startToFile method of an Impl.

  PROCEDURE Replace(name: Atom.T; cl: ToFileClosure) =
  (* Store the current external procedure stored under "name" in "impl"'s
     cache, replace it by "cl" in the external code table, and set the "rt"
     and "i" fields of "cl". *)
    VAR p: JunoScope.Proc := JunoScope.Lookup(impl.scp, name); BEGIN
      WITH entry = impl.cache[impl.extCnt] DO
        entry.slot := p.index;
        entry.proc := JunoRT.ext_code_tbl[p.index];
        cl.rt := entry.proc.rt
      END;
      cl.i := impl;
      JunoRT.ext_code_tbl[p.index] := cl;
      INC(impl.extCnt)
    END Replace;

  (* StartToFile *)
  BEGIN
    impl.wr := wr;
    impl.extCnt := 0;
    impl.page := 1;
    Replace(Save,     NEW(ToFileClosure, invoke := SaveProc2));
    Replace(Restore,  NEW(ToFileClosure, invoke := RestoreProc2));
    Replace(NewPath,  NEW(ToFileClosure, invoke := NewPathProc2));
    Replace(MoveTo,   NEW(ToFileClosure, invoke := MoveToProc2));
    Replace(LineTo,   NEW(ToFileClosure, invoke := LineToProc2));
    Replace(CurveTo,  NEW(ToFileClosure, invoke := CurveToProc2));
    Replace(Close,    NEW(ToFileClosure, invoke := CloseProc2));
    Replace(Stroke,   NEW(ToFileClosure, invoke := StrokeProc2));
    Replace(Fill,     NEW(ToFileClosure, invoke := FillProc2));
    Replace(Type,     NEW(ToFileClosure, invoke := TypeProc2));
    Replace(SetWidth, NEW(ToFileClosure, invoke := SetWidthProc2));
    Replace(SetEnd,   NEW(ToFileClosure, invoke := SetEndStyleProc2));
    Replace(SetJoin,  NEW(ToFileClosure, invoke := SetJoinStyleProc2));
    Replace(SetColor, NEW(ToFileClosure, invoke := SetColorProc2));
    Replace(SetFace,  NEW(ToFileClosure, invoke := SetFaceProc2));
    Replace(SetSize,  NEW(ToFileClosure, invoke := SetSizeProc2));
    Replace(SetFont,  NEW(ToFileClosure, invoke := SetFontProc2));
    Replace(FontH,    NEW(ToFileClosure, invoke := FontHProc2));
    Replace(StringW,  NEW(ToFileClosure, invoke := StringWProc2));
    Replace(StringBB, NEW(ToFileClosure, invoke := StringBBProc2));
    Replace(ShowPage, NEW(ToFileClosure, invoke := ShowPageProc2));
    Replace(SavePage, NEW(ToFileClosure, invoke := SavePageProc2));
    Replace(RestPage, NEW(ToFileClosure, invoke := RestorePageProc2));
  END StartToFile;

PROCEDURE Prologue(impl: Impl) RAISES {Wr.Failure} =
  BEGIN
    <* ASSERT impl.wr # NIL *>
    WriteHeader(impl.wr);
    WritePrologue(impl.wr, impl.rt.currView);
    WriteSetup(impl.wr, impl.rt.currView);
    WritePageHeader(impl.wr, impl.page)
  END Prologue;

PROCEDURE WriteHeader(wr: Wr.T) RAISES {Wr.Failure} =
  BEGIN
    Wr.PutText(wr, "%!PS-Adobe-3.0\n");
    Wr.PutText(wr, "%%Creator: Juno-2\n");
    Wr.PutText(wr, "%%Title: Juno.ps\n");
    Wr.PutText(wr, "%%CreationDate: ");
    WriteTime(wr, Time.Now());
    Wr.PutText(wr, "\n%%BoundingBox: (atend)\n");
    Wr.PutText(wr, "%%Pages: (atend)\n");
    Wr.PutText(wr, "%%PageOrder: Ascend\n");
    Wr.PutText(wr, "%%Orientation: "
      & JunoConfig.OrientName[JunoConfig.orientation] & "\n");
    Wr.PutText(wr, "%%EndComments\n");
  END WriteHeader;

PROCEDURE WritePrologue(wr: Wr.T; d: T) RAISES {Wr.Failure} =
  VAR ch: Drawing.ChildPublic := Filter.Child(d); BEGIN
    Wr.PutText(wr, "\n%%BeginPrologue\n");

    (* define "InitializeJunoPage" procedure *)
    Wr.PutText(wr, "% InitializeJunoPage\n%\n");
    Wr.PutText(wr, "% Sets the initial graphics state for a Juno page\n");
    Wr.PutText(wr, "/InitializeJunoPage {\n  ");
    Wr.PutText(wr, Fmt.Real(DefaultColor.r)); Wr.PutChar(wr, ' ');
    Wr.PutText(wr, Fmt.Real(DefaultColor.g)); Wr.PutChar(wr, ' ');
    Wr.PutText(wr, Fmt.Real(DefaultColor.b));
    Wr.PutText(wr, " setrgbcolor\n  ");
    Wr.PutText(wr, Fmt.Real(DefaultWidth));
    Wr.PutText(wr, " setlinewidth\n  ");
    Wr.PutText(wr, Fmt.Int(EndMapInv[DefaultEndStyle]));
    Wr.PutText(wr, " setlinecap\n  ");
    Wr.PutText(wr, Fmt.Int(JoinMapInv[DefaultJointStyle]));
    Wr.PutText(wr, " setlinejoin\n  ");
    Wr.PutText(wr, "10.435 setmiterlimit\n  ");
    (* Wr.PutText(wr, "newpath\n  "); *)
    Wr.PutChar(wr, '/');
    Wr.PutText(wr, DefaultFaceName);
    WriteFindFont(wr);
    Wr.PutText(wr, Fmt.Real(defaultXFontPtSize));
    Wr.PutText(wr, " scalefont setfont\n  ");

    (* Translate and rotate if necessary, based on "ch.getOrigin()" and
       "JunoConfig.orientation". The PostScript variables "xCenter" and
       "yCenter" are set to the coordinate at the center of the page for use
       by the "showerror.ps" code in case a run-time error needs to be
       displayed. *)
    CASE ch.getOrigin() OF
      JunoConfig.Origin.Center =>
      	Wr.PutText(wr, Fmt.Real(HalfWidth));  Wr.PutChar(wr, ' ');
      	Wr.PutText(wr, Fmt.Real(HalfHeight)); Wr.PutChar(wr, ' ');
      	Wr.PutText(wr, "translate\n")
    | JunoConfig.Origin.SW =>
      	IF JunoConfig.orientation = JunoConfig.Orientation.Landscape THEN
      	  Wr.PutText(wr, Fmt.Real(PageWidth));
      	  Wr.PutText(wr, " 0 translate\n")
      	END
    END;
    IF JunoConfig.orientation = JunoConfig.Orientation.Landscape THEN
      Wr.PutText(wr, "  90 rotate\n");
    END;
    Wr.PutText(wr, "} def\n\n");

    (* copy "prologue.ps" file *)
    <* FATAL Rd.Failure, Rd.EndOfFile, Thread.Alerted, Rsrc.NotFound *>
    VAR rd: Rd.T := Rsrc.Open("prologue.ps", JunoRsrc.Path); BEGIN
      (* copy PostScript code to "wr" *)
      WHILE NOT Rd.EOF(rd) DO Wr.PutChar(wr, Rd.GetChar(rd)) END;
      Rd.Close(rd)
    END;
    Wr.PutText(wr, "%%EndPrologue\n")
  END WritePrologue;

PROCEDURE WriteTime(wr: Wr.T; t: Time.T) RAISES {Wr.Failure} =
Writes the time t to wr in the form:
         "Wed, Jun 22, 11:19:40 PDT, 1994".
  CONST
    MonthName = ARRAY OF TEXT{
      "Jan", "Feb", "Mar", "Apr", "May", "Jun",
      "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
    DayName = ARRAY OF TEXT{
      "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
  VAR d: Date.T := Date.FromTime(t); BEGIN
    Wr.PutText(wr, DayName[ORD(d.weekDay)]); Wr.PutText(wr, ", ");
    Wr.PutText(wr, MonthName[ORD(d.month)]); Wr.PutChar(wr, ' ');
    Wr.PutText(wr, Fmt.Int(d.day));          Wr.PutText(wr, ", ");
    Wr.PutText(wr, Fmt.Int(d.hour));         Wr.PutChar(wr, ':');
    Wr.PutText(wr, Fmt.Int(d.minute));       Wr.PutChar(wr, ':');
    Wr.PutText(wr, Fmt.Int(d.second));       Wr.PutChar(wr, ' ');
    Wr.PutText(wr, d.zone);                  Wr.PutText(wr, ", ");
    Wr.PutText(wr, Fmt.Int(d.year))
  END WriteTime;

PROCEDURE WriteFindFont(wr: Wr.T) RAISES {Wr.Failure} =
Writes the name of the findfont procedure to wr surrounded by space characters.
  BEGIN
    Wr.PutChar(wr, ' ');
    Wr.PutText(wr, FindFontProc);
    Wr.PutChar(wr, ' ')
  END WriteFindFont;

PROCEDURE WriteSetup(wr: Wr.T; d: T) RAISES {Wr.Failure} =
  VAR ch: Drawing.ChildPublic := Filter.Child(d); dx, dy := 0.0; BEGIN
    Wr.PutText(wr, "\n%%BeginSetup\n");
    Wr.PutText(wr, "% define the coordinates of the center of the page\n");
    IF ch.getOrigin() = JunoConfig.Origin.SW THEN
      CASE JunoConfig.orientation OF
        JunoConfig.Orientation.Portrait =>  dx := HalfWidth; dy := HalfHeight
      | JunoConfig.Orientation.Landscape => dx := HalfHeight; dy := HalfWidth
      END
    END;
    Wr.PutText(wr, "/xCenter " & Fmt.Real(dx) & " def ");
    Wr.PutText(wr, "/yCenter " & Fmt.Real(dy) & " def\n");
    Wr.PutText(wr, "%%EndSetup\n")
  END WriteSetup;

PROCEDURE WritePageHeader(wr: Wr.T; pageNum: CARDINAL) RAISES {Wr.Failure} =
  VAR pg := Fmt.Int(pageNum); BEGIN
    Wr.PutText(wr, "\n%%Page: ");
    Wr.PutText(wr, pg); Wr.PutChar(wr, ' '); Wr.PutText(wr, pg);
    Wr.PutText(wr, "\nsave\n");
    Wr.PutText(wr, "InitializeJunoPage\n")
  END WritePageHeader;

PROCEDURE WritePageTrailer(wr: Wr.T) RAISES {Wr.Failure} =
Invoked at the end of each page; brackets the save done in WritePageHeader.
  BEGIN
    Wr.PutText(wr, "restore\n");
  END WritePageTrailer;

PROCEDURE Epilogue(impl: Impl; showPage := FALSE) RAISES {Wr.Failure} =
An implementation of the endToFile method of an Impl.
  VAR
    d := impl.rt.currView;
    ch: Drawing.ChildPublic := Filter.Child(d);
  BEGIN
    <* ASSERT impl.wr # NIL *>
    WritePageTrailer(impl.wr);
    IF showPage THEN Wr.PutText(impl.wr, "showpage\n") END;
    Wr.PutText(impl.wr, "\n%%Trailer\n");
    Wr.PutText(impl.wr, "%%BoundingBox: ");
    VAR bbox := d.ps.bbox; BEGIN
      (* rotate if in "JunoConfig.Orientation.Landscape" *)
      IF JunoConfig.orientation = JunoConfig.Orientation.Landscape THEN
        IF ch.getOrigin() = JunoConfig.Origin.SW THEN
          (* translate to portrait-page origin *)
          bbox := JunoRect.Add(bbox, JunoPt.T{0.0, -PageWidth})
        END;
        bbox := JunoRect.Rotate90(bbox);
      END;
      (* translate if at "Origin.Center" *)
      IF ch.getOrigin() = JunoConfig.Origin.Center THEN
        bbox := JunoRect.Add(bbox, JunoPt.T{HalfWidth, HalfHeight})
      END;
      WriteRect(impl.wr, bbox)
    END;
    Wr.PutText(impl.wr, "\n%%Pages: ");
    Wr.PutText(impl.wr, Fmt.Int(impl.page));
    Wr.PutText(impl.wr, "\n%%EOF\n")
  END Epilogue;

PROCEDURE EndToFile(impl: Impl) =
  BEGIN
    <* ASSERT impl.wr # NIL *>
    FOR i := FIRST(impl.cache) TO impl.extCnt - 1 DO
      JunoRT.ext_code_tbl[impl.cache[i].slot] := impl.cache[i].proc
    END;
    impl.wr := NIL
  END EndToFile;

PROCEDURE CopyState(READONLY from: State; VAR (*OUT*) to: State) =
  BEGIN
    to := from;
    to.path := Path.Copy(from.path);
  END CopyState;

PROCEDURE SaveProc(dc: Closure): BOOLEAN =
  VAR d := dc.rt.currView; BEGIN
    IF d.sp > LAST(d.psStack^) THEN
      VAR new := NEW(REF ARRAY OF State, 2 * NUMBER(d.psStack^)); BEGIN
        SUBARRAY(new^, 0, NUMBER(d.psStack^)) := d.psStack^;
        d.psStack := new
      END
    END;
    CopyState(d.ps, d.psStack[d.sp]);
    INC(d.sp);
    RETURN TRUE
  END SaveProc;

PROCEDURE SaveProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    IF NOT SaveProc(cl) THEN RETURN FALSE END;
    TRY Wr.PutText(cl.i.wr, "gsave\n") EXCEPT
      Wr.Failure => RETURN FALSE
    END;
    RETURN TRUE
  END SaveProc2;

PROCEDURE RestoreProc(dc: Closure): BOOLEAN =
  VAR d := dc.rt.currView; BEGIN
    IF d.sp = 0 THEN RETURN FALSE END;
    DEC(d.sp);
    d.ps := d.psStack[d.sp];
    RETURN TRUE
  END RestoreProc;

PROCEDURE RestoreProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    IF NOT RestoreProc(cl) THEN RETURN FALSE END;
    TRY Wr.PutText(cl.i.wr, "grestore\n") EXCEPT
      Wr.Failure => RETURN FALSE
    END;
    RETURN TRUE
  END RestoreProc2;

<* INLINE *>
PROCEDURE WritePoint(wr: Wr.T; READONLY pt: JunoPt.T) RAISES {Wr.Failure} =
  BEGIN
    Wr.PutText(wr, Fmt.Real(pt.x)); Wr.PutChar(wr, ' ');
    Wr.PutText(wr, Fmt.Real(pt.y)); Wr.PutChar(wr, ' ')
  END WritePoint;

<* INLINE *>
PROCEDURE WriteRect(wr: Wr.T; READONLY rect: JunoRect.T) RAISES {Wr.Failure} =
  BEGIN
    Wr.PutText(wr, Fmt.Real(rect.west));  Wr.PutChar(wr, ' ');
    Wr.PutText(wr, Fmt.Real(rect.south)); Wr.PutChar(wr, ' ');
    Wr.PutText(wr, Fmt.Real(rect.east));  Wr.PutChar(wr, ' ');
    Wr.PutText(wr, Fmt.Real(rect.north)); Wr.PutChar(wr, ' ')
  END WriteRect;
======================== Callback Procedures ============================

Implementation Note:

In most cases, when examining Juno arguments passed on the Juno machine's stack, we must use a NULL => TYPECASE arm to handle the possibility of Modula-3 NIL being passed on the stack. However, we can omit this TYPECASE arm when the expected value is a point, since the subsequent call to the procedure JunoPt.FromValuePair on this argument will raise JunoPt.BadPt in that case.

PROCEDURE NewPathProc(dc: Closure): BOOLEAN =
  BEGIN
    ResetPath(dc.rt.currView.ps);
    RETURN TRUE
  END NewPathProc;

PROCEDURE NewPathProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    IF NewPathProc(cl) THEN
      TRY
        Wr.PutText(cl.i.wr, "newpath\n");
        RETURN TRUE
      EXCEPT Wr.Failure => (* SKIP *)
      END
    END;
    RETURN TRUE
  END NewPathProc2;

PROCEDURE MoveToProc(dc: Closure): BOOLEAN =
  VAR err := FALSE; pr := JunoArgs.ReadPair(1, err); BEGIN
    IF NOT err THEN
      WITH ps = dc.rt.currView.ps DO
        VAR pt: JunoPt.T; BEGIN
          TRY pt := JunoPt.FromValuePair(pr) EXCEPT
            JunoPt.BadPt => RETURN FALSE
          END;
          ps.moveto := TRUE;
          ps.movetoPt := pt;
          ps.currPt := pt;
          ps.subpathStartPt := pt;
          RETURN TRUE
        END
      END
    END;
    RETURN FALSE
  END MoveToProc;

PROCEDURE MoveToProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    IF MoveToProc(cl) THEN
      TRY
        WITH wr = cl.i.wr DO
          WritePoint(wr, cl.rt.currView.ps.currPt);
          Wr.PutText(wr, "moveto\n")
        END;
        RETURN TRUE
      EXCEPT
        Wr.Failure => (* SKIP *)
      END
    ELSE (* SKIP *)
    END;
    RETURN FALSE
  END MoveToProc2;

PROCEDURE StartSegment(VAR (*INOUT*) ps: State; ch: Drawing.ChildPublic):
    BOOLEAN =
Code executed when a new straight or curved segment is added to the path to maintain the invariants on the moveto and movetoPt fields. Returns FALSE iff the current path is logically empty.
  BEGIN
    IF ps.moveto THEN
      ps.moveto := FALSE;
      Path.MoveTo(ps.path, JunoPt.ToHV(ps.movetoPt, ch.xform))
    ELSIF Path.IsClosed(ps.path) THEN
      RETURN FALSE
    END;
    RETURN TRUE
  END StartSegment;

PROCEDURE LineToProc(dc: Closure): BOOLEAN =
  BEGIN
    WITH d = dc.rt.currView, ps = d.ps DO
      VAR ch: Drawing.ChildPublic := Filter.Child(d); BEGIN
      	IF StartSegment(ps, ch) THEN
      	  VAR err := FALSE; pr := JunoArgs.ReadPair(1, err); BEGIN
      	    IF NOT err THEN
	      TRY ps.currPt := JunoPt.FromValuePair(pr) EXCEPT
		JunoPt.BadPt => RETURN FALSE
	      END;
      	      Path.LineTo(ps.path, JunoPt.ToHV(ps.currPt, ch.xform));
	      RETURN TRUE
      	    END
      	  END
      	END
      END
    END;
    RETURN FALSE
  END LineToProc;

PROCEDURE LineToProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    IF LineToProc(cl) THEN
      TRY
        WritePoint(cl.i.wr, cl.rt.currView.ps.currPt);
        Wr.PutText(cl.i.wr, "lineto\n");
        RETURN TRUE
      EXCEPT Wr.Failure => (* SKIP *)
      END
    END;
    RETURN FALSE
  END LineToProc2;

PROCEDURE CurveToProc(dc: Closure): BOOLEAN =
  VAR dummy1, dummy2, dummy3: JunoPt.T; BEGIN
    RETURN CurveToWork(dc, dummy1, dummy2, dummy3)
  END CurveToProc;

PROCEDURE CurveToProc2(cl: ToFileClosure): BOOLEAN =
  VAR pt1, pt2, pt3: JunoPt.T; BEGIN
    IF CurveToWork(cl, pt1, pt2, pt3) THEN
      WITH wr = cl.i.wr DO
        TRY
	  WritePoint(wr, pt1);
	  WritePoint(wr, pt2);
	  WritePoint(wr, pt3);
	  Wr.PutText(wr, "curveto\n");
	  RETURN TRUE
        EXCEPT
          Wr.Failure => (* SKIP *)
        END;
      END
    END;
    RETURN FALSE
  END CurveToProc2;

PROCEDURE CurveToWork(dc: Closure; VAR (*OUT*) pt1, pt2, pt3: JunoPt.T):
    BOOLEAN =
  BEGIN
    WITH d = dc.rt.currView, ps = d.ps DO
      VAR ch: Drawing.ChildPublic := Filter.Child(d); BEGIN
      	IF StartSegment(ps, ch) THEN
      	  VAR
      	    err := FALSE;
      	    pr1 := JunoArgs.ReadPair(3, err);
      	    pr2 := JunoArgs.ReadPair(2, err);
      	    pr3 := JunoArgs.ReadPair(1, err);
      	  BEGIN
      	    IF NOT err THEN
	      TRY
      		pt1 := JunoPt.FromValuePair(pr1);
      		pt2 := JunoPt.FromValuePair(pr2);
      		pt3 := JunoPt.FromValuePair(pr3)
	      EXCEPT
      		JunoPt.BadPt => RETURN FALSE
	      END;
	      Path.CurveTo(ps.path,
      		JunoPt.ToHV(pt1, ch.xform),
      		JunoPt.ToHV(pt2, ch.xform),
      		JunoPt.ToHV(pt3, ch.xform));
      	      ps.currPt := pt3;
	      RETURN TRUE
      	    END
	  END
      	END
      END
    END;
    RETURN FALSE
  END CurveToWork;

PROCEDURE CloseProc(dc: Closure): BOOLEAN =
  BEGIN
    WITH d = dc.rt.currView, ps = d.ps DO
      IF ps.moveto THEN
        ps.moveto := FALSE;
        VAR ch: Drawing.ChildPublic := Filter.Child(d); BEGIN
          Path.MoveTo(ps.path, JunoPt.ToHV(ps.movetoPt, ch.xform))
        END
      ELSIF Path.IsClosed(ps.path) THEN
        RETURN FALSE
      END;
      Path.Close(ps.path);
      ps.currPt := ps.subpathStartPt
    END;
    RETURN TRUE
  END CloseProc;

PROCEDURE CloseProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    IF CloseProc(cl) THEN
      TRY
        Wr.PutText(cl.i.wr, "closepath\n");
        RETURN TRUE
      EXCEPT Wr.Failure => (* SKIP *)
      END;
    END;
    RETURN FALSE
  END CloseProc2;

PROCEDURE StrokeProc(dc: Closure): BOOLEAN =
  BEGIN
    WITH d = dc.rt.currView, ps = d.ps DO
      VAR ch: Drawing.ChildPublic := Filter.Child(d); BEGIN
      	VBT.Stroke(ch, Rect.Full, ps.path,
      	  width := ROUND(ps.width * ch.xform.widthScale),
      	  end := ps.end, join := ps.join, op := ps.colorOp)
      END;
      ResetPath(ps)
    END;
    RETURN TRUE
  END StrokeProc;

PROCEDURE StrokeProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    TRY Wr.PutText(cl.i.wr, "stroke\n") EXCEPT
      Wr.Failure => RETURN FALSE
    END;
    ResetPath(cl.rt.currView.ps);
    RETURN TRUE
  END StrokeProc2;

PROCEDURE FillProc(dc: Closure): BOOLEAN =
  BEGIN
    WITH d = dc.rt.currView, ps = d.ps DO
      VAR ch: Drawing.ChildPublic := Filter.Child(d); BEGIN
        VBT.Fill(ch, Rect.Full, ps.path, wind := ps.wind, op := ps.colorOp)
      END;
      ResetPath(ps)
    END;
    RETURN TRUE
  END FillProc;

PROCEDURE FillProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    TRY
      CASE cl.rt.currView.ps.wind OF
    	VBT.WindingCondition.NonZero => Wr.PutText(cl.i.wr, "fill\n")
      | VBT.WindingCondition.Odd     => Wr.PutText(cl.i.wr, "eofill\n")
      END
    EXCEPT
      Wr.Failure => RETURN FALSE
    END;
    ResetPath(cl.rt.currView.ps);
    RETURN TRUE
  END FillProc2;

PROCEDURE TypeProc(dc: Closure): BOOLEAN =
  VAR
    err := FALSE;
    pr := JunoArgs.ReadPair(2, err);
    t := JunoArgs.ReadText(1, err);
  BEGIN
    IF NOT err THEN
      WITH d = dc.rt.currView, ps = d.ps DO
        VAR ch: Drawing.ChildPublic := Filter.Child(d); pt: JunoPt.T; BEGIN
          TRY pt := JunoPt.FromValuePair(pr) EXCEPT
            JunoPt.BadPt => RETURN FALSE
          END;
          VBT.PaintText(ch, fnt := ps.xFont, t := t,
            pt := JunoPt.ToHV(pt, ch.xform),
            op := ps.textColorOp);
          RETURN TRUE
        END
      END
    END;
    RETURN FALSE
  END TypeProc;

PROCEDURE TypeProc2(cl: ToFileClosure): BOOLEAN =
  VAR
    err := FALSE;
    pr := JunoArgs.ReadPair(2, err);
    t := JunoArgs.ReadText(1, err);
  BEGIN
    IF NOT err THEN
      VAR wr := cl.i.wr; pt: JunoPt.T; BEGIN
        TRY
          pt := JunoPt.FromValuePair(pr);
          Wr.PutText(wr, "gsave\n");
          WritePoint(wr, pt);
          Wr.PutText(wr, "moveto\n(");
          Wr.PutText(wr, EscapeString(t));
          Wr.PutText(wr, ") show\n");
          Wr.PutText(wr, "grestore\n")
        EXCEPT
          JunoPt.BadPt, Wr.Failure => RETURN FALSE
        END;
        RETURN TRUE
      END
    END;
    RETURN FALSE
  END TypeProc2;

PROCEDURE EscapeString(t: TEXT): TEXT =
Return a text equivalent to t, but with non-printing and PostScript- special characters (namely, '(', ')', and '\') converted to octal escape sequences.
  CONST
    PSSpecial = SET OF CHAR {'(', ')', '\\'};
    Printing = SET OF CHAR {' ' .. '~'} - PSSpecial;
  PROCEDURE OctalString(c: CHAR): TEXT =
    BEGIN
      IF c IN PSSpecial THEN RETURN Text.FromChar(c) END;
      RETURN Fmt.Pad(Fmt.Int(ORD(c), base := 8), 3, padChar := '0')
    END OctalString;
  VAR res := ""; start := 0; c: CHAR; len := Text.Length(t); BEGIN
    FOR i := 0 TO len - 1 DO
      c := Text.GetChar(t, i);
      IF NOT c IN Printing THEN
        (* flush batch of chars in [start, i) *)
        IF start < i THEN res := res & Text.Sub(t, start, i - start) END;
        res := res & "\\" & OctalString(c);
        start := i + 1
      END
    END;
    (* fast path: no escaped characters *)
    IF start = 0 THEN RETURN t END;
    (* otherwise, flush suffix if necessary *)
    IF start < len THEN res := res & Text.Sub(t, start, len - start) END;
    RETURN res
  END EscapeString;

PROCEDURE SetWidthProc(dc: Closure): BOOLEAN =
  VAR err := FALSE; r := JunoArgs.ReadReal(1, err); BEGIN
    IF NOT err AND r >= 0.0 THEN
      dc.rt.currView.ps.width := r;
      RETURN TRUE
    END;
    RETURN FALSE
  END SetWidthProc;

PROCEDURE SetWidthProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    IF SetWidthProc(cl) THEN
      TRY
        Wr.PutText(cl.i.wr, Fmt.Real(cl.rt.currView.ps.width));
        Wr.PutText(cl.i.wr, " setlinewidth\n");
        RETURN TRUE
      EXCEPT Wr.Failure => (* SKIP *)
      END
    END;
    RETURN FALSE
  END SetWidthProc2;

PROCEDURE GetWidthProc(dc: Closure): BOOLEAN =
  BEGIN
    JunoArgs.WriteReal(1, dc.rt.currView.ps.width);
    RETURN TRUE
  END GetWidthProc;

CONST EndMap = ARRAY [ButtEndsVal..SquareEndsVal] OF VBT.EndStyle{
  VBT.EndStyle.Butt, VBT.EndStyle.Round, VBT.EndStyle.Square};

PROCEDURE SetEndStyleProc(dc: Closure): BOOLEAN =
  VAR err := FALSE; es := JunoArgs.ReadInt(1, err); BEGIN
    IF NOT err AND ButtEndsVal <= es AND es <= SquareEndsVal THEN
      dc.rt.currView.ps.end := EndMap[es];
      RETURN TRUE
    END;
    RETURN FALSE
  END SetEndStyleProc;

CONST EndMapInv = ARRAY VBT.EndStyle OF INTEGER{
  RoundEndsVal, ButtEndsVal, SquareEndsVal};

PROCEDURE SetEndStyleProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    IF SetEndStyleProc(cl) THEN
      TRY
        Wr.PutText(cl.i.wr, Fmt.Int(EndMapInv[cl.rt.currView.ps.end]));
        Wr.PutText(cl.i.wr, " setlinecap\n")
      EXCEPT Wr.Failure => (* SKIP *)
      END
    END;
    RETURN TRUE
  END SetEndStyleProc2;

PROCEDURE GetEndStyleProc(dc: Closure): BOOLEAN =
  BEGIN
    JunoArgs.WriteInt(1, EndMapInv[dc.rt.currView.ps.end]);
    RETURN TRUE
  END GetEndStyleProc;

CONST JoinMap = ARRAY [MiterJointsVal..BevelJointsVal] OF VBT.JoinStyle {
  VBT.JoinStyle.Miter, VBT.JoinStyle.Round, VBT.JoinStyle.Bevel};

PROCEDURE SetJoinStyleProc(dc: Closure): BOOLEAN =
  VAR err := FALSE; js := JunoArgs.ReadInt(1, err); BEGIN
    IF NOT err AND MiterJointsVal <= js AND js <= BevelJointsVal THEN
      dc.rt.currView.ps.join := JoinMap[js];
      RETURN TRUE
    END;
    RETURN FALSE
  END SetJoinStyleProc;

CONST JoinMapInv = ARRAY VBT.JoinStyle OF INTEGER {
  RoundJointsVal, BevelJointsVal, MiterJointsVal};

PROCEDURE SetJoinStyleProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    IF SetJoinStyleProc(cl) THEN
      TRY
        Wr.PutText(cl.i.wr, Fmt.Int(JoinMapInv[cl.rt.currView.ps.join]));
        Wr.PutText(cl.i.wr, " setlinejoin\n")
      EXCEPT Wr.Failure => (* SKIP *)
      END
    END;
    RETURN TRUE
  END SetJoinStyleProc2;

PROCEDURE GetJoinStyleProc(dc: Closure): BOOLEAN =
  BEGIN
    JunoArgs.WriteInt(1, JoinMapInv[dc.rt.currView.ps.join]);
    RETURN TRUE
  END GetJoinStyleProc;

PROCEDURE ReadColor(VAR (*OUT*) color: Color): BOOLEAN =
If argument -1 is a color value, set color to that value and return TRUE; otherwise, return FALSE.
  VAR err := FALSE; p1 := JunoArgs.ReadPair(1, err); BEGIN
    IF NOT err THEN
     TYPECASE p1.cdr OF NULL => | RTVal.Pair (p2) =>
      TYPECASE p2.cdr OF NULL => | RTVal.Pair (p3) =>
       TYPECASE p1.car OF NULL => | RTVal.Number (r) =>
        TYPECASE p2.car OF NULL => | RTVal.Number (g) =>
         TYPECASE p3.car OF NULL => | RTVal.Number (b) =>
          IF p3.cdr = RTVal.nil AND
             0.0 <= r.val AND r.val <= 1.0 AND
             0.0 <= g.val AND g.val <= 1.0 AND
             0.0 <= b.val AND b.val <= 1.0 THEN
            color := Color{r.val, g.val, b.val};
            RETURN TRUE
          END
         ELSE (* SKIP *)
         END
        ELSE (* SKIP *)
        END
       ELSE (* SKIP *)
       END
      ELSE (* SKIP *)
      END
     ELSE (* SKIP *)
     END
    END;
    RETURN FALSE
  END ReadColor;

PROCEDURE SetColorProc(dc: Closure): BOOLEAN =
  BEGIN
    WITH ps = dc.rt.currView.ps, c = ps.color DO
      IF ReadColor(c) THEN
        ps.colorOp := PaintOp.FromRGB(c.r, c.g, c.b,
          mode := PaintOp.Mode.Accurate, bw := PaintOp.BW.UseFg);
        ps.textColorOp := PaintOp.Pair(PaintOp.Transparent, ps.colorOp);
        RETURN TRUE
      END
    END;
    RETURN FALSE
  END SetColorProc;

PROCEDURE SetColorProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    WITH c = cl.rt.currView.ps.color DO
      TRY
        IF ReadColor(c) THEN
          WITH wr = cl.i.wr DO
            Wr.PutText(wr, Fmt.Real(c.r)); Wr.PutChar(wr, ' ');
            Wr.PutText(wr, Fmt.Real(c.g)); Wr.PutChar(wr, ' ');
            Wr.PutText(wr, Fmt.Real(c.b));
            Wr.PutText(wr, " setrgbcolor\n")
          END;
          RETURN TRUE
        END
      EXCEPT Wr.Failure => (* SKIP *)
      END
    END;
    RETURN FALSE
  END SetColorProc2;

PROCEDURE GetColorProc(dc: Closure): BOOLEAN =
  BEGIN
    WITH color = dc.rt.currView.ps.color DO
      JunoArgs.WriteValue(1,
        RTVal.FromPair(RTVal.FromReal(color.r),
          RTVal.FromPair(RTVal.FromReal(color.g),
            RTVal.FromPair(RTVal.FromReal(color.b),
              RTVal.nil))))
    END;
    RETURN TRUE
  END GetColorProc;

CONST WindMap = ARRAY [NZWindingVal..OddWindingVal] OF VBT.WindingCondition {
  VBT.WindingCondition.NonZero, VBT.WindingCondition.Odd};

PROCEDURE SetWindingProc(dc: Closure): BOOLEAN =
  VAR err := FALSE; ws := JunoArgs.ReadInt(1, err); BEGIN
    IF NOT err AND NZWindingVal <= ws AND ws <= OddWindingVal THEN
      dc.rt.currView.ps.wind := WindMap[ws];
      RETURN TRUE
    END;
    RETURN FALSE
  END SetWindingProc;

CONST WindMapInv = ARRAY VBT.WindingCondition OF INTEGER {
  OddWindingVal, NZWindingVal};

PROCEDURE GetWindingProc(dc: Closure): BOOLEAN =
  BEGIN
    JunoArgs.WriteInt(1, WindMapInv[dc.rt.currView.ps.wind]);
    RETURN TRUE
  END GetWindingProc;

PROCEDURE GetXInfo(face: TEXT; size: INTEGER): PSFont.XInfo =
  VAR ref: REFANY; BEGIN
    IF NOT fontTbl.get(face & Fmt.Int(size), ref) THEN ref := NIL END;
    RETURN NARROW(ref, PSFont.XInfo)
  END GetXInfo;

PROCEDURE SetFaceProc(dc: Closure): BOOLEAN =
  VAR err := FALSE; nm := JunoArgs.ReadText(1, err); BEGIN
    IF NOT err THEN
      WITH ps = dc.rt.currView.ps DO
	VAR xInfo := GetXInfo(nm, ps.size); BEGIN
          IF xInfo = NIL THEN RETURN FALSE END;
          ps.face := nm; ps.ptSize := xInfo.ptSize;
	  ps.xFont := Font.FromName(ARRAY OF TEXT{xInfo.name});
          RETURN TRUE
	END
      END
    END;
    RETURN FALSE
  END SetFaceProc;

PROCEDURE SetFaceProc2(cl: ToFileClosure): BOOLEAN =
  VAR err := FALSE; nm := JunoArgs.ReadText(1, err); BEGIN
    IF NOT err THEN
      WITH ps = cl.rt.currView.ps, wr = cl.i.wr DO
	VAR ref: REFANY; xInfo := GetXInfo(nm, ps.size); BEGIN
	  IF xInfo = NIL OR NOT metricTbl.get(nm, ref) THEN
            RETURN FALSE
          END;
          ps.face := nm; ps.ptSize := xInfo.ptSize;
	  ps.psMetric := ref;
          TRY
            Wr.PutChar(wr, '/'); Wr.PutText(wr, nm);
            WriteFindFont(wr);
	    Wr.PutText(wr, Fmt.Real(xInfo.ptSize));
            Wr.PutText(wr, " scalefont setfont\n")
          EXCEPT
            Wr.Failure => RETURN FALSE
          END;
          RETURN TRUE
	END
      END
    END;
    RETURN FALSE
  END SetFaceProc2;

PROCEDURE SetSizeProc(dc: Closure): BOOLEAN =
  VAR err := FALSE; sz := JunoArgs.ReadInt(1, err); BEGIN
    IF NOT err AND sz >= 0 THEN
      WITH ps = dc.rt.currView.ps DO
        VAR xInfo := GetXInfo(ps.face, sz); BEGIN
    	  IF xInfo = NIL THEN RETURN FALSE END;
          ps.size := sz; ps.ptSize := xInfo.ptSize;
    	  ps.xFont := Font.FromName(ARRAY OF TEXT{xInfo.name});
          RETURN TRUE
        END
      END
    END;
    RETURN FALSE
  END SetSizeProc;

PROCEDURE SetSizeProc2(cl: ToFileClosure): BOOLEAN =
  VAR err := FALSE; sz := JunoArgs.ReadInt(1, err); BEGIN
    IF NOT err AND sz >= 0 THEN
      WITH ps = cl.rt.currView.ps, wr = cl.i.wr DO
        VAR xInfo := GetXInfo(ps.face, sz); BEGIN
    	  IF xInfo = NIL THEN RETURN FALSE END;
          ps.size := sz; ps.ptSize := xInfo.ptSize;
          TRY
            Wr.PutChar(wr, '/'); Wr.PutText(wr, ps.face);
            WriteFindFont(wr);
            Wr.PutText(wr, Fmt.Real(xInfo.ptSize));
            Wr.PutText(wr, " scalefont setfont\n")
          EXCEPT
            Wr.Failure => RETURN FALSE
          END;
          RETURN TRUE
        END
      END
    END;
    RETURN FALSE
  END SetSizeProc2;

PROCEDURE SetFontProc(dc: Closure): BOOLEAN =
  VAR
    err := FALSE;
    nm := JunoArgs.ReadText(2, err);
    sz := JunoArgs.ReadInt(1, err);
  BEGIN
    IF NOT err AND sz >= 0 THEN
      VAR xInfo := GetXInfo(nm, sz); BEGIN
        IF xInfo = NIL THEN RETURN FALSE END;
        WITH ps = dc.rt.currView.ps DO
          ps.face := nm; ps.size := sz; ps.ptSize := xInfo.ptSize;
	  ps.xFont := Font.FromName(ARRAY OF TEXT{xInfo.name})
	END;
	RETURN TRUE
      END
    END;
    RETURN FALSE
  END SetFontProc;

PROCEDURE SetFontProc2(cl: ToFileClosure): BOOLEAN =
  VAR
    err := FALSE;
    nm := JunoArgs.ReadText(2, err);
    sz := JunoArgs.ReadInt(1, err);
  BEGIN
    IF NOT err AND sz >= 0 THEN
      VAR xInfo := GetXInfo(nm, sz); BEGIN
        IF xInfo = NIL THEN RETURN FALSE END;
        WITH ps = cl.rt.currView.ps, wr = cl.i.wr DO
          VAR ref: REFANY; BEGIN
            IF NOT metricTbl.get(nm, ref) THEN RETURN FALSE END;
            ps.psMetric := ref
	  END;
	  ps.face := nm; ps.size := sz; ps.ptSize := xInfo.ptSize;
          TRY
            Wr.PutChar(wr, '/'); Wr.PutText(wr, nm);
            WriteFindFont(wr);
	    Wr.PutText(wr, Fmt.Real(xInfo.ptSize));
	    Wr.PutText(wr, " scalefont setfont\n")
          EXCEPT
            Wr.Failure => RETURN FALSE
          END;
          RETURN TRUE
        END
      END
    END;
    RETURN FALSE
  END SetFontProc2;

PROCEDURE GetFaceProc(dc: Closure): BOOLEAN =
  BEGIN
    JunoArgs.WriteText(1, dc.rt.currView.ps.face);
    RETURN TRUE
  END GetFaceProc;

PROCEDURE GetSizeProc(dc: Closure): BOOLEAN =
  BEGIN
    JunoArgs.WriteInt(1, dc.rt.currView.ps.size);
    RETURN TRUE
  END GetSizeProc;

PROCEDURE GetFontProc(dc: Closure): BOOLEAN =
  BEGIN
    JunoArgs.WriteText(2, dc.rt.currView.ps.face);
    JunoArgs.WriteInt(1, dc.rt.currView.ps.size);
    RETURN TRUE
  END GetFontProc;

PROCEDURE GetPtSizeProc(dc: Closure): BOOLEAN =
  BEGIN
    JunoArgs.WriteReal(1, dc.rt.currView.ps.ptSize);
    RETURN TRUE
  END GetPtSizeProc;

PROCEDURE FontHProc(dc: Closure): BOOLEAN =
Note: We can use a dummy string, since we only care about the ascent and descent of the font, and VBT.BoundingBox returns the same ascent and descent regardless of its argument.
  BEGIN
    WITH d = dc.rt.currView DO
      VAR
        ch: Drawing.ChildPublic := Filter.Child(d);
        bbox := VBT.BoundingBox(ch, "a", d.ps.xFont);
      BEGIN
        WITH yScale = ch.xform.yScale DO
          JunoArgs.WriteReal(2, -FLOAT(bbox.north, JunoValue.Real) / yScale);
          JunoArgs.WriteReal(1,  FLOAT(bbox.south, JunoValue.Real) / yScale)
        END;
        RETURN TRUE
      END
    END
  END FontHProc;

PROCEDURE FontHProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    WITH
      ps = cl.rt.currView.ps,
      sz = ps.ptSize,
      bbox = ps.psMetric.bbox
    DO
      JunoArgs.WriteReal(2,  sz * bbox.north);
      JunoArgs.WriteReal(1, -sz * bbox.south)
    END;
    RETURN TRUE
  END FontHProc2;

PROCEDURE StringWProc(dc: Closure): BOOLEAN =
  VAR err := FALSE; t := JunoArgs.ReadText(1, err); BEGIN
    IF NOT err THEN
      WITH d = dc.rt.currView DO
        VAR
          ch: Drawing.ChildPublic := Filter.Child(d);
          w := VBT.TextWidth(ch, t, d.ps.xFont);
        BEGIN
          JunoArgs.WriteReal(2, FLOAT(w, JunoValue.Real) / ch.xform.xScale)
        END;
        RETURN TRUE
      END
    END;
    RETURN FALSE
  END StringWProc;

PROCEDURE StringWProc2(cl: ToFileClosure): BOOLEAN =
  VAR err := FALSE; t := JunoArgs.ReadText(1, err); BEGIN
    IF NOT err THEN
      WITH metric = cl.rt.currView.ps.psMetric DO
        VAR total: JunoValue.Real := 0.0; BEGIN
          FOR i := 0 TO Text.Length(t) - 1 DO
            VAR code := ORD(Text.GetChar(t, i)); BEGIN
              IF metric.mapped[code] THEN
                total := total + metric.width[code]
              END
            END
          END;
          JunoArgs.WriteReal(2, total * cl.rt.currView.ps.ptSize);
          RETURN TRUE
        END
      END
    END;
    RETURN FALSE
  END StringWProc2;

PROCEDURE StringBBProc(dc: Closure): BOOLEAN =
  VAR err := FALSE; t := JunoArgs.ReadText(1, err); BEGIN
    IF NOT err THEN
      WITH d = dc.rt.currView DO
      	VAR
      	  ch: Drawing.ChildPublic := Filter.Child(d);
          r: Rect.T := VBTExtras.TightBoundingBox(ch, t, d.ps.xFont);
          res: JunoRect.T;
      	BEGIN
          IF r = Rect.Empty THEN
            res := JunoRect.Empty
          ELSE
      	    WITH xScale = ch.xform.xScale, yScale = ch.xform.yScale DO
      	      res := JunoRect.T{
      	  	(FLOAT( r.west,  JunoValue.Real) - 0.49) / xScale,
      	  	(FLOAT( r.east,  JunoValue.Real) - 0.49) / xScale,
      	  	(FLOAT(-r.north, JunoValue.Real) + 0.51) / yScale,
      	  	(FLOAT(-r.south, JunoValue.Real) + 0.51) / yScale}
            END
      	  END;
          JunoArgs.WriteValue(2, JunoRect.ToRTVal(res));
      	  RETURN TRUE
      	END
      END
    END;
    RETURN FALSE
  END StringBBProc;

PROCEDURE StringBBProc2(cl: ToFileClosure): BOOLEAN =
  VAR err := FALSE; t := JunoArgs.ReadText(1, err); BEGIN
    IF NOT err THEN
      WITH ps = cl.rt.currView.ps DO
        VAR res: JunoRect.T; empty := TRUE; refPt := 0.0; BEGIN
          FOR i := 0 TO Text.Length(t) - 1 DO
            VAR code := ORD(Text.GetChar(t, i)); BEGIN
              IF NOT ps.psMetric.mapped[code] THEN
                (* Map unencoded characters to the space character *)
                code := ORD(' ');
                <* ASSERT ps.psMetric.mapped[code] *>
              END;
              VAR
                bbox := ps.psMetric.charBB[code];
                bbox2: JunoRect.T;
              BEGIN
            	IF bbox # NIL THEN
            	  bbox2 := JunoRect.Add(bbox^, JunoPt.T{refPt, 0.0});
            	  IF empty
            	    THEN empty := FALSE; res := bbox2
            	    ELSE res := JunoRect.Join(res, bbox2)
            	  END
            	END;
            	refPt := refPt + ps.psMetric.width[code]
              END
            END
          END;
          IF empty
            THEN res := JunoRect.T{0.0, 0.0, 0.0, 0.0}
            ELSE res := JunoRect.Scale(res, ps.ptSize)
          END;
          JunoArgs.WriteValue(2, JunoRect.ToRTVal(res));
          RETURN TRUE
        END
      END
    END;
    RETURN FALSE
  END StringBBProc2;

PROCEDURE CurrPtProc(dc: Closure): BOOLEAN =
  BEGIN
    WITH ps = dc.rt.currView.ps DO
      IF NOT ps.moveto AND Path.IsClosed(ps.path)
        THEN JunoArgs.WriteValue(1, RTVal.nil)
        ELSE JunoArgs.WriteValue(1, JunoPt.ToValuePair(ps.currPt))
      END
    END;
    RETURN TRUE
  END CurrPtProc;

VAR Nil := RTVal.nil;

TYPE
  JunoMO = Path.MapObject BRANDED "PSImpl.JunoMO" OBJECT
    ch: Drawing.ChildPublic;
    head, curr: RTVal.Pair;
  METHODS
    init(): JunoMO := JunoMOInit
  OVERRIDES
    move := AddMoveTo;
    line := AddLineTo;
    curve := AddCurveTo;
    close := AddClose
  END;

PROCEDURE JunoMOInit(self: JunoMO): JunoMO =
  BEGIN
    self.head := RTVal.FromPair(Nil, Nil);
    self.curr := self.head;
    RETURN self
  END JunoMOInit;

PROCEDURE AddNewList(self: JunoMO; nm: TEXT): RTVal.Pair =
  VAR pr := RTVal.FromPair(RTVal.FromText(nm), Nil); BEGIN
    self.curr.cdr := RTVal.FromPair(pr, Nil);
    self.curr := self.curr.cdr;
    RETURN pr
  END AddNewList;

PROCEDURE AddPt(
    VAR (*INOUT*) pr: RTVal.Pair;
    READONLY pt: Point.T;
    ch: Drawing.ChildPublic) =
  VAR pair := JunoPt.ToValuePair(JunoPt.FromHV(pt, ch.xform)); BEGIN
    pr.cdr := RTVal.FromPair(pair, Nil);
    pr := pr.cdr;
  END AddPt;

PROCEDURE AddMoveTo(self: JunoMO; READONLY pt: Point.T) =
  VAR pr := AddNewList(self, "MoveTo"); BEGIN
    AddPt(pr, pt, self.ch);
    pr.cdr := Nil
  END AddMoveTo;

PROCEDURE AddLineTo(
    self: JunoMO;
    <*UNUSED*> READONLY pt1: Point.T;
    READONLY pt2: Point.T) =
  VAR pr := AddNewList(self, "LineTo"); BEGIN
    AddPt(pr, pt2, self.ch);
    pr.cdr := Nil
  END AddLineTo;

PROCEDURE AddCurveTo(
    self: JunoMO;
    <*UNUSED*> READONLY pt1: Point.T;
    READONLY pt2, pt3, pt4: Point.T)=
  VAR pr := AddNewList(self, "CurveTo"); BEGIN
    AddPt(pr, pt2, self.ch);
    AddPt(pr, pt3, self.ch);
    AddPt(pr, pt4, self.ch);
    pr.cdr := Nil
  END AddCurveTo;

PROCEDURE AddClose(self: JunoMO; <*UNUSED*> READONLY pt1, pt2: Point.T) =
  VAR pr := AddNewList(self, "Close"); BEGIN
    pr.cdr := Nil
  END AddClose;

PROCEDURE CurrPathProc(dc: Closure): BOOLEAN =
  <* FATAL Path.Malformed *>
  VAR jmo: JunoMO; BEGIN
    WITH d = dc.rt.currView, ps = d.ps DO
      jmo := NEW(JunoMO, ch := Filter.Child(d)).init();
      Path.Map(ps.path, jmo);
      IF ps.moveto THEN
        jmo.move(JunoPt.ToHV(ps.movetoPt, jmo.ch.xform))
      END;
      JunoArgs.WriteValue(1, jmo.head.cdr)
    END;
    RETURN TRUE
  END CurrPathProc;

PROCEDURE SetBBoxProc(dc: Closure): BOOLEAN =
  VAR
    err := FALSE;
    pr1 := JunoArgs.ReadPair(2, err);
    pr2 := JunoArgs.ReadPair(1, err);
    pt1, pt2: JunoPt.T;
  BEGIN
    IF NOT err THEN
      TRY
        pt1 := JunoPt.FromValuePair(pr1);
        pt2 := JunoPt.FromValuePair(pr2)
      EXCEPT
        JunoPt.BadPt => RETURN FALSE
      END;
      WITH bbox = dc.rt.currView.ps.bbox DO
        bbox.west := MIN(pt1.x, pt2.x);
        bbox.east := MAX(pt1.x, pt2.x);
        bbox.south := MIN(pt1.y, pt2.y);
        bbox.north := MAX(pt1.y, pt2.y)
      END;
      RETURN TRUE
    END;
    RETURN FALSE
  END SetBBoxProc;

PROCEDURE GetBBoxProc(dc: Closure): BOOLEAN =
  BEGIN
    WITH bbox = dc.rt.currView.ps.bbox DO
      JunoArgs.WriteValue(2, JunoPt.ToValuePair(
        JunoPt.T{x := bbox.west, y := bbox.south}));
      JunoArgs.WriteValue(1, JunoPt.ToValuePair(
        JunoPt.T{x := bbox.east, y := bbox.north}))
    END;
    RETURN TRUE
  END GetBBoxProc;

PROCEDURE ShowPageProc(dc: Closure): BOOLEAN =
  BEGIN
    Drawing.Sync(Filter.Child(dc.rt.currView));
    RETURN TRUE
  END ShowPageProc;

PROCEDURE ShowPageProc2(cl: ToFileClosure): BOOLEAN =
  BEGIN
    INC(cl.i.page);
    TRY
      WITH wr = cl.i.wr DO
        WritePageTrailer(wr);
      	Wr.PutText(wr, "showpage\n");
      	WritePageHeader(wr, cl.i.page)
      END;
      RETURN TRUE
    EXCEPT Wr.Failure => (* SKIP *)
    END;
    RETURN FALSE
  END ShowPageProc2;

PROCEDURE ResetProc(dc: Closure): BOOLEAN =
  VAR d := dc.rt.currView; ch: Drawing.ChildPublic := Filter.Child(d); BEGIN
    VBT.PaintTint(ch, Rect.Full, PaintOp.Bg);
    Reset(d);
    RETURN TRUE
  END ResetProc;

PROCEDURE SavePageProc(dc: Closure): BOOLEAN =
  BEGIN
    DblBufferVBT.Save(Filter.Child(dc.rt.currView));
    RETURN TRUE
  END SavePageProc;

PROCEDURE SavePageProc2(<*UNUSED*> cl: ToFileClosure): BOOLEAN =
  BEGIN RETURN TRUE END SavePageProc2;

PROCEDURE RestorePageProc(dc: Closure): BOOLEAN =
  BEGIN
    DblBufferVBT.Restore(Filter.Child(dc.rt.currView));
    RETURN TRUE
  END RestorePageProc;

PROCEDURE RestorePageProc2(<*UNUSED*> cl: ToFileClosure): BOOLEAN =
  BEGIN RETURN TRUE END RestorePageProc2;

BEGIN
  (* read the font data from the pickle *)
  <* FATAL Rd.Failure, Rd.EndOfFile, Rsrc.NotFound *>
  VAR
    rd := Rsrc.Open("FontData.pkl", JunoRsrc.Path);
    fontData: PSFont.Data;
  BEGIN
    TRY fontData := Pickle.Read(rd) EXCEPT Pickle.Error (msg) =>
      <* FATAL Wr.Failure *> BEGIN
        Wr.PutText(stderr, "Error reading pickled font data: " & msg & "\n");
        Wr.Flush(stderr)
      END;
      Process.Exit(1)
    END;
    Rd.Close(rd);
    fontTbl := fontData.fontTbl;
    metricTbl := fontData.metricTbl
  END;

  (* set defaultXFont *)
  VAR xInfo := GetXInfo(DefaultFaceName, DefaultFontSize); BEGIN
    IF xInfo = NIL THEN RAISE Error END;
    defaultXFont := Font.FromName(ARRAY OF TEXT{xInfo.name});
    defaultXFontPtSize := xInfo.ptSize
  END;

  (* set default metric *)
  VAR ref: REFANY; BEGIN
    IF metricTbl.get(DefaultFaceName, ref)
      THEN defaultPSMetric := ref
      ELSE RAISE Error
    END
  END
END PSImpl.

interface JunoRect is in:


interface PSFont is in:


interface View is in:


interface JunoValue is in: