/* See pswrite.h */
/* Copyright (C) 1995 UNICAMP.  See notice at the end of this file.  */
/* Last edited on 2008-07-14 20:28:33 by stolfi */

#include <pswrite.h>
#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <affirm.h>

void pswrite_eps_header(
    FILE *psfile,
    double x_min_PS, double x_max_PS, 
    double y_min_PS, double y_max_PS
  )
  { char *date = today();
    
    fprintf(psfile, "%%!PS-Adobe-2.0 EPSF-2.0\n");
    fprintf(psfile, "%%%%BoundingBox: %.0f %.0f %.0f %.0f\n", 
      floor(x_min_PS), floor(y_min_PS), ceil(x_max_PS), ceil(y_max_PS)
    );
    fprintf(psfile, "%%%%CreationDate: %s\n", date);
    fprintf(psfile, "%%%%Pages: 1\n");
    fprintf(psfile, "%%%%EndComments\n");
    
    pswrite_define_procs(psfile, 1);
    fprintf(psfile, "%%%%EndProlog\n");
    fprintf(psfile, "\n");
    pswrite_page_header(psfile, 1, NULL);

    fflush(psfile);
  }

void pswrite_eps_trailer(FILE *psfile)
  {
    pswrite_page_trailer(psfile, 1);
    fprintf(psfile, "%%%%Trailer\n");
    fflush(psfile);
  }

void pswrite_ps_header(FILE *psfile, double x_page_size, double y_page_size)
  { char *date = today();
    
    fprintf(psfile, "%%!PS-Adobe-2.0\n");
    fprintf(psfile, "%%%%BoundingBox: %.0f %.0f %.0f %.0f\n", 
      0.0, 0.0, ceil(x_page_size), ceil(y_page_size)
    );
    fprintf(psfile, "%%%%CreationDate: %s\n", date);
    fprintf(psfile, "%%%%Pages: (atend)\n");
    fprintf(psfile, "%%%%End_comments\n");
    
    pswrite_define_procs(psfile, 0);
    
    fprintf(psfile, "%%%%End_prolog\n");
    fprintf(psfile, "\n");

    fflush(psfile);
  }

void pswrite_ps_trailer(FILE *psfile, int npages)
  {
    fprintf(psfile, "%%%%Trailer\n");
    fprintf(psfile, "%%%%Pages: %d\n", npages);
    fflush(psfile);
  }
  
void pswrite_define_procs(FILE *psfile, int epsformat)
  /*
    Defines the drawing procedures appropriate to the 
    specified file type. */
  {
    fprintf(psfile, "/psplot$dict 6400 dict def \n");
    fprintf(psfile, "psplot$dict begin\n");
    
    pswrite_define_draw_procs(psfile);
    if (! epsformat) pswrite_define_caption_procs(psfile);
    
    fprintf(psfile, "end\n");
  }

void pswrite_page_header(FILE *psfile, int page_num, char *page_label)
  {
    fprintf(psfile, "%%%%Page: %d", page_num);
    if (page_label != NULL) 
      { fprintf(psfile, " \"%s\"\n", page_label); }
    else
      { fprintf(psfile, " %d\n", page_num); }
    fprintf(psfile, "\n");

    fprintf(psfile, "psplot$dict begin\n");
    fprintf(psfile, "/savedstate save def\n");
    fflush(psfile);
  }

void pswrite_page_headline(FILE *psfile, int page_num, char *page_label, char *footline)
  {
    /* Footline with page number or label: */
    fprintf(psfile, "(");
    if (date != NULL) { fprintf(psfile, "%s ", date); }
    if (page_label != NULL)
      { fprintf(psfile, "page %s", page_label); }
    else
      { fprintf(psfile, "page %d", date, page_num); }
    fprintf(psfile, ") shhead\n");
    fflush(psfile);
  }

void pswrite_showpage(FILE *psfile)
  {
    fprintf(psfile, "showpage\n");
    fprintf(psfile, "\n");
  }

void pswrite_page_trailer(FILE *psfile)
  {
    fprintf(psfile, "savedstate restore\n");
    fprintf(psfile, "%% Now we are back to the standard coord system.\n");
    fprintf(psfile, "\n");
    fprintf(psfile, "end %% psplot$dict\n");
    fprintf(psfile, "\n");
    fflush(psfile);
  }
  
