(* Copyright (C) 1995 UNICAMP.  See notice at the end of this file.  *)

MODULE PSWrite;  (* Version 95-04-16-stolfi *)

IMPORT Wr, Thread, Fmt, Text, Date, Time;

CONST MM = 72.0d0 / 25.4d0; (* One mm in pt's *)

PROCEDURE EPSFileHeader(wr: Wr.T; xMin, xMax, yMin, yMax: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "%!PS-Adobe-2.0\n");
    Wr.PutText(wr, "%%Creator: PSPlot.m3 " & Today() & "\n");
    Wr.PutText(wr, "%%BoundingBox: ");
    Wr.PutText(wr, FL(xMin * MM, 3));
    Wr.PutChar(wr, ' ');
    Wr.PutText(wr, FL(yMin * MM, 3));
    Wr.PutChar(wr, ' ');
    Wr.PutText(wr, FL(xMax * MM, 3));
    Wr.PutChar(wr, ' ');
    Wr.PutText(wr, FL(yMax * MM, 3));
    Wr.PutChar(wr, '\n');
    Wr.PutText(wr, "%%EndComments\n");
    ProcedureDefinitions(wr);
    Wr.Flush(wr);
  END EPSFileHeader;

PROCEDURE EPSFileTrailer (wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "%%Trailer\n");
    Wr.PutText(wr, "%%EOF\n");
    Wr.Flush(wr);
  END EPSFileTrailer;
  
PROCEDURE PSFileHeader(wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "%!PS-Adobe-2.0\n");
    Wr.PutText(wr, "%%Creator: PSPlot.m3 " & Today() & "\n");
    Wr.PutText(wr, "%%Pages: (atend)\n");
    Wr.PutText(wr, "%%EndComments\n");
    ProcedureDefinitions(wr);
    Wr.Flush(wr);
  END PSFileHeader;
  
PROCEDURE PSPageHeader (wr: Wr.T; page, foot: TEXT) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "%%Page: " & page & " " & page & "\n");
    Wr.PutText(wr, "\n");
    Wr.PutText(wr, "% Print date:\n");
    Wr.PutText(wr, "gsave\n");
    Wr.PutText(wr, "  /Courier findfont\n");
    Wr.PutText(wr, "  8 scalefont setfont\n");
    Wr.PutText(wr, "  80 18 moveto\n");
    Wr.PutText(wr, "  "); 
    PutString(wr, foot & "   page " & page, "?"); 
    Wr.PutText(wr, " show\n");
    Wr.PutText(wr, "grestore\n");
    Wr.PutText(wr, "\n");
  END PSPageHeader;

