#include <stdio.h>
/*
 * FUNCTION:  initps
 * 
 * Writes PostScript prologue to output postscript file
 * 
 * ARGUMENT:  fpps = FILE pointer to postscript file
 */
#if PROTOTYPE_ALLOWED
void initps(FILE * fpps, char *title, char *timestamp)
#else
void initps(fpps, title, timestamp)
   FILE *fpps;
   char *title, *timestamp;
#endif
{
   fputs("%!PS-Adobe-2.0\n", fpps);
   fprintf(fpps, "%%%%Title: %s\n", title);
   fputs("%%Creator: vector\n", fpps);
   fprintf(fpps, "%%%%CreationDate: %s\n", timestamp);
   fputs("%%DocumentFonts: Times-Roman Times-Bold Times-Italic Helvetica\n", fpps);
   fputs("%%Pages: (atend)\n", fpps);
   fputs("%%BoundingBox: (atend)\n", fpps);
   fputs("%%EndComments\n", fpps);
   fputs("%%BeginProlog\n", fpps);
   fputs("% constant definitions\n", fpps);
   fputs("/Plainfont /Times-Roman def\n", fpps);
   fputs("/Boldfont /Times-Bold def\n", fpps);
   fputs("/Font Plainfont def\n", fpps);
   fputs("% definition operators\n", fpps);
   fputs("/M  {moveto} bind def\n", fpps);
   fputs("/L  {lineto} bind def\n", fpps);
   fputs("/R  {rlineto} bind def\n", fpps);
   fputs("/Ls { lineto currentpoint stroke moveto\n", fpps);
   fputs("    } bind def\n", fpps);
   fputs("/Fsi{findfont exch scalefont setfont\n", fpps);
   fputs("    } bind def\n", fpps);
   fputs("/shade {gsave setgray eofill grestore} bind def\n", fpps);
   /*
    * To have PS handle the up-down positioning, we would have to use a PS
    * variable with the font size in it.
    */
   /* Show Centered. */
   fputs("/SC { moveto dup stringwidth\n", fpps);
   fputs("      2 div neg exch 2 div neg exch rmoveto show\n", fpps);
   fputs("    } bind def\n", fpps);
   /* Show Right-justified. */
   fputs("/SR { moveto dup stringwidth\n", fpps);
   fputs("      neg exch neg exch rmoveto show\n", fpps);
   fputs("    } bind def\n", fpps);
   fputs("/Sh { moveto show } bind def\n", fpps);

   fputs("/arrowdict 14 dict def\n", fpps);
   fputs("/A % takes 4 arguments: len_i, dir,  (lon_i,lat_i) for tail\n", fpps);
   fputs("{ arrowdict begin\n", fpps);
   fputs("  gsave\n", fpps);	/* workaround for Sparc printer */
   fputs("  translate\n", fpps);
   fputs("  rotate\n", fpps);
   fputs("  0 0 moveto\n", fpps);
   fputs("  /arrowlength exch def\n", fpps);
   fputs("  arrowlength arrowhead_min gt \n", fpps);
   fputs("  { /base arrowlength headlength sub def\n", fpps);
   fputs("    /factor 1.0 def\n", fpps);
   fputs("    base 0 lt \n", fpps);
   fputs("    { /base 0 def\n", fpps);
   fputs("      /factor arrowlength headlength div def\n", fpps);
   fputs("    } if\n", fpps);
   fputs("    base 0 lineto stroke\n", fpps);
   fputs("    base halfheadthickness factor mul neg moveto\n", fpps);
   fputs("    arrowlength 0 lineto\n", fpps);
   fputs("    base halfheadthickness factor mul lineto\n", fpps);
   fputs("    closepath fill\n", fpps);
   fputs("  }\n", fpps);
   fputs("  { 0 0\n", fpps);
   fputs("    halfheadthickness \n", fpps);
   fputs("    arrowhead_min headlength div mul\n", fpps);
   fputs("    0 360 arc\n", fpps);
   fputs("    fill\n", fpps);
   fputs("  } ifelse\n", fpps);
   fputs("  grestore\n", fpps);	/* workaround for Sparc printer */
   fputs("end} bind def\n", fpps);

   /* Symbols can be stroked or filled: */
   fputs("/StrokeOrFill {stroke} def", fpps);
   fputs("/stroked_symbol { /StrokeOrFill {stroke} def} bind def", fpps);
   fputs("/filled_symbol  { /StrokeOrFill {fill} def} bind def", fpps);

   /*
    * Variable to hold symbol dimension, to make the symbol routines easier
    * to write and read.
    */
   fputs("/len 1 def\n", fpps);
   /* Variable to hold symbol line thickness as fraction of length. */
   fputs("/thick 0.15 def\n", fpps);

   /*
    * In the following, I am not at all sure all the gsave-grestores, and the
    * occasional newpaths, are needed.  Fortunately, these routines will be
    * seldom used, so efficiency is not paramount.
    */
   /* circle: x,y,radius on stack */
   fputs("/circle\n", fpps);
   fputs("{ newpath 0 360 arc StrokeOrFill\n", fpps);
   fputs("} bind def\n", fpps);

   fputs("/plus\n", fpps);
   fputs("  {gsave newpath \n", fpps);
   fputs("  /len exch def \n", fpps);
   fputs("  moveto\n", fpps);
   fputs("  len thick mul  setlinewidth\n", fpps);
   fputs("  len neg 0 rmoveto\n", fpps);
   fputs("  len 2 mul 0 rlineto\n", fpps);
   fputs("  len neg len neg rmoveto\n", fpps);
   fputs("  0 len 2 mul rlineto\n", fpps);
   fputs("  stroke grestore\n", fpps);
   fputs("} bind def\n", fpps);

   fputs("/x\n", fpps);
   fputs("  {gsave newpath\n", fpps);
   fputs("  /len exch def \n", fpps);
   fputs("  moveto\n", fpps);
   fputs("  len thick mul setlinewidth\n", fpps);
   fputs("  len neg len rmoveto\n", fpps);
   fputs("  len 2 mul len 2 mul neg rlineto\n", fpps);
   fputs("  len 2 mul neg 0 rmoveto\n", fpps);
   fputs("  len 2 mul len 2 mul rlineto\n", fpps);
   fputs("  stroke grestore\n", fpps);
   fputs("} bind def\n", fpps);

   fputs("/square \n", fpps);
   fputs("  {gsave newpath\n", fpps);
   fputs("  /len exch def \n", fpps);
   fputs("  moveto\n", fpps);
   fputs("  len thick mul setlinewidth\n", fpps);
   fputs("  len neg len neg rmoveto\n", fpps);
   fputs("  len 2 mul 0 rlineto\n", fpps);
   fputs("  0 len 2 mul rlineto\n", fpps);
   fputs("  len 2 mul neg 0 rlineto\n", fpps);
   fputs("  0 len 2 mul neg rlineto\n", fpps);
   fputs("  closepath StrokeOrFill grestore\n", fpps);
   fputs("} bind def\n\n", fpps);

   fputs("/delta\n", fpps);
   fputs("  {gsave newpath\n", fpps);
   fputs("  /len exch def \n", fpps);
   fputs("  moveto\n", fpps);
   fputs("  len thick mul setlinewidth\n", fpps);
   fputs("  len neg len neg rmoveto\n", fpps);
   fputs("  len 2 mul 0 rlineto\n", fpps);
   fputs("  len neg len 2 mul rlineto\n", fpps);
   fputs("  len neg len 2 mul neg rlineto\n", fpps);
   fputs("  closepath StrokeOrFill grestore\n", fpps);
   fputs("} bind def\n\n", fpps);

   fputs("/del\n", fpps);
   fputs("  {gsave newpath\n", fpps);
   fputs("  /len exch def \n", fpps);
   fputs("  moveto\n", fpps);
   fputs("  len thick mul setlinewidth\n", fpps);
   fputs("  len len rmoveto\n", fpps);
   fputs("  len 2 mul neg 0 rlineto\n", fpps);
   fputs("  len len 2 mul neg rlineto\n", fpps);
   fputs("  len len 2 mul rlineto\n", fpps);
   fputs("  closepath StrokeOrFill grestore\n", fpps);
   fputs("} bind def\n\n", fpps);

   fputs("/diamond\n", fpps);
   fputs("  {gsave newpath\n", fpps);
   fputs("  /len exch def \n", fpps);
   fputs("  moveto\n", fpps);
   fputs("  len thick mul setlinewidth\n", fpps);
   fputs("  len 0 rmoveto\n", fpps);
   fputs("  len neg len rlineto\n", fpps);
   fputs("  len neg len neg rlineto\n", fpps);
   fputs("  len len neg rlineto\n", fpps);
   fputs("  len len rlineto\n", fpps);
   fputs("  closepath StrokeOrFill grestore\n", fpps);
   fputs("} bind def\n", fpps);

   fputs("%%EndProlog\n", fpps);

}