void pswrite_define_procs(FILE *psfile)
  {
    fprintf(psfile, "%% Footline printing operator:\n");
    fprintf(psfile, "%%   /string/ shfoot --> \n");
    fprintf(psfile, "/shfoot\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "  /Courier findfont\n");
    fprintf(psfile, "  8 scalefont setfont\n");
    fprintf(psfile, "  80 18 moveto\n");
    fprintf(psfile, "  show \n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Rectangle draw operator:\n");
    fprintf(psfile, "%%   /xlo/ /xhi/ /ylo/ /yhi/ recd --> \n");
    fprintf(psfile, "/recd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "  newpath\n");
    fprintf(psfile, "    3 index 2 index moveto\n");
    fprintf(psfile, "    2 index 2 index lineto\n");
    fprintf(psfile, "    2 index 1 index lineto\n");
    fprintf(psfile, "    3 index 1 index lineto\n");
    fprintf(psfile, "    pop pop pop pop\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Rectangle fill operator:\n");
    fprintf(psfile, "%%   /xlo/ /xhi/ /ylo/ /yhi/ /gray/ recf --> \n");
    fprintf(psfile, "/recf\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    setgray\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    3 index 2 index moveto\n");
    fprintf(psfile, "    2 index 2 index lineto\n");
    fprintf(psfile, "    2 index 1 index lineto\n");
    fprintf(psfile, "    3 index 1 index lineto\n");
    fprintf(psfile, "    pop pop pop pop\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    fill\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Rectangle fill and draw operator:\n");
    fprintf(psfile, "%%   /xlo/ /xhi/ /ylo/ /yhi/ /gray/ recfd --> \n");
    fprintf(psfile, "/recfd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    4 index 3 index moveto\n");
    fprintf(psfile, "    3 index 3 index lineto\n");
    fprintf(psfile, "    3 index 2 index lineto\n");
    fprintf(psfile, "    4 index 2 index lineto\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    gsave setgray fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "    pop pop pop pop\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Polygon draw operator:\n");
    fprintf(psfile, "%%   /x1/ /y1/ .. /xn/ /yn/ /n/ pold --> \n");
    fprintf(psfile, "/pold\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    3 1 roll moveto\n");
    fprintf(psfile, "    1 sub 1 1  3 2 roll { pop lineto } for\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Polygon fill operator:\n");
    fprintf(psfile, "%%   /x1/ /y1/ .. /xn/ /yn/ /n/ /gray/ polf --> \n");
    fprintf(psfile, "/polf\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    setgray\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    3 1 roll moveto\n");
    fprintf(psfile, "    1 sub 1 1  3 2 roll { pop lineto } for\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    fill\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Polygon fill and draw operator:\n");
    fprintf(psfile, "%%   /x1/ /y1/ .. /xn/ /yn/ /n/ /gray/ polfd --> \n");
    fprintf(psfile, "/polfd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    4 2 roll moveto\n");
    fprintf(psfile, "    exch 1 sub\n");
    fprintf(psfile, "    %% -- /x1/ /y1/ .. /x[n-1]/ /y[n-1]/ /gray/ /n-1/\n");
    fprintf(psfile, "    1 1  3 2 roll { pop 3 1 roll lineto } for\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    gsave setgray fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Circle fill operator:\n");
    fprintf(psfile, "%%   /x/ /y/ /radius/ /gray/ cirf --> \n");
    fprintf(psfile, "/cirf\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    setgray\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      0 360 arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "    fill\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Circle draw operator:\n");
    fprintf(psfile, "%%   /x/ /y/ /radius/ cird --> \n");
    fprintf(psfile, "/cird\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      0 360 arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Circle fill and draw operator:\n");
    fprintf(psfile, "%%   /x/ /y/ /radius/ /gray/ cirfd --> \n");
    fprintf(psfile, "/cirfd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    4 1 roll\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      0 360 arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "      gsave setgray fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Lune fill and draw operator:\n");
    fprintf(psfile, "%%   /xc/ /yc/ /rad/ /tilt/ /gray/ lunefd --> \n");
    fprintf(psfile, "/lunefd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    5 1 roll\n");
    fprintf(psfile, "    %% --- gray, xc, yc, rad, tilt\n");
    fprintf(psfile, "    4 2 roll\n");
    fprintf(psfile, "    %% --- gray, rad, tilt, xc, yc\n");
    fprintf(psfile, "    translate\n");
    fprintf(psfile, "    %% --- gray, rad, tilt\n");
    fprintf(psfile, "    rotate\n");
    fprintf(psfile, "    %% --- gray, rad \n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      dup\n");
    fprintf(psfile, "      %% --- gray, rad, rad\n");
    fprintf(psfile, "      dup neg 0\n");
    fprintf(psfile, "      %% --- gray, rad, rad, -rad, 0\n");
    fprintf(psfile, "      3 2 roll 2 mul\n");
    fprintf(psfile, "      %% --- gray, rad, -rad, 0, 2*rad\n");
    fprintf(psfile, "      -60 60 arc\n");
    fprintf(psfile, "      %% --- gray, rad\n");
    fprintf(psfile, "      dup 0\n");
    fprintf(psfile, "      %% --- gray, rad, rad, 0\n");
    fprintf(psfile, "      3 2 roll 2 mul\n");
    fprintf(psfile, "      %% --- gray, rad, 0, 2*rad\n");
    fprintf(psfile, "      120 240 arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "      gsave setgray fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Cell fill operator:\n");
    fprintf(psfile, "%%   /xi/ /yi/ celf --> \n");
    fprintf(psfile, "/celf\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  3 1 roll \n");
    fprintf(psfile, "  exch dup \n");
    fprintf(psfile, "  xstep mul xmin add exch 1 add xstep mul xmin add\n");
    fprintf(psfile, "  3 2 roll dup\n");
    fprintf(psfile, "  ystep mul ymin add exch 1 add ystep mul ymin add\n");
    fprintf(psfile, "  5 4 roll \n");
    fprintf(psfile, "  recf\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Triangle fill operator:\n");
    fprintf(psfile, "%%   /xa/ /ya/ /xb/ /yb/ /xc/ /yc/ /gray/ trif --> \n");
    fprintf(psfile, "/trif\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    setgray\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    moveto\n");
    fprintf(psfile, "    lineto\n");
    fprintf(psfile, "    lineto\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    fill\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

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

    fprintf(psfile, "%% Curve draw operator:\n");
    fprintf(psfile, "%%   /xa/ /ya/  /xb/ /yb/  /xc/ /yc/  /xd/ /yd/ arcd --> \n");
    fprintf(psfile, "/arcd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      8 -2 roll moveto curveto\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

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

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

    fprintf(psfile, "%% Label printing operator:\n");
    fprintf(psfile, "%%   /str/ /xa/ /ya/ /xc/ /yc/ lbsh --> \n");
    fprintf(psfile, "/lbsh\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  labelfont setfont\n");
    fprintf(psfile, "  newpath moveto\n");
    fprintf(psfile, "    %% --- str, xa, ya\n");
    fprintf(psfile, "  gsave 2 index false charpath flattenpath pathbbox grestore\n");
    fprintf(psfile, "    %% --- str, xa, ya, lox, loy, hix, hiy\n");
    fprintf(psfile, "  3 index 3 index currentpoint \n");
    fprintf(psfile, "    %% --- str, xa, ya, lox, loy, hix, hiy, lox, loy, cx, cy\n");
    fprintf(psfile, "  exch 4 1 roll exch sub\n");
    fprintf(psfile, "  3 1 roll sub exch\n");
    fprintf(psfile, "    %% --- str, xa, ya, lox, loy, hix, hiy, cx-lox, cy-loy\n");
    fprintf(psfile, "  rmoveto\n");
    fprintf(psfile, "    %% --- str, xa, ya, lox, loy, hix, hiy\n");
    fprintf(psfile, "  exch 4 1 roll exch sub \n");
    fprintf(psfile, "  3 1 roll sub exch\n");
    fprintf(psfile, "    %% --- str, xa, ya, dx, dy\n");
    fprintf(psfile, "  exch 4 1 roll mul -1 mul\n");
    fprintf(psfile, "  3 1 roll mul -1 mul exch\n");
    fprintf(psfile, "    %% --- str, -dx*xa, -dy*ya\n");
    fprintf(psfile, "  rmoveto\n");
    fprintf(psfile, "    %% --- str\n");
    fprintf(psfile, "  show\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fflush(psfile);
  }

void pswrite_define_caption_procs(FILE *psfile)
  {
    fprintf(psfile, "%% Operator to move to new caption line:\n");
    fprintf(psfile, "%%   nl --> \n");
    fprintf(psfile, "/nl\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  /ytext ytext dytext sub def\n");
    fprintf(psfile, "  xtext ytext moveto\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Operator to print string at CP without clipping:\n");
    fprintf(psfile, "%%   /s/ shw --> \n");
    fprintf(psfile, "/shw\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    initclip\n");
    fprintf(psfile, "    captionfont setfont show\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fflush(psfile);
  }


void pswrite_set_pen(
    FILE *psfile,
    double width,
    double dashlength,
    double dashspace
  )
  {
    fprintf(psfile, "mm %.3f mul setlinewidth\n", width);
    if ((dashlength == 0.0) | (dashspace == 0.0))
      { fprintf(psfile, "[ ] 0 setdash\n"); }
    else
      { fprintf(psfile,
          "[ %.3f mm mul %.3f mm mul ] 0 setdash\n",
          dashlength, dashspace
        );
      }
    fprintf(psfile, "\n");
    fflush(psfile);
  }
  
void pswrite_draw_frame (FILE *psfile)
  {
    pswrite_begin_section(psfile, "Draw frame around plot area");
    fprintf(psfile, "gsave\n");
    fprintf(psfile, "%% Assumes xmax, xmin, ymax, ymin are defined.\n");
    fprintf(psfile, "  initclip\n");
    fprintf(psfile, "  newpath\n");
    fprintf(psfile, "  xmin ymin moveto\n");
    fprintf(psfile, "  xmax ymin lineto\n");
    fprintf(psfile, "  xmax ymax lineto\n");
    fprintf(psfile, "  xmin ymax lineto\n");
    fprintf(psfile, "  xmin ymin lineto\n");
    fprintf(psfile, "  closepath stroke\n");
    fprintf(psfile, "grestore\n");
    pswrite_end_section(psfile);
  }


void pswrite_add_caption(FILE *psfile, char *txt)
  {
    fprintf(psfile, "nl ");
    pswrite_put_text(psfile, txt, ") shw\nnl (");
    fprintf(psfile, " shw\n");
    fflush(psfile);
  }
  
void pswrite_set_label_font(FILE *psfile, char *font, float size)
  {
    fprintf(psfile, "%% Label font setup:\n");
    fprintf(psfile, "/labelfont\n");
    fprintf(psfile, "  /%s findfont %.3f pt mul scalefont\n", font, size);
    fprintf(psfile, "def\n");
    fprintf(psfile, "\n");
    fflush(psfile);
  }

MODULE PSWrite;

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

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

void EPSFile_header(wr: Wr.T; x_min, x_max, y_min, y_max: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "%%!PS-Adobe-2.0 EPSF-2.0\n");
    fprintf(psfile, "%%%%Creator: pswrite.c " & Today() & "\n");
    fprintf(psfile, "%%%%BoundingBox: ");
    FPut.Long_real(wr, x_min * MM, prec = 3, style = Fmt.Style.Fix);
    Wr.Put_char(wr, ' ');
    FPut.Long_real(wr, y_min * MM, prec = 3, style = Fmt.Style.Fix);
    Wr.Put_char(wr, ' ');
    FPut.Long_real(wr, x_max * MM, prec = 3, style = Fmt.Style.Fix);
    Wr.Put_char(wr, ' ');
    FPut.Long_real(wr, y_max * MM, prec = 3, style = Fmt.Style.Fix);
    Wr.Put_char(wr, '\n');
    fprintf(psfile, "%%%%EndComments\n");
    
    fprintf(psfile, "/$maindict 6400 dict def \n");
    fprintf(psfile, "$maindict begin\n");
    
    fprintf(psfile, "end\n");
    fprintf(psfile, "%%%%EndProlog\n");

    void_definitions(wr);
    Wr.Flush(wr);
  } EPSFile_header;

void EPSFile_trailer (wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "%%%%Trailer\n");
    fprintf(psfile, "%%%%Pages: %d\n", npages);
    fprintf(psfile, "%%%%EOF\n");
    Wr.Flush(wr);
  } EPSFile_trailer;
  
void PSFile_header(wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "%%!PS-Adobe-2.0\n");
    fprintf(psfile, "%%%%Creator: PSPlot.m3 " & Today() & "\n");
    fprintf(psfile, "%%%%Pages: (atend)\n");
    fprintf(psfile, "%%%%EndComments\n");
    
    fprintf(psfile, "/$maindict 6400 dict def \n");
    fprintf(psfile, "$maindict begin\n");

    void_definitions(wr);
    Wr.Flush(wr);
  } PSFile_header;
  
void PSPage_header (wr: Wr.T; page, foot: TEXT) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "%%%%Page: " & page & " " & page & "\n");
    fprintf(psfile, "\n");
    fprintf(psfile, "%% Print date:\n");
    fprintf(psfile, "gsave\n");
    fprintf(psfile, "  /Courier findfont\n");
    fprintf(psfile, "  8 scalefont setfont\n");
    fprintf(psfile, "  80 18 moveto\n");
    fprintf(psfile, "  "); 
    Put_string(wr, foot & "   page " & page, "?"); 
    fprintf(psfile, " show\n");
    fprintf(psfile, "grestore\n");
    fprintf(psfile, "\n");
  } PSPage_header;

void void_definitions(wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    ?? fprintf(psfile, "%%%%BeginProcSet: psplot package\n");
  
    fprintf(psfile, "%% True and false:\n");
    fprintf(psfile, "/t true def /f false def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Set fill color operator:\n");
    fprintf(psfile, "%%   /R/ /G/ /B/ sfc --> \n");
    fprintf(psfile, "/sfc\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  /fillb exch def\n");
    fprintf(psfile, "  /fillg exch def\n");
    fprintf(psfile, "  /fillr exch def\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Set text color operator:\n");
    fprintf(psfile, "%%   /R/ /G/ /B/ stc --> \n");
    fprintf(psfile, "/stc\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  /textb exch def\n");
    fprintf(psfile, "  /textg exch def\n");
    fprintf(psfile, "  /textr exch def\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Polygon fill and draw operator:\n");
    fprintf(psfile, "%%   /x1/ /y1/ .. /xn/ /yn/ /n/ /R/ /G/ /B/ polfd --> \n");
    fprintf(psfile, "/polfd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    6 4 roll moveto\n");
    fprintf(psfile, "    4 3 roll 1 sub\n");
    fprintf(psfile, "    %% -- /x1/ /y1/ .. /x[n-1]/ /y[n-1]/ /R/ /G/ /B/ /n-1/\n");
    fprintf(psfile, "    1 1  3 2 roll { pop 5 3 roll lineto } for\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    gsave setrgbcolor fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Lune fill and draw operator:\n");
    fprintf(psfile, "%%   /xc/ /yc/ /rad/ /tilt/ /R/ /G/ /B/ lunefd --> \n");
    fprintf(psfile, "/lunefd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    7 3 roll\n");
    fprintf(psfile, "    %% --- R, G, B, xc, yc, rad, tilt\n");
    fprintf(psfile, "    4 2 roll\n");
    fprintf(psfile, "    %% --- R, G, B, rad, tilt, xc, yc\n");
    fprintf(psfile, "    translate\n");
    fprintf(psfile, "    %% --- R, G, B, rad, tilt\n");
    fprintf(psfile, "    rotate\n");
    fprintf(psfile, "    %% --- R, G, B, rad \n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      dup\n");
    fprintf(psfile, "      %% --- R, G, B, rad, rad\n");
    fprintf(psfile, "      dup neg 0\n");
    fprintf(psfile, "      %% --- R, G, B, rad, rad, -rad, 0\n");
    fprintf(psfile, "      3 2 roll 2 mul\n");
    fprintf(psfile, "      %% --- R, G, B, rad, -rad, 0, 2*rad\n");
    fprintf(psfile, "      -60 60 arc\n");
    fprintf(psfile, "      %% --- R, G, B, rad\n");
    fprintf(psfile, "      dup 0\n");
    fprintf(psfile, "      %% --- R, G, B, rad, rad, 0\n");
    fprintf(psfile, "      3 2 roll 2 mul\n");
    fprintf(psfile, "      %% --- R, G, B, rad, 0, 2*rad\n");
    fprintf(psfile, "      120 240 arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "      gsave setrgbcolor fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Slice fill and draw operator:\n");
    fprintf(psfile, "%%   /xc/ /yc/ /rad/ /start/ /stop/ /R/ /G/ /B/ slicefd --> \n");
    fprintf(psfile, "/slicefd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    8 3 roll\n");
    fprintf(psfile, "    %% --- R, G, B, xc, yc, rad, start, stop\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      4 index 4 index moveto arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "    gsave setrgbcolor fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Curve draw operator:\n");
    fprintf(psfile, "%%   /xa/ /ya/  /xb/ /yb/  /xc/ /yc/  /xd/ /yd/ arcd --> \n");
    fprintf(psfile, "/arcd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      8 -2 roll moveto curveto\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

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

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

    fprintf(psfile, "%% Arrowhead operator:\n");
    fprintf(psfile, "%%   /dxa/ /dya/ /dxb/ /dyb/ /xt/ /yt/ arrd --> \n");
    fprintf(psfile, "/arrd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    translate currentlinewidth dup scale\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      0 0 moveto\n");
    fprintf(psfile, "      lineto\n");
    fprintf(psfile, "      lineto\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    { gsave eofill grestore } stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

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

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

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

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

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

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

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

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

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

    ?? fprintf(psfile, "%%%%EndProcSet\n");
    fprintf(psfile, "\n");

    Wr.Flush(wr);
  } void_definitions;

void PSPage_trailer (wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "showpage\n");
    fprintf(psfile, "%%%%EndPage\n");
    fprintf(psfile, "\n");
    Wr.Flush(wr);
  } PSPage_trailer;

void PSFile_trailer (wr: Wr.T; pages: TEXT) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "%%%%Trailer\n");
    fprintf(psfile, "%%%%Pages: " & pages & "\n");
    fprintf(psfile, "%%%%EOF\n");
    Wr.Flush(wr);
  } PSFile_trailer;
  
void {_drawing(wr: Wr.T; x_min, x_max, y_min, y_max: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "30 dict begin\n");
    fprintf(psfile, "gsave\n");

    IF x_min # 0.0d0 OR y_min # 0.0d0 THEN
      fprintf(psfile, "%% Set origin at corner of drawing area:\n");
      FPut.Long_real(wr, x_min * MM, prec = 3, style = Fmt.Style.Fix);
      fprintf(psfile, " ");
      FPut.Long_real(wr, y_min * MM, prec = 3, style = Fmt.Style.Fix);
      fprintf(psfile, " translate\n");
    };
      
    fprintf(psfile, "/xmin 0 def  %% min plottable x\n");
    fprintf(psfile, "/xmax " & FL((x_max - x_min) * MM, 3) & " def  %% max plottable x\n");

    fprintf(psfile, "/ymin 0 def  %% min plottable y\n");
    fprintf(psfile, "/ymax " & FL((y_max - y_min) * MM, 3) & " def  %% max plottable y\n");
    
    fprintf(psfile, "%% Units of measure:\n");
    fprintf(psfile, "/pt 1.0 def\n");
    fprintf(psfile, "/in pt 72.0 mul def \n");
    fprintf(psfile, "/mm pt 72.0 25.4 div mul def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Set clipping path to boundary of plot area:\n");
    fprintf(psfile, "newpath\n");
    fprintf(psfile, "  xmin ymin moveto\n");
    fprintf(psfile, "  xmax ymin lineto\n");
    fprintf(psfile, "  xmax ymax lineto\n");
    fprintf(psfile, "  xmin ymax lineto\n");
    fprintf(psfile, "  xmin ymin lineto\n");
    fprintf(psfile, "clip\n");
    fprintf(psfile, "\n");
 } Begin_drawing;
  
void End_drawing(wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "grestore\n");
    fprintf(psfile, "%% Now we are back to the standard coord system.\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "end\n");
    fprintf(psfile, "\n");
  } End_drawing;
  
void Set_font(wr: Wr.T; font: TEXT; size: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "/");
    fprintf(psfile, font);
    fprintf(psfile, " ");
    FPut.Real(wr, size, prec = 4, style = Fmt.Style.Fix);
    fprintf(psfile, " sfnt\n");
  } Set_font;

void Set_text_color(wr: Wr.T; R, G, B: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  { 
    FPut.Real(wr, R, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Real(wr, G, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Real(wr, B, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, "  stc\n");
    Wr.Flush(wr);
  END Set_text_color;

void Label (
    wr: Wr.T; 
    txt: TEXT;
    x, y: LONG; 
    x_align, y_align: REAL = 0.0; 
    angle: REAL = 0.0;
  ) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    Put_string(wr, txt, "?");
    fprintf(psfile, "\n");
    FPut.Real(wr, angle, prec = 4, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Real(wr, x_align, prec = 4, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Real(wr, y_align, prec = 4, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, x * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, y * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " gshw\n");
  } Label;

void Round_join_and_caps(wr: Wr.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "%% Round joints and caps:\n");
    fprintf(psfile, "1 setlinecap 1 setlinejoin\n");
    fprintf(psfile, "\n");
  } Round_join_and_caps;

void Set_grid_size(wr: Wr.T; x_n, y_n: CARDINAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "/xn " & Fmt.Int(x_n) & " def  %% grid cells along x axis\n");
    fprintf(psfile, "/xstep xmax xmin sub xn div def  %% x-size of grid cell\n");
    fprintf(psfile, "/yn " & Fmt.Int(y_n) & " def  %% grid cells along y axis\n");
    fprintf(psfile, "/ystep ymax ymin sub yn div def  %% y-size of grid cell\n");
  } Set_grid_size;

void Set_line_color(wr: Wr.T; R, G, B: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    FPut.Real(wr, R, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Real(wr, G, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Real(wr, B, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, "  setrgbcolor\n");
    Wr.Flush(wr);
  } Set_line_color;

void Set_fill_color(wr: Wr.T; R, G, B: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    FPut.Real(wr, R, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Real(wr, G, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Real(wr, B, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, "  sfc\n");
    Wr.Flush(wr);
  } Set_fill_color;

void Set_line_width(wr: Wr.T; width: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    FPut.Long_real(wr, FLOAT(width, LONG) * MM, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, " setlinewidth\n");
    Wr.Flush(wr);
  } Set_line_width;

void Set_line_dash_pattern(wr: Wr.T; READONLY pattern: ARRAY OF REAL; skip: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "[ ");
    FOR i = 0 TO LAST(pattern) DO
      FPut.Long_real(wr, FLOAT(pattern[i], LONG) * MM, prec = 3, style = Fmt.Style.Fix);
      fprintf(psfile, " ");
    };
    fprintf(psfile, "] ");
    FPut.Long_real(wr, FLOAT(skip, LONG) * MM, prec = 3, style = Fmt.Style.Fix);
    fprintf(psfile, " setdash\n");
    Wr.Flush(wr);
  } Set_line_dash_pattern;

void Comment (wr: Wr.T; txt: TEXT) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, "% " & txt & "\n");
    Wr.Flush(wr);
  } Comment;

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

void Segment (wr: Wr.T; xa, ya, xb, yb: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    FPut.Long_real(wr, xa * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, ya * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xb * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, yb * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " segd\n");
    Wr.Flush(wr);
  } Segment;  

void Dot (wr: Wr.T; xc, yc: LONG; size: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    FPut.Long_real(wr, xc * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, yc * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Real(wr, size, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " dotd\n");
    Wr.Flush(wr);
  } Dot;  

void Arrowhead (wr: Wr.T; xt, yt: LONG;  dxa, dya, dxb, dyb: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    FPut.Long_real(wr, dxa, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, dya, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, dxb, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, dyb, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xt * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, yt * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " arrd\n");
    Wr.Flush(wr);
  } Arrowhead;  

void Rectangle(wr: Wr.T; xlo, xhi, ylo, yhi: LONG; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, FB(draw));
    fprintf(psfile, " ");
    fprintf(psfile, FB(fill));
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xlo * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, xhi * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, ylo * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, yhi * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " recf\n");
    Wr.Flush(wr);
  } Rectangle;

void Triangle (wr: Wr.T; xa, ya, xb, yb, xc, yc: LONG; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, FB(draw));
    fprintf(psfile, " ");
    fprintf(psfile, FB(fill));
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xa * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, ya * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xb * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, yb * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xc * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, yc * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " trif\n");
    Wr.Flush(wr);
  } Triangle;

void Circle (wr: Wr.T; xc, yc, radius: LONG; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, FB(draw));
    fprintf(psfile, " ");
    fprintf(psfile, FB(fill));
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xc * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, yc * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, radius * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " cirf\n");
    Wr.Flush(wr);
  } Circle;
  
void ps_setup_caption_data(FILE *psfile)
  {
    fprintf(psfile, "%% Caption text cursor:\n");
    fprintf(psfile, "/xtext xmin def\n");
    fprintf(psfile, "/ytext ymin def\n");
    fprintf(psfile, "/dytext 10 pt mul def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Caption font setup:\n");
    fprintf(psfile, "/captionfont\n");
    fprintf(psfile, "  /Courier findfont\n");
    fprintf(psfile, "  dytext scalefont\n");
    fprintf(psfile, "def\n");
    fprintf(psfile, "\n");
  }
  
void ps_set_label_font(FILE *psfile, char *font, float size)
  {
    fprintf(psfile, "%% Label font setup:\n");
    fprintf(psfile, "/labelfont\n");
    fprintf(psfile, "  /%s findfont %.3f pt mul scalefont\n", font, size);
    fprintf(psfile, "def\n");
    fprintf(psfile, "\n");
    fflush(psfile);
  }
  
void ps_put_label(
    FILE *psfile, 
    char *text, 
    double x, double y, 
    float xalign, float yalign
  )
  {
    double psx == ps_hmin + ps_xscale * (x - ps_xmin);
    double psy == ps_vmin + ps_yscale * (y - ps_ymin);
    ps_put_text(psfile, text, "\\267");
    fprintf(psfile, " ");
    fprintf(psfile, "  %5.3f %5.3f  %6.1f %6.1f  lbsh\n",
      xalign, yalign, psx, psy
    );
    fflush(psfile);
  }

void ps_draw_curve(
    FILE *psfile,
    double xa, double ya,
    double xb, double yb,
    double xc, double yc,
    double xd, double yd
  )
  {
    double psxa == ps_hmin + ps_xscale * (xa - ps_xmin);
    double psya == ps_vmin + ps_yscale * (ya - ps_ymin);
    double psxb == ps_hmin + ps_xscale * (xb - ps_xmin);
    double psyb == ps_vmin + ps_yscale * (yb - ps_ymin);
    double psxc == ps_hmin + ps_xscale * (xc - ps_xmin);
    double psyc == ps_vmin + ps_yscale * (yc - ps_ymin);
    double psxd == ps_hmin + ps_xscale * (xd - ps_xmin);
    double psyd == ps_vmin + ps_yscale * (yd - ps_ymin);
    fprintf(psfile, "%6.1f %6.1f  %6.1f %6.1f  %6.1f %6.1f  %6.1f %6.1f arcd\n",
      psxa, psya, psxb, psyb, psxc, psyc, psxd, psyd
    );
    fflush(psfile);
  }

void ps_aux_polygon(
    FILE *psfile,
    double x[], double y[],
    int npoints,
    double R, double G, double B,
    char *operator
  )
  {
    int i;
    if (npoints>6) fprintf(psfile, "\n");
    for (i=0; i<npoints; i++)
      {
        double psxi == ps_hmin + ps_xscale * (x[i] - ps_xmin);
        double psyi == ps_vmin + ps_yscale * (y[i] - ps_ymin);
        if ((i % 6) == 0) 
          { if (i>0) fprintf(psfile, "\n"); }
        else
          { fprintf(psfile, "  "); }
        fprintf(psfile, "%6.1f %6.1f", psxi, psyi);
      }
    if (npoints>6) fprintf(psfile, "\n");
    fprintf(psfile, "  %d", npoints);
    if (R >= 0.0) fprintf(psfile, "  %5.3f %5.3f %5.3f", R, G, B);
    fprintf(psfile, " %s\n", operator);
    fflush(psfile);
  }

void ps_draw_polygon(
    FILE *psfile,
    double x[], double y[],
    int npoints
  )
  {
    ps_aux_polygon(psfile, x, y, npoints, -1.0, -1.0, -1.0, "pold");
  }
  
void ps_aux_lune(
    FILE *psfile,
    double xc, double yc, double radius, double tilt,
    double R, double G, double B,
    char *operator
  )
  {
    double psxc == ps_hmin + ps_xscale * (xc - ps_xmin);
    double psyc == ps_vmin + ps_yscale * (yc - ps_ymin);
    double psradius == ps_yscale * radius;
    double pstilt == tilt * 180.0 / M_PI;
    fprintf(psfile, "%6.1f %6.1f  %6.1f %6.2f",
      psxc, psyc, psradius, pstilt); 
    if (R >= 0.0) fprintf(psfile, "  %5.3f %5.3f %5.3f", R, G, B);
    fprintf(psfile, " %s\n", operator);
    fflush(psfile);
  }

void ps_fill_and_draw_lune(
    FILE *psfile,
    double xc, double yc, double radius, double tilt,
    double R, double G, double B
  )
  {
    ps_aux_lune(psfile, xc, yc, radius, tilt, R, G, B, "lunefd");
  }
  
void ps_aux_slice(
    FILE *psfile,
    double xc, double yc, double radius, double start, double stop,
    double R, double G, double B,
    char *operator
  )
  {
    double psxc == ps_hmin + ps_xscale * (xc - ps_xmin);
    double psyc == ps_vmin + ps_yscale * (yc - ps_ymin);
    double psradius == ps_yscale * radius;
    double psstart == start * 180.0 / M_PI;
    double psstop  == stop  * 180.0 / M_PI;
    fprintf(psfile, "%6.1f %6.1f  %6.1f  %6.2f %6.2f",
      psxc, psyc, psradius, psstart, psstop); 
    if (R >= 0.0) fprintf(psfile, "  %5.3f %5.3f %5.3f", R, G, B);
    fprintf(psfile, " %s\n", operator);
    fflush(psfile);
  }

void ps_fill_and_draw_slice(
    FILE *psfile,
    double xc, double yc, double radius, double start, double stop,
    double R, double G, double B
  )
  {
    ps_aux_slice(psfile, xc, yc, radius, start, stop, R, G, B, "slicefd");
  }
    
void ps_aux_end_page(FILE *psfile)
  {
    fprintf(psfile, "savedstate restore\n");
    fprintf(psfile, "%% Now we are back to the standard coord system.\n");
    fprintf(psfile, "\n");
    fprintf(psfile, "end %% $maindict\n");
    fprintf(psfile, "\n");
    fflush(psfile);
  }

void ps_add_caption(FILE *psfile, char *txt)
  {
    fprintf(psfile, "nl ");
    ps_put_text(psfile, txt, ") shw\nnl (");
    fprintf(psfile, " shw\n");
    fflush(psfile);
  }
 
void Ellipse(wr: Wr.T; xc, yc, xa, ya, xb, yb: LONG; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, FB(draw));
    fprintf(psfile, " ");
    fprintf(psfile, FB(fill));
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xc * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, yc * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xa * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, ya * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    FPut.Long_real(wr, xb * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    FPut.Long_real(wr, yb * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, "  ");
    fprintf(psfile, " elpf\n");
    Wr.Flush(wr);
  } Ellipse;

void Grid_cell (wr: Wr.T; xi, yi: CARDINAL; fill, draw: BOOL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    fprintf(psfile, FB(draw));
    fprintf(psfile, " ");
    fprintf(psfile, FB(fill));
    fprintf(psfile, "  ");
    fprintf(psfile, FIP(xi, 3));
    fprintf(psfile, " ");
    fprintf(psfile, FIP(yi, 3));
    fprintf(psfile, " celf\n");
    Wr.Flush(wr);
  } Grid_cell;

void Coord_line (wr: Wr.T; axis: Axis; coord: LONG) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  {
    FPut.Long_real(wr, coord * MM, prec = 2, style = Fmt.Style.Fix);
    fprintf(psfile, " ");
    IF axis == Axis.X THEN
      fprintf(psfile, "xgrd")
    ELSE
      fprintf(psfile, "ygrd")
    };
    fprintf(psfile, "\n");
  } Coord_line;

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

void FIP(x: INTEGER; w: CARDINAL): TEXT =
  {
    RETURN Fmt.Pad(Fmt.Int(x), w)
  } FIP;

void FB(x: BOOL): TEXT == 
  {
    IF x THEN RETURN "t" ELSE RETURN "f" }
  } FB;