PROCEDURE ProcedureDefinitions(wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "%%BeginProcSet: psplot package\n");
  
    Wr.PutText(wr, "% True and false:\n");
    Wr.PutText(wr, "/t true def /f false def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Set fill color operator:\n");
    Wr.PutText(wr, "%   /r/ /g/ /b/ sfc --> \n");
    Wr.PutText(wr, "/sfc\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  /fillb exch def\n");
    Wr.PutText(wr, "  /fillg exch def\n");
    Wr.PutText(wr, "  /fillr exch def\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Set text color operator:\n");
    Wr.PutText(wr, "%   /r/ /g/ /b/ stc --> \n");
    Wr.PutText(wr, "/stc\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  /textb exch def\n");
    Wr.PutText(wr, "  /textg exch def\n");
    Wr.PutText(wr, "  /textr exch def\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Segment operator:\n");
    Wr.PutText(wr, "%   /xa/ /ya/ /xb/ /yb/ segd --> \n");
    Wr.PutText(wr, "/segd\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "    newpath\n");
    Wr.PutText(wr, "    moveto\n");
    Wr.PutText(wr, "    lineto\n");
    Wr.PutText(wr, "    stroke\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Rectangle operator:\n");
    Wr.PutText(wr, "%   /draw/ /fill/ /xlo/ /xhi/ /ylo/ /yhi/ recf --> \n");
    Wr.PutText(wr, "/recf\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "    newpath\n");
    Wr.PutText(wr, "      3 index 2 index moveto\n");
    Wr.PutText(wr, "      2 index 2 index lineto\n");
    Wr.PutText(wr, "      2 index 1 index lineto\n");
    Wr.PutText(wr, "      3 index 1 index lineto\n");
    Wr.PutText(wr, "      closepath\n");
    Wr.PutText(wr, "    pop pop pop pop\n");
    Wr.PutText(wr, "    { gsave fillr fillg fillb setrgbcolor fill grestore } if\n");
    Wr.PutText(wr, "    { stroke } if\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Cell operator:\n");
    Wr.PutText(wr, "%   /draw/ /fill/ /xi/ /yi/ celf --> \n");
    Wr.PutText(wr, "/celf\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  exch \n");
    Wr.PutText(wr, "  dup xstep mul xmin add exch 1 add xstep mul xmin add\n");
    Wr.PutText(wr, "  3 2 roll\n");
    Wr.PutText(wr, "  dup ystep mul ymin add exch 1 add ystep mul ymin add\n");
    Wr.PutText(wr, "  recf\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Circle operator:\n");
    Wr.PutText(wr, "%   /draw/ /fill/ /x/ /y/ /radius/ cirf --> \n");
    Wr.PutText(wr, "/cirf\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "    newpath\n");
    Wr.PutText(wr, "      0 360 arc\n");
    Wr.PutText(wr, "    closepath\n");
    Wr.PutText(wr, "    { gsave fillr fillg fillb setrgbcolor fill grestore } if\n");
    Wr.PutText(wr, "    { stroke } if\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Triangle operator:\n");
    Wr.PutText(wr, "%   /draw/ /fill/ /xa/ /ya/ /xb/ /yb/ /xc/ /yc/ trif --> \n");
    Wr.PutText(wr, "/trif\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "    newpath\n");
    Wr.PutText(wr, "      moveto\n");
    Wr.PutText(wr, "      lineto\n");
    Wr.PutText(wr, "      lineto\n");
    Wr.PutText(wr, "    closepath\n");
    Wr.PutText(wr, "    { gsave fillr fillg fillb setrgbcolor fill grestore } if\n");
    Wr.PutText(wr, "    { stroke } if\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Ellipse operator:\n");
    Wr.PutText(wr, "%   /draw/ /fill/ /xc/ /yc/ /xa/ /ya/ /xb/ /yb/ elpf -->\n");
    Wr.PutText(wr, "/elpf\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "    % Save current matrix:\n");
    Wr.PutText(wr, "    /mtrx matrix currentmatrix def\n");
    Wr.PutText(wr, "    % Change to the affine frame (xc,yc) (xa,ya) (xb,yb):\n");
    Wr.PutText(wr, "    6 4 roll matrix astore concat\n");
    Wr.PutText(wr, "    % Draw the unit circle in this frame:\n");
    Wr.PutText(wr, "    newpath\n");
    Wr.PutText(wr, "      0 0 1 0 360 arc\n");
    Wr.PutText(wr, "    closepath\n");
    Wr.PutText(wr, "    % Restore old matrix, to get uniform line widths:\n");
    Wr.PutText(wr, "    mtrx setmatrix\n");
    Wr.PutText(wr, "    { gsave fillr fillg fillb setrgbcolor fill grestore } if\n");
    Wr.PutText(wr, "    { stroke } if\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Draw an X-value grid line:\n");
    Wr.PutText(wr, "%   /x/ xgrd --> \n");
    Wr.PutText(wr, "/xgrd\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "  newpath\n");
    Wr.PutText(wr, "    dup ymin moveto\n");
    Wr.PutText(wr, "    ymax lineto\n");
    Wr.PutText(wr, "    stroke\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Draw an Y-value grid line:\n");
    Wr.PutText(wr, "%   /y/ ygrd --> \n");
    Wr.PutText(wr, "/ygrd\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "  newpath\n");
    Wr.PutText(wr, "    dup xmin exch moveto\n");
    Wr.PutText(wr, "    xmax exch lineto\n");
    Wr.PutText(wr, "    stroke\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Operator to set font family and size:\n");
    Wr.PutText(wr, "%    /name/ /size/ sfnt -->\n");
    Wr.PutText(wr, "/sfnt\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  /dytext exch def\n");
    Wr.PutText(wr, "  findfont dytext scalefont setfont\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Operator to print string without clipping:\n");
    Wr.PutText(wr, "%   /string/ /angle/ /xalign/ /yalign/ /x/ /y/ gshw --> \n");
    Wr.PutText(wr, "/gshw\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "    initclip\n");
    Wr.PutText(wr, "    translate\n");
    Wr.PutText(wr, "    newpath 0 0 moveto\n");
    Wr.PutText(wr, "    3 index true charpath flattenpath pathbbox\n");
    Wr.PutText(wr, "    2 index sub 4 index mul neg /dytext exch def\n");
    Wr.PutText(wr, "    2 index sub 4 index mul neg /dxtext exch def\n");
    Wr.PutText(wr, "    pop pop pop pop\n");
    Wr.PutText(wr, "    rotate\n");
    Wr.PutText(wr, "    dxtext dytext moveto\n");
    Wr.PutText(wr, "    textr textg textb setrgbcolor\n");
    Wr.PutText(wr, "    show\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "%%EndProcSet\n");
    Wr.PutText(wr, "\n");

    Wr.Flush(wr);
  END ProcedureDefinitions;

PROCEDURE PSPageTrailer (wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "showpage\n");
    Wr.PutText(wr, "%%EndPage\n");
    Wr.PutText(wr, "\n");
    Wr.Flush(wr);
  END PSPageTrailer;

PROCEDURE PSFileTrailer (wr: Wr.T; pages: TEXT) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "%%Trailer\n");
    Wr.PutText(wr, "%%Pages: " & pages & "\n");
    Wr.PutText(wr, "%%EOF\n");
    Wr.Flush(wr);
  END PSFileTrailer;
  
PROCEDURE BeginDrawing(wr: Wr.T; xMin, xMax, yMin, yMax: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "30 dict begin\n");
    Wr.PutText(wr, "gsave\n");

    IF xMin # 0.0d0 OR yMin # 0.0d0 THEN
      Wr.PutText(wr, "% Set origin at corner of drawing area:\n");
      Wr.PutText(wr, FL(xMin * MM, 3));
      Wr.PutText(wr, " ");
      Wr.PutText(wr, FL(yMin * MM, 3));
      Wr.PutText(wr, " translate\n");
    END;
      
    Wr.PutText(wr, "/xmin 0 def  % min plottable x\n");
    Wr.PutText(wr, "/xmax " & FL((xMax - xMin) * MM, 3) & " def  % max plottable x\n");

    Wr.PutText(wr, "/ymin 0 def  % min plottable y\n");
    Wr.PutText(wr, "/ymax " & FL((yMax - yMin) * MM, 3) & " def  % max plottable y\n");
    
    Wr.PutText(wr, "% Units of measure:\n");
    Wr.PutText(wr, "/pt 1.0 def\n");
    Wr.PutText(wr, "/in pt 72.0 mul def \n");
    Wr.PutText(wr, "/mm pt 72.0 25.4 div mul def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Set clipping path to boundary of plot area:\n");
    Wr.PutText(wr, "newpath\n");
    Wr.PutText(wr, "  xmin ymin moveto\n");
    Wr.PutText(wr, "  xmax ymin lineto\n");
    Wr.PutText(wr, "  xmax ymax lineto\n");
    Wr.PutText(wr, "  xmin ymax lineto\n");
    Wr.PutText(wr, "  xmin ymin lineto\n");
    Wr.PutText(wr, "clip\n");
    Wr.PutText(wr, "\n");
 END BeginDrawing;
  
PROCEDURE EndDrawing(wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "grestore\n");
    Wr.PutText(wr, "% Now we are back to the standard coord system.\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "end\n");
    Wr.PutText(wr, "\n");
  END EndDrawing;
  
PROCEDURE SetFont(wr: Wr.T; font: TEXT; size: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "/");
    Wr.PutText(wr, font);
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FR(size, 4));
    Wr.PutText(wr, " sfnt\n");
  END SetFont;

PROCEDURE SetTextColor(wr: Wr.T; r, g, b: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN 
    Wr.PutText(wr, FR(r, 3) & " " & FR(g, 3) & " " & FR(b, 3) & " " & " stc\n");
    Wr.Flush(wr);
  END SetTextColor;

PROCEDURE Label (
    wr: Wr.T; 
    txt: TEXT;
    x, y: LONG; 
    xAlign, yAlign: REAL := 0.0; 
    angle: REAL := 0.0;
  ) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    PutString(wr, txt, "?");
    Wr.PutText(wr, "\n");
    Wr.PutText(wr, FR(angle, 4));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FR(xAlign, 4));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FR(yAlign, 4));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(x * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(y * MM, 2));
    Wr.PutText(wr, " gshw\n");
  END Label;

PROCEDURE RoundJoinAndCaps(wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "% Round joints and caps:\n");
    Wr.PutText(wr, "1 setlinecap 1 setlinejoin\n");
    Wr.PutText(wr, "\n");
  END RoundJoinAndCaps;

PROCEDURE SetGridSize(wr: Wr.T; xN, yN: CARDINAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "/xn " & Fmt.Int(xN) & " def  % grid cells along x axis\n");
    Wr.PutText(wr, "/xstep xmax xmin sub xn div def  % x-size of grid cell\n");
    Wr.PutText(wr, "/yn " & Fmt.Int(yN) & " def  % grid cells along y axis\n");
    Wr.PutText(wr, "/ystep ymax ymin sub yn div def  % y-size of grid cell\n");
  END SetGridSize;

PROCEDURE SetLineColor(wr: Wr.T; r, g, b: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FR(r, 3) & " " & FR(g, 3) & " " & FR(b, 3) & " " & " setrgbcolor\n");
    Wr.Flush(wr);
  END SetLineColor;

PROCEDURE SetFillColor(wr: Wr.T; r, g, b: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FR(r, 3) & " " & FR(g, 3) & " " & FR(b, 3) & " " & " sfc\n");
    Wr.Flush(wr);
  END SetFillColor;

PROCEDURE SetLineWidth(wr: Wr.T; width: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FL(FLOAT(width, LONG) * MM, 3) & " setlinewidth\n");
    Wr.Flush(wr);
  END SetLineWidth;

PROCEDURE SetLineDashPattern(wr: Wr.T; READONLY pattern: ARRAY OF REAL; skip: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "[ ");
    FOR i := 0 TO LAST(pattern) DO
      Wr.PutText(wr, FL(FLOAT(pattern[i], LONG) * MM, 3));
      Wr.PutText(wr, " ");
    END;
    Wr.PutText(wr, "] ");
    Wr.PutText(wr, FL(FLOAT(skip, LONG) * MM, 3));
    Wr.PutText(wr, " setdash\n");
    Wr.Flush(wr);
  END SetLineDashPattern;

PROCEDURE Comment (wr: Wr.T; txt: TEXT) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "% " & txt & "\n");
    Wr.Flush(wr);
  END Comment;

PROCEDURE Frame (wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "%Draw frame around plot area:\n");
    Wr.PutText(wr, "gsave\n");
    Wr.PutText(wr, "% Assumes xmax, xmin, ymax, ymin are defined.\n");
    Wr.PutText(wr, "  initclip\n");
    Wr.PutText(wr, "  newpath\n");
    Wr.PutText(wr, "  xmin ymin moveto\n");
    Wr.PutText(wr, "  xmax ymin lineto\n");
    Wr.PutText(wr, "  xmax ymax lineto\n");
    Wr.PutText(wr, "  xmin ymax lineto\n");
    Wr.PutText(wr, "  xmin ymin lineto\n");
    Wr.PutText(wr, "  closepath stroke\n");
    Wr.PutText(wr, "grestore\n");
  END Frame;

PROCEDURE Segment (wr: Wr.T; xa, ya, xb, yb: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FL(xa * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(ya * MM, 2));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(xb * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(yb * MM, 2));
    Wr.PutText(wr, " segd\n");
    Wr.Flush(wr);
  END Segment;  

PROCEDURE Rectangle(wr: Wr.T; xlo, xhi, ylo, yhi: LONG; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FB(draw));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FB(fill));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(xlo * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(xhi * MM, 2));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(ylo * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(yhi * MM, 2));
    Wr.PutText(wr, " recf\n");
    Wr.Flush(wr);
  END Rectangle;

PROCEDURE Triangle (wr: Wr.T; xa, ya, xb, yb, xc, yc: LONG; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FB(draw));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FB(fill));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(xa * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(ya * MM, 2));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(xb * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(yb * MM, 2));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(xc * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(yc * MM, 2));
    Wr.PutText(wr, " trif\n");
    Wr.Flush(wr);
  END Triangle;

PROCEDURE Circle (wr: Wr.T; xc, yc, radius: LONG; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FB(draw));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FB(fill));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(xc * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(yc * MM, 2));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(radius * MM, 2));
    Wr.PutText(wr, " cirf\n");
    Wr.Flush(wr);
  END Circle;

PROCEDURE Ellipse(wr: Wr.T; xc, yc, xa, ya, xb, yb: LONG; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FB(draw));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FB(fill));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(xc * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(yc * MM, 2));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(xa * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(ya * MM, 2));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FL(xb * MM, 2));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FL(yb * MM, 2));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, " elpf\n");
    Wr.Flush(wr);
  END Ellipse;

