
/* graphics.q: simple PostScript graphics interface
   $Id: graphics.q,v 1.4 2006/06/15 07:26:57 agraef Exp $ */

/* This file is part of the Q programming system.

   The Q programming system is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   The Q programming system is distributed in the hope that it will be
   useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

/* This module is largely untested. Please send any bug reports and fixes
   to ag@muwiinfa.geschichte.uni-mainz.de. */

import stdlib, string;

/* Some standard kinds of graphics devices which can be used as values for the
   GRAPHICS variable: nulldev (null device), filedev NAME (output file), lpdev
   (printer), gsdev (pipe to ghostscript), and gvdev (pipe to ghostview). You
   might have to customize these for your local setup. The defaults should
   work on most UNIX systems, a setup for MS Windows is also provided. */

public nulldev, filedev X, lpdev, gsdev, gvdev;

/* Win32-specific devices. Note that the printer and ghostview devices are not
   supported and are redirected to nulldev instead. For the ghostscript device
   you have to make sure that the gswin32c executable is on your PATH. */

private win32;
win32		= pos "mingw" sysinfo >= 0;

nulldev		= filedev "nul" if win32;
lpdev		= nulldev if win32;
gsdev		= popen "gswin32c -q -" "w" if win32;
gvdev		= nulldev if win32;

/* Defaults (generic UNIX environment). */

nulldev		= filedev "/dev/null";
filedev NAME	= fopen NAME "w";
lpdev		= popen "lpr" "w";
gsdev		= popen "gs -q -" "w";
gvdev		= popen "ghostview -" "w";

/* The graphics output device. This must be assigned to a file object. By
   default, this variable is assigned to the standard output channel (global
   OUTPUT variable), which is useful for debugging purposes, but you probably
   want to reassign it to some PostScript device or file using `def'. E.g.:
   def GRAPHICS = gsdev; // use ghostscript to display graphics output */

public var GRAPHICS;
def GRAPHICS = OUTPUT;

/* Path construction operations. */

public newpath;		/* starts a new path */
public closepath;	/* closes the current subpath */
public clippath;	/* set the current path to the current clipping
			   path */

public moveto X Y;	/* absolute move */
public rmoveto DX DY;	/* relative move */
public lineto X Y;	/* straight line segment (absolute) */
public rlineto DX DY;	/* straight line segment (relative) */
public curveto X1 Y1 X2 Y2 X3 Y3;
			/* Bezier cubic curve section (absolute) */
public rcurveto DX1 DY1 DX2 DY2 DX3 DY3;
			/* Bezier cubic curve section (relative) */
public arc X Y R A1 A2;	/* arc of a circle */
public narc X Y R A1 A2;
			/* negative arc */
public arct X1 Y1 X2 Y2 R;
			/* arc specified by tangents */

public charpath S T;	/* character path; T is a truth value which
			   determines whether the path should be used for
			   stroking (false) or filling/clipping (true) */

/* Painting operations. */

public stroke;		/* draw a line along current path */

public fill;		/* fill the current path (nonzero winding number
			   rule) */
public eofill;		/* fill the current path (even-odd rule) */

public show S;		/* paint string S at the current point */

/* Clipping operations. */

public clip;		/* define the clipping path (nonzero winding number
			   rule) */
public eoclip;		/* define the clipping path (even-odd rule) */

/* Operations to manipulate the graphics state. */

/* save and restore the graphics state */

public gsave;		/* save the graphics state */
public grestore;	/* restore the graphics state */

public savematrix;	/* save the current transformation matrix (CTM) */
public restorematrix;	/* restore the CTM */

/* transformations of the coordinate system; these operations change the
   CTM */

public translate TX TY;	/* move the origin of the coordinate system */
public scale SX SY;	/* change the unit lengths */
public rotate A;	/* rotate the coordinate system */

/* painting attributes */

public setlinewidth X;	/* set the line width to X units */
public setlinecap N;	/* set the line cap parameter (0 = butt cap,
			   1 = round cap, 2 = projecting square cap) */
public setlinejoin N;	/* set the line join parameter (0 = miter join,
			   1 = round join, 2 = bevel join) */
public setdash Xs DX;	/* set the dash pattern */

public setgray N;	/* set the gray shade (0 = black, 1 = white) */

public setrgbcolor R G B;
			/* set the color in the RGB model (R = red,
			   G = green, B = blue) */
public sethsbcolor H S B;
			/* set the color in the HSB model (H = hue,
			   S = saturation, B = brightness) */
public setcmykcolor C M Y K;
			/* set the color in the CMYK model (C = cyan,
			   M = magenta, Y = yellow, K = black) */