void FL(x: LONGREAL; d: CARDINAL): TEXT =
  {
    RETURN Fmt.Long_real(x, style = Fmt.Style.Fix, prec = d)
  } FL;

void Today(): TEXT =
  {
    WITH
      d == Date.From_time(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')
    }
  } Today;

{
} 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.                              */
/*                                                                          */
/****************************************************************************/


void ps_end_figure(FILE *psfile)
  {
    ps_aux_end_page(psfile);
    fprintf(psfile, "%%%%Trailer\n");
    fflush(psfile);
  }

void ps_begin_document(FILE *psfile, const char *papersize)
  {
    fprintf(psfile, "%%!PS-Adobe-2.0\n");
    fprintf(psfile, "%%%%Pages: (atend)\n");
    fprintf(psfile, "%%%%DocumentPaperSizes: %s\n", papersize);
    fprintf(psfile, "%%%%End_comments\n");
    
    fprintf(psfile, "/psplot$dict 6400 dict def \n");
    fprintf(psfile, "psplot$dict begin\n");
    
    ps_define_procs(psfile);
    ps_define_caption_procs(psfile);
    
    fprintf(psfile, "end\n");
    fprintf(psfile, "%%%%End_prolog\n");

    fflush(psfile);
  }

void ps_end_document(FILE *psfile, int npages)
  {
    fprintf(psfile, "%%%%Trailer\n");
    fprintf(psfile, "%%%%Pages: %d\n", npages);
    fflush(psfile);
  }