PROCEDURE GridCell (wr: Wr.T; xi, yi: CARDINAL; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FB(draw));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FB(fill));
    Wr.PutText(wr, "  ");
    Wr.PutText(wr, FIP(xi, 3));
    Wr.PutText(wr, " ");
    Wr.PutText(wr, FIP(yi, 3));
    Wr.PutText(wr, " celf\n");
    Wr.Flush(wr);
  END GridCell;

PROCEDURE CoordLine (wr: Wr.T; axis: Axis; coord: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, FL(coord * MM, 2));
    Wr.PutText(wr, " ");
    IF axis = Axis.X THEN
      Wr.PutText(wr, "xgrd")
    ELSE
      Wr.PutText(wr, "ygrd")
    END;
    Wr.PutText(wr, "\n");
  END CoordLine;

PROCEDURE GridLines (wr: Wr.T) = 
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, "% Grid lines:\n");
    Wr.PutText(wr, "gsave\n");
    Wr.PutText(wr, "  initclip\n");
    Wr.PutText(wr, "  0 1 xn {\n");
    Wr.PutText(wr, "    xstep mul xmin add xgrd\n");
    Wr.PutText(wr, "  } for\n");
    Wr.PutText(wr, "  0 1 yn {\n");
    Wr.PutText(wr, "    ystep mul ymin add ygrd\n");
    Wr.PutText(wr, "  } for\n");
    Wr.PutText(wr, "grestore\n");
    Wr.PutText(wr, "\n");
    Wr.Flush(wr);
  END GridLines;
  