public setfont S X;	/* select font S scaled by X units */

/* The setcolor operation allows to select colors from a fixed set of
   symbolic constants implemented by the Color type. */

public setcolor C;

public type Color = const
		    greenyellow,	// Approximate PANTONE 388
		    yellow,		// Approximate PANTONE YELLOW
		    goldenrod,		// Approximate PANTONE 109
		    dandelion,		// Approximate PANTONE 123
		    apricot,		// Approximate PANTONE 1565
		    peach,		// Approximate PANTONE 164
		    melon,		// Approximate PANTONE 177
		    yelloworange,	// Approximate PANTONE 130
		    orange,		// Approximate PANTONE ORANGE-021
		    burntorange,	// Approximate PANTONE 388
		    bittersweet,	// Approximate PANTONE 167
		    redorange,		// Approximate PANTONE 179
		    mahogany,		// Approximate PANTONE 484
		    maroon,		// Approximate PANTONE 201
		    brickred,		// Approximate PANTONE 1805
		    red,		// VERY-Approx PANTONE RED
		    orangered,		// No PANTONE match
		    rubinered,		// Approximate PANTONE RUBINE-RED
		    wildstrawberry,	// Approximate PANTONE 206
		    salmon,		// Approximate PANTONE 183
		    carnationpink,	// Approximate PANTONE 218
		    magenta,		// Approximate PANTONE PROCESS-MAGENTA
		    violetred,		// Approximate PANTONE 219
		    rhodamine,		// Approximate PANTONE RHODAMINE-RED
		    mulberry,		// Approximate PANTONE 241
		    redviolet,		// Approximate PANTONE 234
		    fuchsia,		// Approximate PANTONE 248
		    lavender,		// Approximate PANTONE 223
		    thistle,		// Approximate PANTONE 245
		    orchid,		// Approximate PANTONE 252
		    darkorchid,		// No PANTONE match
		    purple,		// Approximate PANTONE PURPLE
		    plum,		// VERY-Approx PANTONE 518
		    violet,		// Approximate PANTONE VIOLET
		    royalpurple,	// Approximate PANTONE 267
		    blueviolet,		// Approximate PANTONE 2755
		    periwinkle,		// Approximate PANTONE 2715
		    cadetblue,		// Approximate PANTONE (534+535)/2
		    cornflowerblue,	// Approximate PANTONE 292
		    midnightblue,	// Approximate PANTONE 302
		    navyblue,		// Approximate PANTONE 293
		    royalblue,		// No PANTONE match
		    blue,		// Approximate PANTONE BLUE-072
		    cerulean,		// Approximate PANTONE 3005
		    cyan,		// Approximate PANTONE PROCESS-CYAN
		    processblue,	// Approximate PANTONE PROCESS-BLUE
		    skyblue,		// Approximate PANTONE 2985
		    turquoise,		// Approximate PANTONE (312+313)/2
		    tealblue,		// Approximate PANTONE 3145
		    aquamarine,		// Approximate PANTONE 3135
		    bluegreen,		// Approximate PANTONE 320
		    emerald,		// No PANTONE match
		    junglegreen,	// Approximate PANTONE 328
		    seagreen,		// Approximate PANTONE 3268
		    green,		// VERY-Approx PANTONE GREEN
		    forestgreen,	// Approximate PANTONE 349
		    pinegreen,		// Approximate PANTONE 323
		    limegreen,		// No PANTONE match
		    yellowgreen,	// Approximate PANTONE 375
		    springgreen,	// Approximate PANTONE 381
		    olivegreen,		// Approximate PANTONE 582
		    rawsienna,		// Approximate PANTONE 154
		    sepia,		// Approximate PANTONE 161
		    brown,		// Approximate PANTONE 1615
// the following should be `tan', but this is used for the tangent in math.q
		    yellowbrown,	// No PANTONE match
		    gray,		// Approximate PANTONE COOL-GRAY-8
		    black,		// Approximate PANTONE PROCESS-BLACK
		    white;		// No PANTONE match

/* Miscellaneous operations. */

public showpage;	/* emit the current page */
public copypage;	/* like showpage, but do NOT erase the current page */
public erasepage;	/* erase the current page */
public flushpage;	/* synchronize the display (Ghostscript only) */
public copies N;	/* define number of copies to be printed */

public psfile S;	/* copy the PostScript file with name S to the
			   graphics device */
public psheader;	/* output minimal PostScript header comment */
public psstr S;		/* convert a string to PostScript syntax */
public ps S;		/* output PostScript command */

