/*
 *
 *                    ps_macros.c
 *
 *   Don McCormick,    Marek Krawus
 */

#include "defn.h"

char ps_header[] =
"\
%! PS-Adobe-1.0: For Apple LaserWriter\n\
";

char eps_header[] =
"\
%!PS-Adobe-2.0 EPSF-1.2\n\
%%Creator: hpgl2ps program\n\
";

char macros [] =
"\
% default font is 10 pt. Courier\n\
/basefont {/Courier findfont 10 scalefont setfont} def\n\
\n\
% Specify millimeters. (Note: PostScript has 72 points to the inch)\n\
/mm {72 mul 25.4 div} def\n\
% establish space for default coordinate matrix\n\
/defaultmtx matrix def  \n\
% establish space for clipping window coordinates\n\
/clipX_lo 0.0 def  \n\
/clipY_lo 0.0 def  \n\
/clipX_up 0.0 def  \n\
/clipY_up 0.0 def  \n\
% initclip marker \n\
/fullpage 0.0 def  \n\
\n\
/M % Move macro \n\
{\n\
    /Ymove exch def\n\
    /Xmove exch def\n\
    Xmove mm Ymove mm moveto\n\
} def\n\
\n\
/R % Relative move macro \n\
{\n\
    /Yrmove exch def\n\
    /Xrmove exch def\n\
    Xrmove mm Yrmove mm rmoveto\n\
} def\n\
\n\
/D % Draw macro \n\
{\n\
    /Ydraw exch def\n\
    /Xdraw exch def\n\
    Xdraw mm Ydraw mm lineto\n\
} def\n\
\n\
/I % Relative draw  macro \n\
{\n\
    /Yrdraw exch def\n\
    /Xrdraw exch def\n\
    Xrdraw mm Yrdraw mm rlineto\n\
} def\n\
\n\
/XT % x-tick instruction macro \n\
{\n\
    /Dtick exch def\n\
    /Utick exch def\n\
    /delta\n\
     { Utick Dtick add neg } def\n\
    0 mm Utick mm rmoveto\n\
    delta\n\
    mm 0 mm exch rlineto\n\
    0 mm Dtick mm rmoveto\n\
} def\n\
\n\
/YT % y-tick instruction macro \n\
{\n\
    /Dtick exch def\n\
    /Utick exch def\n\
    /delta\n\
     { Utick Dtick add neg } def\n\
    Utick mm 0 mm rmoveto\n\
    delta\n\
    mm 0 mm rlineto\n\
    Dtick mm 0 mm rmoveto\n\
} def\n\
\n\
/SetWindowClip % Procedure to change clipping path\n\
{\n\
    /clipY_up exch def\n\
    /clipX_up exch def\n\
    /clipY_lo exch def\n\
    /clipX_lo exch def\n\
    initclip  \n\
    clipX_lo fullpage ne \n\
     {   \n\
       newpath\n\
         clipX_lo mm clipY_lo mm moveto\n\
         clipX_up mm clipY_lo mm lineto\n\
         clipX_up mm clipY_up mm lineto\n\
         clipX_lo mm clipY_up mm lineto\n\
       closepath\n\
       clip\n\
     }  if   \n\
} def\n\
\n\
/AdjWindowClip % Procedure to adjust clipping path\n\
	       % ( used in rotate instruction )\n\
{\n\
    initclip  \n\
    clipX_lo fullpage ne \n\
     {   \n\
       newpath\n\
         clipX_lo mm clipY_lo mm moveto\n\
         clipX_up mm clipY_lo mm lineto\n\
         clipX_up mm clipY_up mm lineto\n\
         clipX_lo mm clipY_up mm lineto\n\
       closepath\n\
       clip\n\
     }  if   \n\
} def\n\
\n\
/PolyDict 12 dict def\n\
PolyDict /tablica matrix put\n\
/Poly\n\
%                     Procedure to draw polygons\n\
%    ---->  Xc Yc xradius yradius chord start epsilon alfa counter Poly <--\n\
{\n\
   PolyDict begin\n\
    /counter exch def\n\
    /alfa exch def\n\
    /epsilon exch def\n\
    /start exch def\n\
    /chord exch def\n\
    /yradius exch def\n\
    /xradius exch def\n\
    /Yc exch def\n\
    /Xc exch def\n\
    /bok\n\
     { chord mm 0 mm lineto\n\
       currentpoint translate\n\
       alfa rotate } def\n\
    /oldtablica tablica currentmatrix def\n\
\n\
    Xc mm Yc mm moveto\n\
    start 0 eq\n\
    { xradius mm 0 mm rmoveto }\n\
    { xradius neg\n\
      mm 0 mm rmoveto\n\
      180 epsilon add\n\
      /epsilon exch def } ifelse\n\
    currentpoint translate\n\
    1 yradius mm xradius mm div scale\n\
    epsilon rotate \n\
    newpath \n\
      0 mm 0 mm moveto \n\
      counter {bok} repeat \n\
      closepath \n\
    oldtablica setmatrix \n\
    stroke \n\
  end\n\
} def\n\
\n\
%            Procedure to change font and size of font\n\
%		---->   font size Font    <----\n\
/Font\n\
{\n\
    /Height exch def\n\
    /FontName exch def\n\
    FontName findfont Height mm scalefont setfont\n\
} def\n\
\n\
%      Procedure to change font, width, slant and height\n\
%      ---->   font width height slant DefFont    <----\n\
%\n\
%	Note: slant = height * tan( slant_angle )\n\
\n\
/DefFont\n\
{\n\
    /Slant exch def\n\
    /Height exch def\n\
    /Width exch def\n\
    /FontName exch def\n\
    FontName findfont [ Width mm 0 Slant mm Height mm 0 0] makefont setfont\n\
} def\n\
\n\
%            General Text Layout Procedure\n\
%    ---->   x y pos_num angle (text) Text    <----\n\
\n\
/Text\n\
{\n\
    /String exch def\n\
    /Angle exch def\n\
    /Position exch def\n\
    /Ymove exch def\n\
    /Xmove exch def\n\
    Position 1 lt {/hpf 0 def /lpf 0 def} if\n\
    Position 1 eq {/hpf 0 def /lpf 0 def} if\n\
    Position 2 eq {/hpf 0 def /lpf 0.5 def} if\n\
    Position 3 eq {/hpf 0 def /lpf 1 def} if\n\
    Position 4 eq {/hpf 0.5 def /lpf 0 def} if\n\
    Position 5 eq {/hpf 0.5 def /lpf 0.5 def} if\n\
    Position 6 eq {/hpf 0.5 def /lpf 1 def} if\n\
    Position 7 eq {/hpf 1 def /lpf 0 def} if\n\
    Position 8 eq {/hpf 1 def /lpf 0.5 def} if\n\
    Position 9 eq {/hpf 1 def /lpf 1 def} if\n\
    Position 9 gt {/hpf 1 def /lpf 1 def} if\n\
    /StrLen String stringwidth pop lpf mul def\n\
    /StrHt Height mm hpf mul def\n\
    /Xdiff StrHt Angle sin mul StrLen Angle cos mul sub def\n\
    /Ydiff StrHt Angle cos mul StrLen Angle sin mul add def\n\
    Xmove mm Xdiff add Ymove mm Ydiff sub moveto\n\
    gsave\n\
        Angle rotate\n\
        String show\n\
    grestore\n\
    StrLen Angle cos mul StrLen Angle sin mul rmoveto\n\
    /PosterOnly 0 def\n\
} def\n\
\n\
%     Procedure to print symbol (sm instruction)\n\
%  ---->   x y Xfact Yfact angle (text) Symbol    <----\n\
\n\
/Symbol\n\
{\n\
    /String exch def\n\
    /Angle exch def\n\
    /Yfact exch def\n\
    /Xfact exch def\n\
    /Ymove exch def\n\
    /Xmove exch def\n\
    /StrLen String stringwidth pop Xfact mul def\n\
    /StrHt Height mm Yfact mul def\n\
    /Xdiff StrHt Angle sin mul StrLen Angle cos mul sub def\n\
    /Ydiff StrHt Angle cos mul StrLen Angle sin mul add def\n\
    Xmove mm Xdiff add Ymove mm Ydiff sub moveto\n\
    gsave\n\
        Angle rotate\n\
        String show\n\
    grestore\n\
    StrLen Angle cos mul StrLen Angle sin mul rmoveto\n\
    /PosterOnly 0 def\n\
} def\n\
\n\
%               Arc, Ellipse and Circle procedure.\n\
% ----> direction xcen ycen xrad yrad start_angle end_angle Ellipse   <----\n\
\n\
/EllipseDict 9 dict def\n\
EllipseDict /mtrx matrix put\n\
/Ellipse \n\
{   EllipseDict begin\n\
    /endangle exch def\n\
    /startangle exch def\n\
    /yradius exch def\n\
    /xradius exch def\n\
    /ycenter exch def\n\
    /xcenter exch def\n\
    /direction exch def\n\
    /savematrix mtrx currentmatrix def\n\
    xcenter mm ycenter mm translate\n\
    1 yradius mm xradius mm div scale\n\
    newpath\n\
       direction 0 eq\n\
       { 0 0 xradius mm startangle endangle arc }\n\
       { endangle startangle sub abs round 360 eq \n\
          { 0 0 xradius mm startangle endangle arc }\n\
          { 0 0 xradius mm startangle endangle arcn }\n\
         ifelse \n\
       }  \n\
       ifelse \n\
    savematrix setmatrix\n\
    stroke\n\
    end\n\
} def\n\
\n\
%    Shade Rectangle Relative & Absolute procedure.\n\
%  ---->   xo yo xinc yinc typ spac angle RR   <----\n\
\n\
/RRDict 14 dict def\n\
/RR \n\
{ \n\
    RRDict begin\n\
     /angle exch def\n\
     mm /spacmm exch def\n\
     /typ exch def\n\
     mm /yinc exch def\n\
     mm /xinc exch def\n\
     mm /yo exch def\n\
     mm /xo exch def\n\
     /rectclip \n\
     { \n\
       newpath \n\
          xo yo moveto\n\
          xinc 0 rlineto\n\
          0 yinc rlineto\n\
          xinc neg 0 rlineto\n\
       closepath \n\
     } def \n\
     xinc abs yinc abs gt  \n\
      {/paternbok xinc abs mm def}\n\
      {/paternbok yinc abs mm def} ifelse\n\
     /verticals \n\
     { \n\
        spacmm spacmm paternbok \n\
        { newpath \n\
            paternbok neg moveto \n\
            0 paternbok 2 mul rlineto \n\
          stroke } for \n\
        angle abs 45 eq { 0 spacmm paternbok } \n\
        { spacmm spacmm paternbok } ifelse \n\
        { newpath \n\
            neg paternbok neg moveto \n\
            0 paternbok 2 mul rlineto \n\
          stroke } for \n\
     } def \n\
     /horizontals \n\
     { \n\
        spacmm spacmm paternbok \n\
        { newpath \n\
            paternbok neg exch moveto \n\
            paternbok 2 mul 0 rlineto \n\
          stroke } for \n\
        angle abs 45 eq { 0 spacmm paternbok } \n\
        { spacmm spacmm paternbok } ifelse \n\
        { newpath \n\
            neg paternbok neg exch moveto \n\
            paternbok 2 mul 0 rlineto \n\
          stroke } for \n\
     } def \n\
\n\
     gsave\n\
       rectclip clip\n\
       xo yo translate \n\
       angle rotate \n\
       typ 3 le \n\
       { horizontals } \n\
       { horizontals \n\
         verticals } ifelse \n\
     grestore\n\
    end  \n\
} def\n\
\n\
%  Edge Rectangle Relative & Absolute procedure.\n\
%       ---->   xo yo xinc yinc RR   <----\n\
\n\
/EEDict 5 dict def\n\
/EE \n\
{ \n\
    EEDict begin\n\
     mm /yinc exch def\n\
     mm /xinc exch def\n\
     mm /yo exch def\n\
     mm /xo exch def\n\
     /rectshow \n\
     { \n\
       newpath \n\
          xo yo moveto\n\
          xinc 0 rlineto\n\
          0 yinc rlineto\n\
          xinc neg 0 rlineto\n\
       closepath \n\
       stroke  \n\
     } def \n\
\n\
     gsave\n\
       rectshow \n\
     grestore\n\
\n\
    end  \n\
} def\n\
\n\
%         Procedure to draw arc with chord angle > 5 deg\n\
% flag Xc Yc xradius yradius start finish chord epsilon psi counter Achord\n\
\n\
/AchordDict 14 dict def\n\
AchordDict /tabl matrix put\n\
/Achord\n\
{\n\
   AchordDict begin\n\
    /counter exch def\n\
    /psi exch def\n\
    /epsilon exch def\n\
    /chord exch def\n\
    /finish exch def\n\
    /start exch def\n\
    /yradius exch def\n\
    /xradius exch def\n\
    /Yc exch def\n\
    /Xc exch def\n\
    /flag exch def\n\
    /bok\n\
     { chord mm 0 mm lineto\n\
       currentpoint translate\n\
       psi rotate } def\n\
    /oldtabl tabl currentmatrix def\n\
\n\
    Xc mm Yc mm translate\n\
    1 yradius mm xradius mm div scale\n\
    flag 0 eq\n\
      { start rotate }\n\
      { finish rotate }  ifelse \n\
    xradius mm 0 mm translate \n\
    epsilon rotate \n\
    newpath \n\
       0 0 moveto \n\
       counter { bok } repeat \n\
       oldtabl setmatrix \n\
    stroke \n\
  end\n\
} def\n\
\n\
%         Procedure to draw wedge with chord angle < 5 deg\n\
% fill zwrot Xc Yc xrad yrad start finish ftyp spac fangle WedgeSmooth\n\
\n\
/WSDict 15 dict def\n\
/WedgeSmooth\n\
{\n\
   WSDict begin\n\
    /fangle exch def\n\
    mm /spac exch def\n\
    /ftyp exch def\n\
    /finish exch def\n\
    /start exch def\n\
    mm /yrad exch def\n\
    mm /xrad exch def\n\
    mm /Yc exch def\n\
    mm /Xc exch def\n\
    /zwrot exch def\n\
    /fill exch def\n\
    /clipregion \n\
    { \n\
      newpath \n\
         0 0 moveto \n\
         zwrot 0 eq \n\
         { 0 0 xrad start finish arc } \n\
         { 0 0 xrad start finish arcn } \n\
         ifelse \n\
      closepath \n\
    } def \n\
    xrad yrad gt \n\
    {/paternbok xrad def} \n\
    {/paternbok yrad def} ifelse \n\
    /verticals \n\
    { \n\
      paternbok neg spac paternbok \n\
      {  newpath  \n\
            paternbok neg moveto \n\
            0 paternbok 2 mul rlineto  \n\
         stroke   \n\
      } for  \n\
    }  def \n\
    /horizontals \n\
    { \n\
      paternbok neg spac paternbok \n\
      {  newpath  \n\
            paternbok neg exch moveto \n\
            paternbok 2 mul 0 rlineto  \n\
         stroke   \n\
      } for  \n\
    }  def \n\
    \n\
    gsave \n\
      0 setlinejoin \n\
      10 setmiterlimit \n\
      Xc Yc translate \n\
      1 yrad xrad div scale \n\
      fill 0 eq \n\
      {  clipregion \n\
         stroke  }\n\
      {  clipregion clip \n\
         fangle rotate \n\
         ftyp 3 le \n\
         { horizontals } \n\
         { horizontals verticals } ifelse   } \n\
      ifelse \n\
      1 setlinejoin \n\
      3 setmiterlimit \n\
    grestore \n\
   end \n\
} def \n\
%         Procedure to draw wedge with chord angle >=  5 deg\n\
% fill Xc Yc xrad yrad start dopln ftyp spac fangle chord epsilon psi i\n\
%                                                              WedgeChord\n\
\n\
/WCDict 20 dict def\n\
/WedgeChord\n\
{\n\
   WCDict begin\n\
    /i exch def\n\
    /psi exch def\n\
    /epsilon exch def\n\
    mm /chord exch def \n\
    /fangle exch def\n\
    mm /spac exch def\n\
    /ftyp exch def\n\
    /dopln exch def\n\
    /start exch def\n\
    mm /yrad exch def\n\
    mm /xrad exch def\n\
    mm /Yc exch def\n\
    mm /Xc exch def\n\
    /fill exch def\n\
    /clipregion \n\
    { \n\
      newpath \n\
         0 0 moveto \n\
         start rotate  \n\
         psi i mul round 360 eq  \n\
           { xrad 0 moveto }   \n\
           { xrad 0 lineto }   \n\
         ifelse  \n\
         currentpoint translate  \n\
         epsilon rotate  \n\
         i  \n\
           { chord 0 lineto  \n\
             currentpoint translate  \n\
             psi rotate } \n\
         repeat   \n\
         epsilon neg rotate  \n\
      closepath  \n\
         xrad neg 0 moveto  \n\
         currentpoint translate  \n\
         dopln rotate  \n\
    } def  \n\
    \n\
    xrad yrad gt \n\
    {/paternbok xrad def} \n\
    {/paternbok yrad def} ifelse \n\
    /verticals \n\
    { \n\
      paternbok neg spac paternbok \n\
      {  newpath  \n\
            paternbok neg moveto \n\
            0 paternbok 2 mul rlineto  \n\
         stroke   \n\
      } for  \n\
    }  def \n\
    /horizontals \n\
    { \n\
      paternbok neg spac paternbok \n\
      {  newpath  \n\
            paternbok neg exch moveto \n\
            paternbok 2 mul 0 rlineto  \n\
         stroke   \n\
      } for  \n\
    }  def \n\
    \n\
    gsave \n\
      0 setlinejoin \n\
      10 setmiterlimit \n\
      Xc Yc translate \n\
      1 yrad xrad div scale \n\
      fill 0 eq \n\
      {  clipregion \n\
         stroke  }\n\
      {  clipregion clip \n\
         fangle rotate \n\
         ftyp 3 le \n\
         { horizontals } \n\
         { horizontals verticals } ifelse   } \n\
      ifelse \n\
      1 setlinejoin \n\
      3 setmiterlimit \n\
    grestore \n\
   end \n\
} def \n\
%\n\
%    --------->     Prolog     <--------------\n\
%\n\
basefont        % Set the default font \n\
1 setlinecap    % Use round caps \n\
1 setlinejoin   % Use round joins \n\
3 setmiterlimit % Bevel small angle miters \n\
\n\
";

ps_macros()
{
	fprintf(outfile, "%s", ps_header);
	fprintf(outfile, "%s", macros);
}

eps_macros(x0, y0, x1, y1)
    int x0, y0, x1, y1;
{
	fprintf(outfile, "%s", eps_header);
	fprintf(outfile, "%%%%BoundingBox: %d %d %d %d\n" , x0, y0, x1, y1);
	fprintf(outfile, "%%%%EndComments\n");
	fprintf(outfile, "%s", macros);
}