PROCEDURE PutString (wr: Wr.T; text: TEXT; newline: TEXT) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutChar(wr, '(');
    FOR i := 0 TO Text.Length(text) - 1 DO
      WITH c = Text.GetChar(text, i) DO
        IF c = '\n' THEN
          Wr.PutText(wr, newline)
        ELSIF c = '(' THEN
          Wr.PutChar(wr, '\\'); Wr.PutChar(wr, '(');
        ELSIF c = ')' THEN
          Wr.PutChar(wr, '\\'); Wr.PutChar(wr, ')');
        ELSIF c =  '\t' THEN
          Wr.PutChar(wr, ' '); Wr.PutChar(wr, ' ');
        ELSIF c =  '\\' THEN
          Wr.PutChar(wr, '\\'); Wr.PutChar(wr, '\\');
        ELSIF c < ' ' OR c > '~' THEN
          Wr.PutText(wr, "\\" & Fmt.Pad(Fmt.Int(ORD(c), base := 8), 3, '0'));
        ELSE
          Wr.PutChar(wr, c)
        END
      END
    END;
    Wr.PutText(wr, ")");
  END PutString;

PROCEDURE FIP(x: INTEGER; w: CARDINAL): TEXT =
  BEGIN
    RETURN Fmt.Pad(Fmt.Int(x), w)
  END FIP;