/* implementation *****************************************************/

newpath			= ps "newpath\n";
closepath		= ps "closepath\n";
clippath		= ps "clippath\n";

moveto X:Real Y:Real	= ps (str X++" "++str Y++" moveto\n");
rmoveto DX:Real DY:Real	= ps (str DX++" "++str DY++" rmoveto\n");
lineto X:Real Y:Real	= ps (str X++" "++str Y++" lineto\n");
rlineto DX:Real DY:Real	= ps (str DX++" "++str DY++" rlineto\n");
curveto X1:Real Y1:Real X2:Real Y2:Real X3:Real Y3:Real
			= ps (join " " (map str [X1,Y1,X2,Y2,X3,Y3])++
				" curveto\n");
rcurveto DX1:Real DY1:Real DX2:Real DY2:Real DX3:Real DY3:Real
			= ps (join " " (map str [DX1,DY1,DX2,DY2,DX3,DY3])++
				" rcurveto\n");
arc X:Real Y:Real R:Real A1:Real A2:Real
			= ps (join " " (map str [X,Y,R,A1,A2])++
				" arc\n");
narc X:Real Y:Real R:Real A1:Real A2:Real
			= ps (join " " (map str [X,Y,R,A1,A2])++
				" narc\n");
arct X1:Real Y1:Real X2:Real Y2:Real R:Real
			= ps (join " " (map str [X1,Y1,X2,Y2,R])++
				" arct\n");

charpath S:String T:Bool
			= ps (psstr S++" "++str T++" charpath\n");

stroke			= ps "stroke\n";
fill			= ps "fill\n";
eofill			= ps "eofill\n";

show S:String		= ps (psstr S++" show\n");

clip			= ps "clip\n";
eoclip			= ps "eoclip\n";

gsave			= ps "gsave\n";

grestore		= ps "grestore\n";

savematrix		= ps "matrix currentmatrix\n";

restorematrix		= ps "setmatrix\n";

translate TX:Real TY:Real
			= ps (str TX++" "++str TY++" translate\n");

scale SX:Real SY:Real	= ps (str SX++" "++str SY++" scale\n");

rotate A:Real		= ps (str A++" rotate\n");

setlinewidth X:Real	= ps (str X++" setlinewidth\n");

setlinecap N:Int	= ps (str N++" setlinecap\n");

setlinejoin N:Int	= ps (str N++" setlinejoin\n");

setdash Xs:List DX:Real	= ps ("["++join " " (map str Xs)++"] "++str DX++
				" setdash\n");

setgray N:Real		= ps (str N++" setgray\n");

setrgbcolor R:Real G:Real B:Real
			= ps (str R++" "++str G++" "++str B++" setrgbcolor\n");

sethsbcolor H:Real S:Real B:Real
			= ps (str H++" "++str S++" "++str B++" sethsbcolor\n");

setcmykcolor C:Real M:Real Y:Real K:Real
			= ps (str C++" "++str M++" "++str Y++" "++str K++
				" setcmykcolor\n");

setfont S:String X:Real	= ps ("/"++S++" findfont "++str X++
				" scalefont setfont\n");