void ps_begin_page(
    FILE *psfile,
    int page,
    double xmin, double xmax,
    double ymin, double ymax,

    double hmin, double hmax,
    double vmin, double vmax,

    int xn, int yn
  )
  {
    char *date = today();

    fprintf(stderr, "date = %s\n", date);
    
    ps_save_scales(
      xmin, xmax, ymin, ymax,
      hmin, hmax, vmin, vmax
    );

    fprintf(psfile, "%%%%Page: %d %d\n", page, page);
    fprintf(psfile, "\n");

    fprintf(psfile, "psplot$dict begin\n");
    fprintf(psfile, "/savedstate save def\n");

    fprintf(psfile, "%% Print date:\n");
    fprintf(psfile, "gsave\n");
    fprintf(psfile, "  /Courier findfont\n");
    fprintf(psfile, "  10 scalefont setfont\n");
    fprintf(psfile, "  80 18 moveto\n");
    fprintf(psfile, "  (%s   page %d) show\n", date, page);
    fprintf(psfile, "grestore\n");
    fprintf(psfile, "\n");

    ps_setup_page_state(psfile, xn, yn);
    ps_setup_caption_data(psfile);
  }

void ps_end_page(FILE *psfile)
  {
    fprintf(psfile, "showpage\n");
    fprintf(psfile, "\n");
    ps_aux_end_page(psfile);
  }