PROCEDURE FB(x: BOOL): TEXT = 
  BEGIN
    IF x THEN RETURN "t" ELSE RETURN "f" END
  END FB;

PROCEDURE FL(x: LONGREAL; d: CARDINAL): TEXT =
  BEGIN
    RETURN Fmt.LongReal(x, style := Fmt.Style.Fix, prec := d)
  END FL;

PROCEDURE FR(x: REAL; d: CARDINAL): TEXT =
  BEGIN
    RETURN Fmt.Real(x, style := Fmt.Style.Fix, prec := d)
  END FR;

<*UNUSED*>
PROCEDURE FLP(x: LONGREAL; d, w: CARDINAL): TEXT =
  BEGIN
    RETURN Fmt.Pad(Fmt.LongReal(x, style := Fmt.Style.Fix, prec := d), w)
  END FLP;

<*UNUSED*>
PROCEDURE FRP(x: REAL; d, w: CARDINAL): TEXT =
  BEGIN
    RETURN Fmt.Pad(Fmt.Real(x, style := Fmt.Style.Fix, prec := d), w)
  END FRP;

PROCEDURE Today(): TEXT =
  BEGIN
    WITH
      d = Date.FromTime(Time.Now(), Date.Local)
    DO
      RETURN
        Fmt.Pad(Fmt.Int(d.year - 1900), 2, '0') &
        "-" &
        Fmt.Pad(Fmt.Int(ORD(d.month)+1), 2, '0') &
        "-" &
        Fmt.Pad(Fmt.Int(d.day), 2, '0') &
        " " &
        Fmt.Pad(Fmt.Int(d.hour), 2, '0') &
        ":" &
        Fmt.Pad(Fmt.Int(d.minute), 2, '0') &
        ":" &
        Fmt.Pad(Fmt.Int(d.second), 2, '0')
    END
  END Today;

BEGIN
END PSWrite.
(****************************************************************************)
(*                                                                          *)
(* Copyright (C) 1995 Universidade Estadual de Campinas (UNICAMP)           *)
(*                                                                          *)
(* Authors:                                                                 *)
(*   Jorge Stolfi        - CS Dept, UNICAMP <stolfi@dcc.unicamp.br>         *)
(*                                                                          *)
(* This file can be freely used, distributed, and modified, provided that   *)
(*   this copyright and authorship notice is included in every copy or      *)
(*   derived version.                                                       *)
(*                                                                          *)
(* DISCLAIMER: This software is offered ``as is'', without any guarantee    *)
(*   as to fitness for any particular purpose.  Neither the copyright       *)
(*   holder nor the authors or their employers can be held responsible for  *)
(*   any damages that may result from its use.                              *)
(*                                                                          *)
(****************************************************************************)