setcolor greenyellow	= setcmykcolor 0.15 0 0.69 0;
setcolor yellow		= setcmykcolor 0 0 1 0;
setcolor goldenrod	= setcmykcolor 0 0.10 0.84 0;
setcolor dandelion	= setcmykcolor 0 0.29 0.84 0;
setcolor apricot	= setcmykcolor 0 0.32 0.52 0;
setcolor peach		= setcmykcolor 0 0.50 0.70 0;
setcolor melon		= setcmykcolor 0 0.46 0.50 0;
setcolor yelloworange	= setcmykcolor 0 0.42 1 0;
setcolor orange		= setcmykcolor 0 0.61 0.87 0;
setcolor burntorange	= setcmykcolor 0 0.51 1 0;
setcolor bittersweet	= setcmykcolor 0 0.75 1 0.24;
setcolor redorange	= setcmykcolor 0 0.77 0.87 0;
setcolor mahogany	= setcmykcolor 0 0.85 0.87 0.35;
setcolor maroon		= setcmykcolor 0 0.87 0.68 0.32;
setcolor brickred	= setcmykcolor 0 0.89 0.94 0.28;
setcolor red		= setcmykcolor 0 1 1 0;
setcolor orangered	= setcmykcolor 0 1 0.50 0;
setcolor rubinered	= setcmykcolor 0 1 0.13 0;
setcolor wildstrawberry	= setcmykcolor 0 0.96 0.39 0;
setcolor salmon		= setcmykcolor 0 0.53 0.38 0;
setcolor carnationpink	= setcmykcolor 0 0.63 0 0;
setcolor magenta	= setcmykcolor 0 1 0 0;
setcolor violetred	= setcmykcolor 0 0.81 0 0;
setcolor rhodamine	= setcmykcolor 0 0.82 0 0;
setcolor mulberry	= setcmykcolor 0.34 0.90 0 0.02;
setcolor redviolet	= setcmykcolor 0.07 0.90 0 0.34;
setcolor fuchsia	= setcmykcolor 0.47 0.91 0 0.08;
setcolor lavender	= setcmykcolor 0 0.48 0 0;
setcolor thistle	= setcmykcolor 0.12 0.59 0 0;
setcolor orchid		= setcmykcolor 0.32 0.64 0 0;
setcolor darkorchid	= setcmykcolor 0.40 0.80 0.20 0;
setcolor purple		= setcmykcolor 0.45 0.86 0 0;
setcolor plum		= setcmykcolor 0.50 1 0 0;
setcolor violet		= setcmykcolor 0.79 0.88 0 0;
setcolor royalpurple	= setcmykcolor 0.75 0.90 0 0;
setcolor blueviolet	= setcmykcolor 0.86 0.91 0 0.04;
setcolor periwinkle	= setcmykcolor 0.57 0.55 0 0;
setcolor cadetblue	= setcmykcolor 0.62 0.57 0.23 0;
setcolor cornflowerblue	= setcmykcolor 0.65 0.13 0 0;
setcolor midnightblue	= setcmykcolor 0.98 0.13 0 0.43;
setcolor navyblue	= setcmykcolor 0.94 0.54 0 0;
setcolor royalblue	= setcmykcolor 1 0.50 0 0;
setcolor blue		= setcmykcolor 1 1 0 0;
setcolor cerulean	= setcmykcolor 0.94 0.11 0 0;
setcolor cyan		= setcmykcolor 1 0 0 0;
setcolor processblue	= setcmykcolor 0.96 0 0 0;
setcolor skyblue	= setcmykcolor 0.62 0 0.12 0;
setcolor turquoise	= setcmykcolor 0.85 0 0.20 0;
setcolor tealblue	= setcmykcolor 0.86 0 0.34 0.02;
setcolor aquamarine	= setcmykcolor 0.82 0 0.30 0;
setcolor bluegreen	= setcmykcolor 0.85 0 0.33 0;
setcolor emerald	= setcmykcolor 1 0 0.50 0;
setcolor junglegreen	= setcmykcolor 0.99 0 0.52 0;
setcolor seagreen	= setcmykcolor 0.69 0 0.50 0;
setcolor green		= setcmykcolor 1 0 1 0;
setcolor forestgreen	= setcmykcolor 0.91 0 0.88 0.12;
setcolor pinegreen	= setcmykcolor 0.92 0 0.59 0.25;
setcolor limegreen	= setcmykcolor 0.50 0 1 0;
setcolor yellowgreen	= setcmykcolor 0.44 0 0.74 0;
setcolor springgreen	= setcmykcolor 0.26 0 0.76 0;
setcolor olivegreen	= setcmykcolor 0.64 0 0.95 0.40;
setcolor rawsienna	= setcmykcolor 0 0.72 1 0.45;
setcolor sepia		= setcmykcolor 0 0.83 1 0.70;
setcolor brown		= setcmykcolor 0 0.81 1 0.60;
setcolor yellowbrown	= setcmykcolor 0.14 0.42 0.56 0;
setcolor gray		= setcmykcolor 0 0 0 0.50;
setcolor black		= setcmykcolor 0 0 0 1;
setcolor white		= setcmykcolor 0 0 0 0;

showpage		= ps "showpage\n";
copypage		= ps "copypage\n";
erasepage		= ps "erasepage\n";
flushpage		= ps "flushpage\n";

copies N:Int		= ps "/#copies "++str N++" def\n";

private pscopy F;

pscopy F:File		= () if feof F;
			= ps (freads F++"\n") || pscopy F otherwise;

psfile S:String		= pscopy (fopen S "r");

psheader		= ps "%!\n";

private psstr2 S T I N, psch C;

psstr S:String		= psstr2 S "(" 0 (#S);

psstr2 S T I N		= T++")" if I>=N;
			= psstr2 S (T++psch (S!I)) (I+1) N otherwise;

psch "("		= "\\(";
psch ")"		= "\\)";
psch "\\"		= "\\\\";
psch C			= C otherwise;

ps S:String		= fwrites GRAPHICS S;
