(* Copyright (C) 1995 UNICAMP.  See notice at the end of this file.  *)
(* Last edited on 2001-11-16 18:01:53 by stolfi *)

MODULE PSWrite;

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

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 EPSF-2.0\n");
    Wr.PutText(wr, "%%Creator: PSPlot.m3 " & Today() & "\n");
    Wr.PutText(wr, "%%BoundingBox: ");
    FPut.LongReal(wr, xMin * MM, prec := 3, style := Fmt.Style.Fix);
    Wr.PutChar(wr, ' ');
    FPut.LongReal(wr, yMin * MM, prec := 3, style := Fmt.Style.Fix);
    Wr.PutChar(wr, ' ');
    FPut.LongReal(wr, xMax * MM, prec := 3, style := Fmt.Style.Fix);
    Wr.PutChar(wr, ' ');
    FPut.LongReal(wr, yMax * MM, prec := 3, style := Fmt.Style.Fix);
    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, "% Bezier arc operator:\n");
    Wr.PutText(wr, "%   /xa/ /ya/ /xb/ /yb/ /xc/ /yc/ /xd/ /yd/ bezd -> \n");
    Wr.PutText(wr, "/bezd\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "    newpath\n");
    Wr.PutText(wr, "      8 -2 roll moveto curveto\n");
    Wr.PutText(wr, "    stroke\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Dot operator:\n");
    Wr.PutText(wr, "%   /xc/ /yc/ /size/ dotd --> \n");
    Wr.PutText(wr, "/dotd\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "    newpath\n");
    Wr.PutText(wr, "      currentlinewidth mul\n");
    Wr.PutText(wr, "      0 360 arc\n");
    Wr.PutText(wr, "    closepath\n");
    Wr.PutText(wr, "    fill\n");
    Wr.PutText(wr, "  grestore\n");
    Wr.PutText(wr, "} def\n");
    Wr.PutText(wr, "\n");

    Wr.PutText(wr, "% Arrowhead operator:\n");
    Wr.PutText(wr, "%   /dxa/ /dya/ /dxb/ /dyb/ /xt/ /yt/ arrd --> \n");
    Wr.PutText(wr, "/arrd\n");
    Wr.PutText(wr, "{\n");
    Wr.PutText(wr, "  gsave\n");
    Wr.PutText(wr, "    translate currentlinewidth dup scale\n");
    Wr.PutText(wr, "    newpath\n");
    Wr.PutText(wr, "      0 0 moveto\n");
    Wr.PutText(wr, "      lineto\n");
    Wr.PutText(wr, "      lineto\n");
    Wr.PutText(wr, "    closepath\n");
    Wr.PutText(wr, "    gsave eofill grestore 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 eofill 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 eofill 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 eofill 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");
      FPut.LongReal(wr, xMin * MM, prec := 3, style := Fmt.Style.Fix);
      Wr.PutText(wr, " ");
      FPut.LongReal(wr, yMin * MM, prec := 3, style := Fmt.Style.Fix);
      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, " ");
    FPut.Real(wr, size, prec := 4, style := Fmt.Style.Fix);
    Wr.PutText(wr, " sfnt\n");
  END SetFont;

PROCEDURE SetTextColor(wr: Wr.T; r, g, b: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN 
    FPut.Real(wr, r, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.Real(wr, g, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.Real(wr, b, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  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");
    FPut.Real(wr, angle, prec := 4, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.Real(wr, xAlign, prec := 4, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.Real(wr, yAlign, prec := 4, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, x * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, y * MM, prec := 2, style := Fmt.Style.Fix);
    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
    FPut.Real(wr, r, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.Real(wr, g, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.Real(wr, b, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  setrgbcolor\n");
    Wr.Flush(wr);
  END SetLineColor;

PROCEDURE SetFillColor(wr: Wr.T; r, g, b: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    FPut.Real(wr, r, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.Real(wr, g, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.Real(wr, b, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  sfc\n");
    Wr.Flush(wr);
  END SetFillColor;

PROCEDURE SetLineWidth(wr: Wr.T; width: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    FPut.LongReal(wr, FLOAT(width, LONG) * MM, prec := 3, style := Fmt.Style.Fix);
    Wr.PutText(wr, " 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
      FPut.LongReal(wr, FLOAT(pattern[i], LONG) * MM, prec := 3, style := Fmt.Style.Fix);
      Wr.PutText(wr, " ");
    END;
    Wr.PutText(wr, "] ");
    FPut.LongReal(wr, FLOAT(skip, LONG) * MM, prec := 3, style := Fmt.Style.Fix);
    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
    FPut.LongReal(wr, xa * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, ya * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, xb * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yb * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " segd\n");
    Wr.Flush(wr);
  END Segment;  

PROCEDURE Bezier(wr: Wr.T; xa, ya, xb, yb, xc, yc, xd, yd: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    FPut.LongReal(wr, xa * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, ya * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, xb * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yb * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, xc * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yc * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, xd * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yd * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " bezd\n");
    Wr.Flush(wr);
  END Bezier;  

PROCEDURE Dot (wr: Wr.T; xc, yc: LONG; size: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    FPut.LongReal(wr, xc * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yc * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.Real(wr, size, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " dotd\n");
    Wr.Flush(wr);
  END Dot;  

PROCEDURE Arrowhead (wr: Wr.T; xt, yt: LONG;  dxa, dya, dxb, dyb: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    FPut.LongReal(wr, dxa, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, dya, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, dxb, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, dyb, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, xt * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yt * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " arrd\n");
    Wr.Flush(wr);
  END Arrowhead;  

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, "  ");
    FPut.LongReal(wr, xlo * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, xhi * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, ylo * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yhi * MM, prec := 2, style := Fmt.Style.Fix);
    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, "  ");
    FPut.LongReal(wr, xa * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, ya * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, xb * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yb * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, xc * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yc * MM, prec := 2, style := Fmt.Style.Fix);
    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, "  ");
    FPut.LongReal(wr, xc * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yc * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, radius * MM, prec := 2, style := Fmt.Style.Fix);
    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, "  ");
    FPut.LongReal(wr, xc * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yc * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, xa * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, ya * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, "  ");
    FPut.LongReal(wr, xb * MM, prec := 2, style := Fmt.Style.Fix);
    Wr.PutText(wr, " ");
    FPut.LongReal(wr, yb * MM, prec := 2, style := Fmt.Style.Fix);
    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
    FPut.LongReal(wr, coord * MM, prec := 2, style := Fmt.Style.Fix);
    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 Today(): TEXT =
  BEGIN
    WITH
      d = Date.FromTime(Time.Now(), Date.Local)
    DO
      RETURN
        Fmt.Pad(Fmt.Int(d.year), 4, '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.                              *)
(*                                                                          *)
(****************************************************************************)