void ps_save_scales(
    double xmin, double xmax,
    double ymin, double ymax,

    double hmin, double hmax,
    double vmin, double vmax
  )
  {
    x_min_PS = hmin;
    x_max_PS = hmax;
    ps_xmin = xmin;
    ps_xmax = xmax;
    ps_xscale = (hmax - hmin)/(xmax - xmin);

    y_min_PS = vmin;
    y_max_PS = vmax;
    ps_ymin = ymin;
    ps_ymax = ymax;
    ps_yscale = (vmax - vmin)/(ymax - ymin);

    affirm (
      (fabs(ps_xscale - ps_yscale)/fabs(ps_xscale + ps_yscale) < 0.0001),
      "ps_begin_figure: unequal Postscript scales"
    );
  }

void ps_define_procs(FILE *psfile)
  {
    fprintf(psfile, "%% Rectangle draw operator:\n");
    fprintf(psfile, "%%   /xlo/ /xhi/ /ylo/ /yhi/ recd --> \n");
    fprintf(psfile, "/recd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "  newpath\n");
    fprintf(psfile, "    3 index 2 index moveto\n");
    fprintf(psfile, "    2 index 2 index lineto\n");
    fprintf(psfile, "    2 index 1 index lineto\n");
    fprintf(psfile, "    3 index 1 index lineto\n");
    fprintf(psfile, "    pop pop pop pop\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Rectangle fill operator:\n");
    fprintf(psfile, "%%   /xlo/ /xhi/ /ylo/ /yhi/ /R/ /G/ /B/ recf --> \n");
    fprintf(psfile, "/recf\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    setrgbcolor\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    3 index 2 index moveto\n");
    fprintf(psfile, "    2 index 2 index lineto\n");
    fprintf(psfile, "    2 index 1 index lineto\n");
    fprintf(psfile, "    3 index 1 index lineto\n");
    fprintf(psfile, "    pop pop pop pop\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    fill\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Rectangle fill and stroke operator:\n");
    fprintf(psfile, "%%   /xlo/ /xhi/ /ylo/ /yhi/ /R/ /G/ /B/ recfd --> \n");
    fprintf(psfile, "/recfd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    6 index 5 index moveto\n");
    fprintf(psfile, "    5 index 5 index lineto\n");
    fprintf(psfile, "    5 index 4 index lineto\n");
    fprintf(psfile, "    6 index 4 index lineto\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    gsave setrgbcolor fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "    pop pop pop pop\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Polygon draw operator:\n");
    fprintf(psfile, "%%   /x1/ /y1/ .. /xn/ /yn/ /n/ pold --> \n");
    fprintf(psfile, "/pold\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    3 1 roll moveto\n");
    fprintf(psfile, "    1 sub 1 1  3 2 roll { pop lineto } for\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Polygon fill operator:\n");
    fprintf(psfile, "%%   /x1/ /y1/ .. /xn/ /yn/ /n/ /R/ /G/ /B/ polf --> \n");
    fprintf(psfile, "/polf\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    setrgbcolor\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    3 1 roll moveto\n");
    fprintf(psfile, "    1 sub 1 1  3 2 roll { pop lineto } for\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    fill\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Polygon fill and draw operator:\n");
    fprintf(psfile, "%%   /x1/ /y1/ .. /xn/ /yn/ /n/ /R/ /G/ /B/ polfd --> \n");
    fprintf(psfile, "/polfd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    6 4 roll moveto\n");
    fprintf(psfile, "    4 3 roll 1 sub\n");
    fprintf(psfile, "    %% -- /x1/ /y1/ .. /x[n-1]/ /y[n-1]/ /R/ /G/ /B/ /n-1/\n");
    fprintf(psfile, "    1 1  3 2 roll { pop 5 3 roll lineto } for\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    gsave setrgbcolor fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Circle fill operator:\n");
    fprintf(psfile, "%%   /x/ /y/ /radius/ /R/ /G/ /B/ cirf --> \n");
    fprintf(psfile, "/cirf\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    setrgbcolor\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      0 360 arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "    fill\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Circle draw operator:\n");
    fprintf(psfile, "%%   /x/ /y/ /radius/ cird --> \n");
    fprintf(psfile, "/cird\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      0 360 arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Circle fill and draw operator:\n");
    fprintf(psfile, "%%   /x/ /y/ /radius/ /R/ /G/ /B/ cirfd --> \n");
    fprintf(psfile, "/cirfd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    6 3 roll\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      0 360 arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "      gsave setrgbcolor fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Lune fill and draw operator:\n");
    fprintf(psfile, "%%   /xc/ /yc/ /rad/ /tilt/ /R/ /G/ /B/ lunefd --> \n");
    fprintf(psfile, "/lunefd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    7 3 roll\n");
    fprintf(psfile, "    %% --- R, G, B, xc, yc, rad, tilt\n");
    fprintf(psfile, "    4 2 roll\n");
    fprintf(psfile, "    %% --- R, G, B, rad, tilt, xc, yc\n");
    fprintf(psfile, "    translate\n");
    fprintf(psfile, "    %% --- R, G, B, rad, tilt\n");
    fprintf(psfile, "    rotate\n");
    fprintf(psfile, "    %% --- R, G, B, rad \n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      dup\n");
    fprintf(psfile, "      %% --- R, G, B, rad, rad\n");
    fprintf(psfile, "      dup neg 0\n");
    fprintf(psfile, "      %% --- R, G, B, rad, rad, -rad, 0\n");
    fprintf(psfile, "      3 2 roll 2 mul\n");
    fprintf(psfile, "      %% --- R, G, B, rad, -rad, 0, 2*rad\n");
    fprintf(psfile, "      -60 60 arc\n");
    fprintf(psfile, "      %% --- R, G, B, rad\n");
    fprintf(psfile, "      dup 0\n");
    fprintf(psfile, "      %% --- R, G, B, rad, rad, 0\n");
    fprintf(psfile, "      3 2 roll 2 mul\n");
    fprintf(psfile, "      %% --- R, G, B, rad, 0, 2*rad\n");
    fprintf(psfile, "      120 240 arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "      gsave setrgbcolor fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Slice fill and draw operator:\n");
    fprintf(psfile, "%%   /xc/ /yc/ /rad/ /start/ /stop/ /R/ /G/ /B/ slicefd --> \n");
    fprintf(psfile, "/slicefd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    8 3 roll\n");
    fprintf(psfile, "    %% --- R, G, B, xc, yc, rad, start, stop\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      4 index 4 index moveto arc\n");
    fprintf(psfile, "      closepath\n");
    fprintf(psfile, "    gsave setrgbcolor fill grestore\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Cell fill operator:\n");
    fprintf(psfile, "%%   /xi/ /yi/ /R/ /G/ /B/ celf --> \n");
    fprintf(psfile, "/celf\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  5 3 roll \n");
    fprintf(psfile, "  %% --- R, G, B, xi, yi\n");
    fprintf(psfile, "  exch dup \n");
    fprintf(psfile, "  %% --- R, G, B, yi, xi, xi\n");
    fprintf(psfile, "  xstep mul xmin add exch 1 add xstep mul xmin add\n");
    fprintf(psfile, "  %% --- R, G, B, yi, xlo, xhi\n");
    fprintf(psfile, "  3 2 roll dup\n");
    fprintf(psfile, "  %% --- R, G, B, xlo, xhi, yi, yi\n");
    fprintf(psfile, "  ystep mul ymin add exch 1 add ystep mul ymin add\n");
    fprintf(psfile, "  %% --- R, G, B, xlo, xhi, ylo, yhi\n");
    fprintf(psfile, "  7 4 roll \n");
    fprintf(psfile, "  recf\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Triangle fill operator:\n");
    fprintf(psfile, "%%   /xa/ /ya/ /xb/ /yb/ /xc/ /yc/ /R/ /G/ /B/ trif --> \n");
    fprintf(psfile, "/trif\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    setrgbcolor\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "    moveto\n");
    fprintf(psfile, "    lineto\n");
    fprintf(psfile, "    lineto\n");
    fprintf(psfile, "    closepath\n");
    fprintf(psfile, "    fill\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

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

    fprintf(psfile, "%% Curve draw operator:\n");
    fprintf(psfile, "%%   /xa/ /ya/  /xb/ /yb/  /xc/ /yc/  /xd/ /yd/ arcd --> \n");
    fprintf(psfile, "/arcd\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    newpath\n");
    fprintf(psfile, "      8 -2 roll moveto curveto\n");
    fprintf(psfile, "    stroke\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

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

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

    fprintf(psfile, "%% Label printing operator:\n");
    fprintf(psfile, "%%   /str/ /xa/ /ya/ /xc/ /yc/ lbsh --> \n");
    fprintf(psfile, "/lbsh\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  labelfont setfont\n");
    fprintf(psfile, "  newpath moveto\n");
    fprintf(psfile, "    %% --- str, xa, ya\n");
    fprintf(psfile, "  gsave 2 index false charpath flattenpath pathbbox grestore\n");
    fprintf(psfile, "    %% --- str, xa, ya, lox, loy, hix, hiy\n");
    fprintf(psfile, "  3 index 3 index currentpoint \n");
    fprintf(psfile, "    %% --- str, xa, ya, lox, loy, hix, hiy, lox, loy, cx, cy\n");
    fprintf(psfile, "  exch 4 1 roll exch sub\n");
    fprintf(psfile, "  3 1 roll sub exch\n");
    fprintf(psfile, "    %% --- str, xa, ya, lox, loy, hix, hiy, cx-lox, cy-loy\n");
    fprintf(psfile, "  rmoveto\n");
    fprintf(psfile, "    %% --- str, xa, ya, lox, loy, hix, hiy\n");
    fprintf(psfile, "  exch 4 1 roll exch sub \n");
    fprintf(psfile, "  3 1 roll sub exch\n");
    fprintf(psfile, "    %% --- str, xa, ya, dx, dy\n");
    fprintf(psfile, "  exch 4 1 roll mul -1 mul\n");
    fprintf(psfile, "  3 1 roll mul -1 mul exch\n");
    fprintf(psfile, "    %% --- str, -dx*xa, -dy*ya\n");
    fprintf(psfile, "  rmoveto\n");
    fprintf(psfile, "    %% --- str\n");
    fprintf(psfile, "  show\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fflush(psfile);
  }

void ps_define_caption_procs(FILE *psfile)
  {
    fprintf(psfile, "%% Operator to move to new caption line:\n");
    fprintf(psfile, "%%   nl --> \n");
    fprintf(psfile, "/nl\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  /ytext ytext dytext sub def\n");
    fprintf(psfile, "  xtext ytext moveto\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Operator to print string at CP without clipping:\n");
    fprintf(psfile, "%%   /s/ shw --> \n");
    fprintf(psfile, "/shw\n");
    fprintf(psfile, "{\n");
    fprintf(psfile, "  gsave\n");
    fprintf(psfile, "    initclip\n");
    fprintf(psfile, "    captionfont setfont show\n");
    fprintf(psfile, "  grestore\n");
    fprintf(psfile, "} def\n");
    fprintf(psfile, "\n");

    fflush(psfile);
  }

void ps_setup_page_state(FILE *psfile, int xn, int yn)
  {
    double fxn = xn;
    double fyn = yn;

    fprintf(psfile, "%% Round joints and caps:\n");
    fprintf(psfile, "1 setlinecap 1 setlinejoin\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Black thin lines:\n");
    fprintf(psfile, "0 setlinewidth 0 setgray [ ] 0 setdash\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "/xmin %f def   %% min plottable x\n", x_min_PS);
    fprintf(psfile, "/xmax %f def   %% max plottable x\n", x_max_PS);
    fprintf(psfile, "/xn %d def     %% grid cells along x axis\n", xn);
    fprintf(psfile, "/xstep %f def  %% x-size of grid cell\n", (x_max_PS-x_min_PS)/fxn);

    fprintf(psfile, "/ymin %f def   %% min plottable y\n", y_min_PS);
    fprintf(psfile, "/ymax %f def   %% max plottable y\n", y_max_PS);
    fprintf(psfile, "/yn %d def     %% grid cells along y axis\n", yn);
    fprintf(psfile, "/ystep %f def  %% y-size of grid cell\n", (y_max_PS-y_min_PS)/fyn);

    fprintf(psfile, "%% Units of measure:\n");
    fprintf(psfile, "/pt 1.0 def\n");
    fprintf(psfile, "/in pt 72.0 mul def \n");
    fprintf(psfile, "/mm pt 72.0 25.4 div mul def\n");
    fprintf(psfile, "\n");
    
    ps_set_label_font (psfile, "Courier", 8.0);    

    fprintf(psfile, "%% Set clipping path to boundary of plot area:\n");
    fprintf(psfile, "newpath\n");
    fprintf(psfile, "  xmin ymin moveto\n");
    fprintf(psfile, "  xmax ymin lineto\n");
    fprintf(psfile, "  xmax ymax lineto\n");
    fprintf(psfile, "  xmin ymax lineto\n");
    fprintf(psfile, "  xmin ymin lineto\n");
    fprintf(psfile, "clip\n");
    fprintf(psfile, "\n");

    fflush(psfile);
  }
  
void ps_setup_caption_data(FILE *psfile)
  {
    fprintf(psfile, "%% Caption text cursor:\n");
    fprintf(psfile, "/xtext xmin def\n");
    fprintf(psfile, "/ytext ymin def\n");
    fprintf(psfile, "/dytext 10 pt mul def\n");
    fprintf(psfile, "\n");

    fprintf(psfile, "%% Caption font setup:\n");
    fprintf(psfile, "/captionfont\n");
    fprintf(psfile, "  /Courier findfont\n");
    fprintf(psfile, "  dytext scalefont\n");
    fprintf(psfile, "def\n");
    fprintf(psfile, "\n");
  }
  
void ps_aux_end_page(FILE *psfile)
  {
    fprintf(psfile, "savedstate restore\n");
    fprintf(psfile, "%% Now we are back to the standard coord system.\n");
    fprintf(psfile, "\n");
    fprintf(psfile, "end %% psplot$dict\n");
    fprintf(psfile, "\n");
    fflush(psfile);
  }

void ps_begin_section(FILE *psfile, char *title)
  {
    fprintf(psfile, "%%%s\n", title);
    fprintf(stderr, "[%s]\n", title);
    fflush(psfile);
  }

void ps_end_section(FILE *psfile)
  {
    fprintf(psfile, "\n");
    fflush(psfile);
  }

void ps_add_caption(FILE *psfile, char *txt)
  {
    fprintf(psfile, "nl ");
    ps_put_text(psfile, txt, ") shw\nnl (");
    fprintf(psfile, " shw\n");
    fflush(psfile);
  }
  
void ps_set_label_font(FILE *psfile, char *font, float size)
  {
    fprintf(psfile, "%% Label font setup:\n");
    fprintf(psfile, "/labelfont\n");
    fprintf(psfile, "  /%s findfont %.3f pt mul scalefont\n", font, size);
    fprintf(psfile, "def\n");
    fprintf(psfile, "\n");
    fflush(psfile);
  }
  
void ps_put_label(
    FILE *psfile, 
    char *text, 
    double x, double y, 
    float xalign, float yalign
  )
  {
    double psx = x_min_PS + ps_xscale * (x - ps_xmin);
    double psy = y_min_PS + ps_yscale * (y - ps_ymin);
    ps_put_text(psfile, text, "\\267");
    fprintf(psfile, " ");
    fprintf(psfile, "  %5.3f %5.3f  %6.1f %6.1f  lbsh\n",
      xalign, yalign, psx, psy
    );
    fflush(psfile);
  }

void ps_draw_frame (FILE *psfile)
  {
    ps_begin_section(psfile, "Draw frame around plot area");
    fprintf(psfile, "gsave\n");
    fprintf(psfile, "%% Assumes xmax, xmin, ymax, ymin are defined.\n");
    fprintf(psfile, "  initclip\n");
    fprintf(psfile, "  newpath\n");
    fprintf(psfile, "  xmin ymin moveto\n");
    fprintf(psfile, "  xmax ymin lineto\n");
    fprintf(psfile, "  xmax ymax lineto\n");
    fprintf(psfile, "  xmin ymax lineto\n");
    fprintf(psfile, "  xmin ymin lineto\n");
    fprintf(psfile, "  closepath stroke\n");
    fprintf(psfile, "grestore\n");
    ps_end_section(psfile);
  }

void ps_set_pen(
    FILE *psfile,
    double R, double G, double B,
    double width,
    double dashlength,
    double dashspace
  )
  {
    fprintf(psfile, "%5.3f %5.3f %5.3f setrgbcolor\n", R, G, B);
    fprintf(psfile, "mm %.3f mul setlinewidth\n", width);
    if ((dashlength == 0.0) | (dashspace == 0.0))
      { fprintf(psfile, "[ ] 0 setdash\n"); }
    else
      { fprintf(psfile,
          "[ %.3f mm mul %.3f mm mul ] 0 setdash\n",
          dashlength, dashspace
        );
      }
    fprintf(psfile, "\n");
    fflush(psfile);
  }

void ps_draw_segment(
    FILE *psfile,
    double xa, double ya,
    double xb, double yb
  )
  {
    double psxa = x_min_PS + ps_xscale * (xa - ps_xmin);
    double psya = y_min_PS + ps_yscale * (ya - ps_ymin);
    double psxb = x_min_PS + ps_xscale * (xb - ps_xmin);
    double psyb = y_min_PS + ps_yscale * (yb - ps_ymin);
    fprintf(psfile,
      "%6.1f %6.1f  %6.1f %6.1f segd\n",
      psxa, psya, psxb, psyb
    );
    fflush(psfile);
  }

void ps_draw_curve(
    FILE *psfile,
    double xa, double ya,
    double xb, double yb,
    double xc, double yc,
    double xd, double yd
  )
  {
    double psxa = x_min_PS + ps_xscale * (xa - ps_xmin);
    double psya = y_min_PS + ps_yscale * (ya - ps_ymin);
    double psxb = x_min_PS + ps_xscale * (xb - ps_xmin);
    double psyb = y_min_PS + ps_yscale * (yb - ps_ymin);
    double psxc = x_min_PS + ps_xscale * (xc - ps_xmin);
    double psyc = y_min_PS + ps_yscale * (yc - ps_ymin);
    double psxd = x_min_PS + ps_xscale * (xd - ps_xmin);
    double psyd = y_min_PS + ps_yscale * (yd - ps_ymin);
    fprintf(psfile, "%6.1f %6.1f  %6.1f %6.1f  %6.1f %6.1f  %6.1f %6.1f arcd\n",
      psxa, psya, psxb, psyb, psxc, psyc, psxd, psyd
    );
    fflush(psfile);
  }
  
void ps_aux_rectangle(
    FILE *psfile,
    double xlo, double xhi,
    double ylo, double yhi,
    double R, double G, double B,
    char *operator
  )
  {
    double psxlo = x_min_PS + ps_xscale * (xlo - ps_xmin);
    double psxhi = x_min_PS + ps_xscale * (xhi - ps_xmin);
    double psylo = y_min_PS + ps_yscale * (ylo - ps_ymin);
    double psyhi = y_min_PS + ps_yscale * (yhi - ps_ymin);
    fprintf(psfile, "%6.1f %6.1f  %6.1f %6.1f",
      psxlo, psxhi, psylo, psyhi
    );
    if (R >= 0.0) fprintf(psfile, "  %5.3f %5.3f %5.3f", R, G, B);
    fprintf(psfile, " %s\n", operator);
    fflush(psfile);
  }

void ps_draw_rectangle(
    FILE *psfile,
    double xlo, double xhi,
    double ylo, double yhi
  )
  {
    ps_aux_rectangle(psfile, xlo, xhi, ylo, yhi, -1.0, -1.0, -1.0, "recd");
  }

void ps_fill_rectangle(
    FILE *psfile,
    double xlo, double xhi,
    double ylo, double yhi,
    double R, double G, double B
  )
  {
    ps_aux_rectangle(psfile, xlo, xhi, ylo, yhi, R, G, B, "recf");
  }
  
void pswrite_segment(...)
{
fprintf(psfile, "%6.1f %6.1f  %6.1f %6.1f segd\n",
        psxa, psya, psxb, psyb
      )
  }
void pswrite_curve(...)
{
      fprintf(psfile, "%6.1f %6.1f  %6.1f %6.1f  %6.1f %6.1f  %6.1f %6.1f arcd\n",
        psxa, psya, psxb, psyb, psxc, psyc, psxd, psyd
      );
  }


fprintf(psfile, "%6.1f %cgrd\n", pscoord, axis);

void ps_fill_and_draw_rectangle(
    FILE *psfile,
    double xlo, double xhi,
    double ylo, double yhi,
    double R, double G, double B
  )
  {
    ps_aux_rectangle(psfile, xlo, xhi, ylo, yhi, R, G, B, "recfd");
  }
        fprintf(psfile, "%6.1f %6.1f  %6.1f %6.1f";
          psxlo, psxhi, psylo, psyhi
        );
        if (gray >= 0.0) fprintf(psfile, "  %5.3f", gray);
        fprintf(psfile, " %s\n", operator);
        ???
        psplot_aux_rectangle(psfile, xlo, xhi, ylo, yhi, -1.0, "recd");
        psplot_aux_rectangle(psfile, xlo, xhi, ylo, yhi, gray, "recf");
        psplot_aux_rectangle(psfile, xlo, xhi, ylo, yhi, gray, "recfd");
        ???
        
          
fprintf(psfile,
          "%6.1f %6.1f  %6.1f %6.1f  %6.1f %6.1f  %5.3f trif\n",
          psxa, psya, psxb, psyb, psxc, psyc, gray
        );

        fprintf(psfile, "%6.1f %6.1f  %6.1f", psxc, psyc, psradius); 
        psplot_aux_circle(psfile, xc, yc, radius, gray, "cirf");
        psplot_aux_circle(psfile, xc, yc, radius, gray, "cirfd");
        if (gray >= 0.0) fprintf(psfile, "  %.4f", gray);
        fprintf(psfile, " %s\n", operator);

        fprintf(psfile, "%6.1f %6.1f  %6.1f %6.2f", psxc, psyc, psradius, pstilt); 
        if (gray >= 0.0) fprintf(psfile, "  %.4f", gray);
        fprintf(psfile, " %s\n", operator);
        fflush(psfile);
        ???
        if (gray >= 0.0) fprintf(psfile, " %5.3f", gray);
        fprintf(psfile, " %s\n", operator);
        fflush(psfile);
        ???
        psplot_aux_polygon(psfile, x, y, npoints, gray, "polf");
        psplot_aux_polygon(psfile, x, y, npoints, gray, "polfd");

            fprintf(psfile, "%6.1f %6.1f", psxi, psyi);
fprintf(psfile, "  %d", npoints);
fprintf(psfile, "%3d %3d celf\n", xi, yi);

void psplot_grid_lines(PSPLOT *p)
  {
    ???
    fprintf(psfile, "%% Grid lines:\n");
    fprintf(psfile, "gsave\n");
    fprintf(psfile, "  initclip\n");
    fprintf(psfile, "  0 1 xn {\n");
    fprintf(psfile, "    xstep mul xmin add xgrd\n");
    fprintf(psfile, "  } for\n");
    fprintf(psfile, "  0 1 yn {\n");
    fprintf(psfile, "    ystep mul ymin add ygrd\n");
    fprintf(psfile, "  } for\n");
    fprintf(psfile, "grestore\n");
    fprintf(psfile, "\n");
    fflush(psfile);
    ???
    if (! p->drawing_started) { psplot_error("must call begin_drawing first"); }
    pswrite_grid_lines(p->file)
  }
        fprintf(psfile, " ");
        fprintf(psfile, "  %5.3f %5.3f  %6.1f %6.1f  lbsh\n",
          xalign, yalign, psx, psy
        );
        fflush(psfile);
        ???
        WITH
          x_PS == ,
          y_PS == 
        DO
          
void pswrite_string(PSPLOT *p, FILE *psfile, char *text, char *newline)
  {
    ???
    char *p;
    putc('(', psfile);
    for (p = text; *p != 0; p++)
      {
        if (p == '\n')
          { fprintf(psfile, "%s", newline); }
        else if (p == '(')
          { putc('\\', psfile); putc('(', psfile); }
        else if (p == ')')
          { putc('\\', psfile); putc(')', psfile); }
        else if (p == '\t')
          { putc(' ', psfile); putc(' ', psfile); }
        else if (p == '\\')
          { putc('\\', psfile); putc('\\', psfile); }
        else if (/*p < ' ') || /*p > '~'))
          { fprintf(psfile, "\\%03o", *p); }
        else
          { putc/*p, psfile); }
      }
    fprintf(psfile, ")");
  }

void ps_aux_polygon(
    FILE *psfile,
    double x[], double y[],
    int npoints,
    double R, double G, double B,
    char *operator
  )
  {
    int i;
    if (npoints>6) fprintf(psfile, "\n");
    for (i=0; i<npoints; i++)
      {
        double psxi = x_min_PS + ps_xscale * (x[i] - ps_xmin);
        double psyi = y_min_PS + ps_yscale * (y[i] - ps_ymin);
        if ((i % 6) == 0) 
          { if (i>0) fprintf(psfile, "\n"); }
        else
          { fprintf(psfile, "  "); }
        fprintf(psfile, "%6.1f %6.1f", psxi, psyi);
      }
    if (npoints>6) fprintf(psfile, "\n");
    fprintf(psfile, "  %d", npoints);
    if (R >= 0.0) fprintf(psfile, "  %5.3f %5.3f %5.3f", R, G, B);
    fprintf(psfile, " %s\n", operator);
    fflush(psfile);
  }

void ps_draw_polygon(
    FILE *psfile,
    double x[], double y[],
    int npoints
  )
  {
    ps_aux_polygon(psfile, x, y, npoints, -1.0, -1.0, -1.0, "pold");
  }
    
void ps_fill_polygon(
    FILE *psfile,
    double x[], double y[],
    int npoints,
    double R, double G, double B
  )
  {
    ps_aux_polygon(psfile, x, y, npoints, R, G, B, "polf");
  }
    
void ps_fill_and_draw_polygon(
    FILE *psfile,
    double x[], double y[],
    int npoints,
    double R, double G, double B
  )
  {
    ps_aux_polygon(psfile, x, y, npoints, R, G, B, "polfd");
  }
    
void ps_aux_circle(
    FILE *psfile,
    double xc, double yc, double radius,
    double R, double G, double B,
    char *operator
  )
  {
    double psxc = x_min_PS + ps_xscale * (xc - ps_xmin);
    double psyc = y_min_PS + ps_yscale * (yc - ps_ymin);
    double psradius = ps_yscale * radius;
    fprintf(psfile, "%6.1f %6.1f  %6.1f", psxc, psyc, psradius); 
    if (R >= 0.0) fprintf(psfile, "  %5.3f %5.3f %5.3f", R, G, B);
    fprintf(psfile, " %s\n", operator);
    fflush(psfile);
  }

void ps_fill_circle(
    FILE *psfile,
    double xc, double yc, double radius,
    double R, double G, double B
  )
  {
    ps_aux_circle(psfile, xc, yc, radius, R, G, B, "cirf");
  }
  
void ps_draw_circle(
    FILE *psfile,
    double xc, double yc, double radius
  )
  {
    ps_aux_circle(psfile, xc, yc, radius, -1.0, -1.0, -1.0, "cird");
  }
  
void ps_fill_and_draw_circle(
    FILE *psfile,
    double xc, double yc, double radius,
    double R, double G, double B
  )
  {
    ps_aux_circle(psfile, xc, yc, radius, R, G, B, "cirfd");
  }
  
void ps_aux_lune(
    FILE *psfile,
    double xc, double yc, double radius, double tilt,
    double R, double G, double B,
    char *operator
  )
  {
    double psxc = x_min_PS + ps_xscale * (xc - ps_xmin);
    double psyc = y_min_PS + ps_yscale * (yc - ps_ymin);
    double psradius = ps_yscale * radius;
    double pstilt = tilt * 180.0 / M_PI;
    fprintf(psfile, "%6.1f %6.1f  %6.1f %6.2f",
      psxc, psyc, psradius, pstilt); 
    if (R >= 0.0) fprintf(psfile, "  %5.3f %5.3f %5.3f", R, G, B);
    fprintf(psfile, " %s\n", operator);
    fflush(psfile);
  }

void ps_fill_and_draw_lune(
    FILE *psfile,
    double xc, double yc, double radius, double tilt,
    double R, double G, double B
  )
  {
    ps_aux_lune(psfile, xc, yc, radius, tilt, R, G, B, "lunefd");
  }
  
void ps_aux_slice(
    FILE *psfile,
    double xc, double yc, double radius, double start, double stop,
    double R, double G, double B,
    char *operator
  )
  {
    double psxc = x_min_PS + ps_xscale * (xc - ps_xmin);
    double psyc = y_min_PS + ps_yscale * (yc - ps_ymin);
    double psradius = ps_yscale * radius;
    double psstart = start * 180.0 / M_PI;
    double psstop  = stop  * 180.0 / M_PI;
    fprintf(psfile, "%6.1f %6.1f  %6.1f  %6.2f %6.2f",
      psxc, psyc, psradius, psstart, psstop); 
    if (R >= 0.0) fprintf(psfile, "  %5.3f %5.3f %5.3f", R, G, B);
    fprintf(psfile, " %s\n", operator);
    fflush(psfile);
  }

void ps_fill_and_draw_slice(
    FILE *psfile,
    double xc, double yc, double radius, double start, double stop,
    double R, double G, double B
  )
  {
    ps_aux_slice(psfile, xc, yc, radius, start, stop, R, G, B, "slicefd");
  }
  
void ps_fill_triangle(
    FILE *psfile,
    double xa, double ya,
    double xb, double yb,
    double xc, double yc,
    double R, double G, double B
  )
  {
    double psxa = x_min_PS + ps_xscale * (xa - ps_xmin);
    double psya = y_min_PS + ps_yscale * (ya - ps_ymin);
    double psxb = x_min_PS + ps_xscale * (xb - ps_xmin);
    double psyb = y_min_PS + ps_yscale * (yb - ps_ymin);
    double psxc = x_min_PS + ps_xscale * (xc - ps_xmin);
    double psyc = y_min_PS + ps_yscale * (yc - ps_ymin);
    fprintf(psfile,
      "%6.1f %6.1f  %6.1f %6.1f  %6.1f %6.1f  %5.3f %5.3f %5.3f trif\n",
            psxa, psya, psxb, psyb, psxc, psyc, R, G, B
    );
    fflush(psfile);
  }

void ps_fill_grid_cell(FILE *psfile, int xi, int yi, double R, double G, double B)
  {
    fprintf(psfile, "%3d %3d  %5.3f %5.3f %5.3f celf\n", xi, yi, R, G, B);
    fflush(psfile);
  }

void ps_draw_coord_line (FILE *psfile, char axis, double coord)
  {
    double pscoord;
    if (axis == 'x')
      { pscoord = x_min_PS + ps_xscale * (coord - ps_xmin); }
    else if (axis == 'y')
      { pscoord = y_min_PS + ps_yscale * (coord - ps_ymin); }
    else
      { fatalerror("ps_draw_coord-line: invalid axis"); }
    fprintf(psfile, "%6.1f %cgrd\n", pscoord, axis);
  }

void ps_draw_grid_lines(FILE *psfile)
  {
    fprintf(psfile, "%% Grid lines:\n");
    fprintf(psfile, "gsave\n");
    fprintf(psfile, "  initclip\n");
    fprintf(psfile, "  0 1 xn {\n");
    fprintf(psfile, "    xstep mul xmin add xgrd\n");
    fprintf(psfile, "  } for\n");
    fprintf(psfile, "  0 1 yn {\n");
    fprintf(psfile, "    ystep mul ymin add ygrd\n");
    fprintf(psfile, "  } for\n");
    fprintf(psfile, "grestore\n");
    fprintf(psfile, "\n");
    fflush(psfile);
  }

void ps_put_text(FILE *psfile, char *text, char *newline)
  {
    char *p;
    putc('(', psfile);
    for (p = text; *p != 0; p++)
      {
        if (p == '\n')
          { fprintf(psfile, "%s", newline); }
        else if (p == '(')
          { putc('\\', psfile); putc('(', psfile); }
        else if (p == ')')
          { putc('\\', psfile); putc(')', psfile); }
        else if (p == '\t')
          { putc(' ', psfile); putc(' ', psfile); }
        else if (p == '\\')
          { putc('\\', psfile); putc('\\', psfile); }
        else if (/*p < ' ') || /*p > '~'))
          { fprintf(psfile, "\\%03o", *p); }
        else
          { putc/*p, psfile); }
      }
    fprintf(psfile, ")");
  }