/* Part of XPCE --- The SWI-Prolog GUI toolkit Author: Jan Wielemaker and Anjo Anjewierden E-mail: wielemak@science.uva.nl WWW: http://www.swi-prolog.org/packages/xpce/ Copyright (c) 1985-2005, University of Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include #include #include #include static void ps_put_string(PceString); static int postscriptImage(Image, Int, int iscolor); static int header(Any, Area, BoolObj); static int footer(void); static status fill(Any, Name); static void ps_colour(Colour c, int grey); static status draw_postscript_image(Image image, Int x, Int y, Name hb); static struct { Colour colour; /* current colour */ struct { Name family; /* family of current PostScript font */ Int points; /* points in current PostScript font */ } currentFont; } psstatus; static Chain documentFonts = NIL; /* chain holding fonts in document */ static Chain documentDefs = NIL; /* chain holding defs in document */ static IOSTREAM *psoutput; /* PostScript sink */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create a postscript image of a graphical and make it fit into the specified are. If `ls' is ON the image will be rotated 90 degrees resulting in a landscaped image. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ StringObj getPostscriptObject(Any obj, BoolObj ls, Area a) { StringObj result; char *PostScript = NULL; size_t size = 0; if ( isNil(documentFonts) ) documentFonts = globalObject(NAME_DocumentFonts, ClassChain, EAV); else clearChain(documentFonts); if ( isNil(documentDefs) ) documentDefs = globalObject(NAME_DocumentDefs, ClassChain, EAV); else clearChain(documentDefs); psstatus.colour = BLACK_COLOUR; psstatus.currentFont.family = NIL; psoutput = Sopenmem(&PostScript, &size, "w"); if ( hasSendMethodObject(obj, NAME_compute) ) send(obj, NAME_compute, EAV); if ( !header(obj, a, ls) ) { Sclose(psoutput); psoutput = NULL; free(PostScript); fail; } send(obj, NAME_Postscript, NAME_body, EAV); footer(); Sclose(psoutput); psoutput = NULL; result = CtoString(PostScript); /* TBD: avoid duplication! */ free(PostScript); answer(result); } __pce_export void * pcePostScriptStream(void) { return psoutput; } void ps_put_char(int c) { Sputc(c, psoutput); } static void putString(const char *s) { Sfputs(s, psoutput); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Output() is a special version of printf. The following options are recognised: Option Argument Description ~~ - Output a tilde ~s char * Output literal string ~a PceString Output PceString as PostScript string ~c Point Output <-x and <-y of the point ~d Int Output an integer ~D int Output an integer ~f float Output a float (passed as integer * 100) ~m Graphical Move to XY of graphical ~t Figure Translate to XY of figure ~T Graphical Set texture to texture of graphical ~C Graphical Output colour of the graphical ~N Name print text of name ~S StringObj Output text of StringObj with postscript escapes ~O Object Output comment to start O ~P Int, Image Output pattern of grayscale image with depth Int ~I Int, Image Output pattern of colour image with depth Int ~p Graphical Output pen of graphical ~x Graphical Output X of graphical ~y Graphical Output Y of graphical ~w Graphical Output W of graphical ~h Graphical Output H of graphical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static void _output(char *fm, va_list args) { char tmp[LINESIZE]; for( ;*fm ; fm++) { switch(*fm) { case '\\': switch(*++fm) /* \ escapes */ { case 'n': ps_put_char('\n'); continue; case '\\': ps_put_char('\\'); continue; case '\0': ps_put_char('\\'); return; } case '~': switch(*++fm) /* ~ escapes */ { case '~': ps_put_char('~'); continue; case '\0': ps_put_char('~'); return; case 's': putString(va_arg(args, char *)); continue; case 'd': sprintf(tmp, "%" PRIdPTR, valInt(va_arg(args, Int))); putString(tmp); continue; case 'D': sprintf(tmp, "%d", va_arg(args, int)); putString(tmp); continue; case 'f': { char *s; sprintf(tmp, "%.2f", va_arg(args, double)); for(s=tmp; *s; s++) if ( *s != '-' && !isalnum(*s) ) *s = '.'; putString(tmp); continue; } case 'm': { Graphical gr = va_arg(args, Graphical); sprintf(tmp, "%" PRIdPTR " " "%" PRIdPTR " moveto", valInt(gr->area->x), valInt(gr->area->y)); putString(tmp); continue; } case 'c': { Point p = va_arg(args, Point); sprintf(tmp, "%" PRIdPTR " " "%" PRIdPTR, valInt(p->x), valInt(p->y)); putString(tmp); continue; } case 't': { Figure f = va_arg(args, Figure); sprintf(tmp, "%" PRIdPTR " " "%" PRIdPTR " translate", valInt(f->offset->x), valInt(f->offset->y)); putString(tmp); continue; } case 'p': { Graphical gr = va_arg(args, Graphical); sprintf(tmp, "%" PRIdPTR, valInt(gr->pen)); putString(tmp); continue; } case 'T': { Name texture = get(va_arg(args, Any), NAME_texture, EAV); if ( texture == NAME_none ) { putString("nodash"); } else if ( instanceOfObject(texture, ClassCharArray) ) { CharArray ca = (CharArray) texture; ca = getDowncaseCharArray(ca); putString(strName(ca)); } continue; } case 'C': { Graphical gr = va_arg(args, Graphical); Colour c = get(gr, NAME_colour, EAV); ps_colour(c, 100); continue; } case 'a': ps_put_string(va_arg(args, PceString)); continue; case 'N': putString(strName(va_arg(args, Name))); continue; case 'S': { StringObj s = va_arg(args, StringObj); ps_put_string(&s->data); continue; } case 'O': { Any obj = va_arg(args, Any); char *s = pp(obj); putString(s); continue; } case 'P': { Int depth = va_arg(args, Int); Image image = va_arg(args, Image); postscriptImage(image, depth, FALSE); continue; } case 'I': { Int depth = va_arg(args, Int); Image image = va_arg(args, Image); postscriptImage(image, depth, TRUE); continue; } case 'x': { Graphical gr = va_arg(args, Graphical); sprintf(tmp, "%" PRIdPTR, valInt(gr->area->x)); putString(tmp); continue; } case 'y': { Graphical gr = va_arg(args, Graphical); sprintf(tmp, "%" PRIdPTR, valInt(gr->area->y)); putString(tmp); continue; } case 'w': { Graphical gr = va_arg(args, Graphical); sprintf(tmp, "%" PRIdPTR, valInt(gr->area->w)); putString(tmp); continue; } case 'h': { Graphical gr = va_arg(args, Graphical); sprintf(tmp, "%" PRIdPTR, valInt(gr->area->h)); putString(tmp); continue; } default: { errorPce(NIL, NAME_unknownEscape, CtoName("~"), toInt(*fm)); ps_put_char('~'), ps_put_char(*fm); continue; } } default: { ps_put_char(*fm); continue; } } } } void ps_output(char *fm, ...) { va_list args; va_start(args, fm); _output(fm, args); va_end(args); } static void ps_put_string(PceString s) { wint_t c; int i, size = s->s_size; ps_put_char('('); for(i=0; i= ' ' && c <= '~' ) { ps_put_char(c); } else { char tmp[8]; sprintf(tmp, "\\%03o", (unsigned int)c); putString(tmp); } } } ps_put_char(')'); } status ps_font(FontObj font) { Name family = (Name) get(font, NAME_postscriptFont, EAV); Int points = (Int) get(font, NAME_postscriptSize, EAV); if ( !family ) family = CtoName("Courier"); if ( !points ) points = font->points; if ( psstatus.currentFont.family == family && psstatus.currentFont.points == points ) succeed; if ( memberChain(documentFonts, family) ) appendChain(documentFonts, family); ps_output("/~N findfont ~d scalefont setfont\n", family, points); succeed; } static void ps_colour(Colour c, int grey) { if ( notDefault(c) && notNil(c) ) { float r = (float) valInt(getRedColour(c)) / (float) valInt(BRIGHT); float g = (float) valInt(getGreenColour(c)) / (float) valInt(BRIGHT); float b = (float) valInt(getBlueColour(c)) / (float) valInt(BRIGHT); if ( grey != 100 ) { r = 1 - (1-r) * grey / 100.0; g = 1 - (1-g) * grey / 100.0; b = 1 - (1-b) * grey / 100.0; } ps_output("~f ~f ~f setrgbcolor ", r, g, b); } } static Int getPostScriptGreyPattern(Any pattern) { Int rval; if ( hasGetMethodObject(pattern, NAME_postscriptGrey) && (rval = get(pattern, NAME_postscriptGrey, EAV)) && (rval = toInteger(rval)) && valInt(rval) >= 0 && valInt(rval) <= 100 ) return rval; fail; } static status fill(Any gr, Name sel) { Image pattern = get(gr, sel, EAV); Int greyLevel; if ( instanceOfObject(pattern, ClassColour) ) { Colour c = (Colour) pattern; ps_output("gsave "); ps_colour(c, 100); ps_output(" fill grestore\n"); } else if ( instanceOfObject(pattern, ClassImage) ) { if ( (greyLevel = getPostScriptGreyPattern(pattern)) ) { Colour c = get(gr, NAME_displayColour, EAV); if ( c ) { ps_output("gsave "); ps_colour(c, valInt(greyLevel)); ps_output(" fill grestore\n"); } else { ps_output("gsave ~f setgray fill grestore\n", (float) (100 - valInt(greyLevel)) / 100.0 ); } } else { ps_output("~x ~y ~w ~h ~d ~d \n<~P>\nfillwithmask\n", gr, gr, gr, gr, pattern->size->w, pattern->size->h, ONE, pattern); } } succeed; } #define putByte(b) { ps_put_char(print[(b >> 4) & 0xf]); \ ps_put_char(print[b & 0xf]); \ if ( (++bytes % 32) == 0 ) ps_put_char('\n'); \ bits = 8; c = 0; \ } status postscriptDrawable(int ox, int oy, int w, int h, int depth, int iscolor) { static char print[] = {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'}; int x, y; int bits, bytes; int c; DEBUG(NAME_postscript, Cprintf("postscriptDrawable(%d %d %d %d) ...", ox, oy, w, h)); for(bytes = y = c = 0, bits = 8; y < h; y++) { for(x=0; x < w; x++) { c |= ((TRUE-(r_get_mono_pixel(x+ox, y+oy))) << --bits); if ( bits == 0 ) putByte(c); } if ( bits != 8 ) putByte(c); } DEBUG(NAME_postscript, Cprintf("ok\n")); succeed; } static int postscriptImage(Image image, Int depth, int iscolor) { ws_postscript_image(image, depth, iscolor); succeed; } /******************************** * HEADER & FOOTER * *********************************/ static int header(Any gr, Area area, BoolObj ls) { int x, y, w, h; int xgr, ygr, wgr, hgr; int paperH, paperW; float scale; if ( isDefault(ls) ) ls = OFF; if ( isDefault(area) ) { x = 70, y = 70, w = 500, h = 700; } else { x = valInt(area->x); y = valInt(area->y); w = valInt(area->w); h = valInt(area->h); } ps_output("%!PS-Adobe-3.0 EPSF-3.0\n"); ps_output("%%Creator: PCE ~N\n", get(PCE, NAME_version, EAV)); ps_output("%%CreationDate: ~S\n", get(PCE, NAME_date, EAV)); ps_output("%%Pages: 1\n"); ps_output("%%DocumentFonts: (atend)\n"); { Area bb = get(gr, NAME_boundingBox, EAV); /* Hack */ if ( instanceOfObject(gr, ClassFrame) ) { assign(bb, x, ZERO); assign(bb, y, ZERO); } xgr = valInt(bb->x); ygr = valInt(bb->y); wgr = valInt(bb->w); hgr = valInt(bb->h); } if ( ls == ON ) paperH = wgr, paperW = hgr; else paperW = wgr, paperH = hgr; if ( wgr <= w && hgr <= h ) { scale = 1.0; } else { scale = min( (float)w / (float)wgr, (float)h/(float)hgr ); paperW = (int)((float)paperW * scale + 0.999); paperH = (int)((float)paperH * scale + 0.999); } if ( ls == ON ) { ps_output("%%BoundingBox: ~D ~D ~D ~D\n", x+w-paperW, y, x+w, y+paperH); } else { ps_output("%%BoundingBox: ~D ~D ~D ~D\n", x, y, x+paperW, y+paperH); } ps_output("%%Object: ~O\n", gr); ps_output("%%EndComments\n\n"); TRY(send(gr, NAME_Postscript, NAME_head, EAV)); ps_output("gsave\n\n"); if ( ls == ON ) ps_output("~D ~D translate 90 rotate\n", x + w, y); else ps_output("~D ~D translate\n", x, y); ps_output("~f ~f scale\n", scale, -scale); ps_output("~D ~D translate\n", -xgr, -hgr - ygr); ps_output("%%EndProlog\n"); ps_output("%%Page 0 1\n"); succeed; } static int footer(void) { Cell cell; ps_output("\n%%Trailer\n"); ps_output("grestore\n"); /* ps_output("/pce restore\n"); */ ps_output("%%DocumentFonts:"); for_cell(cell, documentFonts) ps_output(" ~N", cell->value); ps_output("\n"); succeed; } /******************************* * MACROS * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Definition of PostScript macros used by the real code. First is the name of the Macro, followed by the definion, and finally a comma-separated list of required definitions. A two pass process through the actual objects for which to create PostScript will first generate the required header, followed by the actual object. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #define PSMACRO(a, b, r) { a, b, r } typedef struct { Name name; const char *def; const char *required; } psmacro; static psmacro macrodefs[] = { PSMACRO(NAME_dotted, "\t{ [1 5] 0 setdash\n" "\t} def", NULL), PSMACRO(NAME_dashed, "\t{ [5] 0 setdash\n" "\t} def", NULL), PSMACRO(NAME_dashdot, "\t{ [5 2 1 2] 0 setdash\n" "\t} def", NULL), PSMACRO(NAME_dashdotted, "\t{ [5 2 1 2 1 2 1 2] 0 setdash\n" "\t} def", NULL), PSMACRO(NAME_longdash, "\t{ [8 5] 0 setdash\n" "\t} def", NULL), PSMACRO(NAME_nodash, "\t{ [] 0 setdash\n" "\t} def", NULL), PSMACRO(NAME_pspen, "\t{ 2 div\n" "\t} def", NULL), PSMACRO(NAME_pen, "\t{ pspen\n" "\t setlinewidth\n" "\t} def", "pspen"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Draw a path according to the current texture and pen. Draws % only if the pen is not 0. If a dash pattern is provided the % path is first cleared. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_draw, "\t{ 0 currentlinewidth ne\n" "\t { currentdash 0 eq exch [] eq and not\n" "\t { gsave nodash 1 setgray stroke grestore\n" "\t } if\n" "\t stroke\n" "\t } if\n" "\t} def", NULL), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Create a rectangular path from x, y, w, h in the current dict - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_region, "\t{ newpath\n" "\t x y moveto\n" "\t w 0 rlineto\n" "\t 0 h rlineto\n" "\t w neg 0 rlineto\n" "\t closepath\n" "\t} def", NULL), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Paint inverted - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_invert, "\t{ {1 exch sub} settransfer\n" "\t} def", NULL), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Create a path for a PCE box without rounded corners. Stack: % % pen x y w h radius BOXPATH path - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_boxpath, "\t{ /r exch def\n" "\t /h exch def\n" "\t /w exch def\n" "\t /y exch def\n" "\t /x exch def\n" "\t /p exch def\n" "\t \n" "\t r 0 eq\n" "\t { 2 setlinecap newpath\n" "\t x p pspen add y p pspen add moveto\n" "\t w p sub 0 rlineto\n" "\t 0 h p sub rlineto\n" "\t w p sub neg 0 rlineto\n" "\t 0 h p sub neg rlineto\n" "\t }\n" "\t { newpath\n" "\t /pr r p pspen add def\n" "\t x pr add y p pspen add moveto\n" "\t x w add pr sub y pr add r 270 360 arc\n" "\t x w add pr sub y h add pr sub r 0 90 arc\n" "\t x pr add y h add pr sub r 90 180 arc\n" "\t x pr add y pr add r 180 270 arc\n" "\t } ifelse\n" "\t \n" "\t p pen\n" "\t} def", "pen,pspen"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Create a path for a PCE circle. % pen x y radius CIRCLEPATH - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_circlepath, "\t{ /r exch def\n" "\t /y exch def\n" "\t /x exch def\n" "\t /p exch def\n" "\t newpath\n" "\t x r add y r add r p pspen sub 0 360 arc\n" "\t \n" "\t p pen\n" "\t} def", "pen,pspen"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Create a path for a PCE ellipse % pen x y w h ELLIPSEPATH - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_ellipsepath, "\t{ /h exch 2 div def\n" "\t /w exch 2 div def\n" "\t /y exch def\n" "\t /x exch def\n" "\t /p exch def\n" "\t matrix currentmatrix\n" "\t x w add y h add translate\n" "\t w p pspen sub h p pspen sub scale\n" "\t newpath\n" "\t 0 0 1 0 360 arc\n" "\t setmatrix\n" "\t p pen\n" "\t} def", "pen,pspen"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % pen close x y w h start size ARCPATH - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_arcpath, "\t{ /size exch neg def\n" "\t /start exch neg 360 add def\n" "\t /h exch def\n" "\t /w exch def\n" "\t /y exch def\n" "\t /x exch def\n" "\t /close exch def\n" "\t /p exch def\n" "\t matrix currentmatrix\n" "\t x y translate\n" "\t w p pspen sub h p pspen sub scale\n" "\t newpath\n" "\t close 2 eq { 0 0 moveto } if\n" "\t size 0 le\n" "\t { 0 0 1 start start size add arcn\n" "\t }\n" "\t { 0 0 1 start start size add arc\n" "\t } ifelse\n" "\t close 0 ne { closepath } if\n" "\t setmatrix\n" "\t p pen\n" "\t} def", "pen,pspen"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % pen x y STARTPATH - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_startpath, "\t{ newpath moveto pen\n" "\t} def", "pen"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Linepath: create a path for a pce line % pen x y w h LINEPATH - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_linepath, "\t{ /h exch def\n" "\t /w exch def\n" "\t newpath moveto w h rlineto\n" "\t pen\n" "\t} def", "pen"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % drawline: draw a line using current pen/texture % x1 y1 x2 y2 DRAWLINE - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_drawline, "\t{ /y2 exch def\n" "\t /x2 exch def\n" "\t newpath moveto x2 y2 lineto\n" "\t draw\n" "\t} def", "draw"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % x y w h CLEAR % Clear a region - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_clear, "\t{ /h exch def\n" "\t /w exch def\n" "\t /y exch def\n" "\t /x exch def\n" "\t gsave\n" "\t region 1 setgray fill\n" "\t grestore\n" "\t} def", "region"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % text. (x,y) is the xy coordinate of the baselinestart of the first % character. w is the width to which the text is scaled. % x y w string TEXT - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_text, "\t{ /s exch def\n" "\t /w exch def\n" "\t \n" "\t gsave\n" "\t 1 eq { invert } if\n" "\t moveto s stringwidth pop w exch div -1 scale s show\n" "\t grestore\n" "\t} def", NULL), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % x y w h BITMAP hexdata Draw a transparent image. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_bitmap, "\t{ /h exch def\n" "\t /w exch def\n" "\t /y exch def\n" "\t /x exch def\n" "\t gsave\n" /* "\t {1 exch sub} settransfer\n" */ /* " region clip" */ "\t x y h add translate\n" "\t /w8 w 7 add 8 idiv 8 mul def\n" "\t /picstr w8 8 idiv string def\n" "\t w8 h neg scale\n" "\t w8 h false [w 0 0 h neg 0 h]\n" "\t {currentfile picstr readhexstring pop} imagemask\n" "\t grestore\n" "\t} def", NULL), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % x y w h depth GREYMAP hexdata - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_greymap, "\t{ /d exch def\n" "\t /h exch def\n" "\t /w exch def\n" "\t /y exch def\n" "\t /x exch def\n" "\t gsave\n" " region clip" "\t x y h add translate\n" "\t /w8 w 7 add 8 idiv 8 mul def\n" "\t /picstr w8 8 idiv string def\n" "\t w h neg scale\n" "\t w8 h d [w 0 0 h neg 0 h]\n" "\t {currentfile picstr readhexstring pop} image\n" "\t grestore\n" "\t} def", "region"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % x y w h depth RGBMAP hexdata - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_rgbimage, "\t{ /d exch def\n" "\t /h exch def\n" "\t /w exch def\n" "\t /y exch def\n" "\t /x exch def\n" "\t gsave\n" " region clip" "\t x y h add translate\n" "\t /w8 w 7 add 8 idiv 8 mul def\n" "\t /picstr w8 8 idiv string def\n" "\t w h neg scale\n" "\t w8 h d [w 0 0 h neg 0 h]\n" "\t {currentfile picstr readhexstring pop} false 3 colorimage\n" "\t grestore\n" "\t} def", "region"), /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % x y w h pw ph pattern FILLWITHMASK % Fill path with a repetitive pattern which is sized (pw, ph). % discribe an area that encapsulates the path. is a % 1-deep image. 1's of the image are painted in the current colour. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PSMACRO(NAME_fillwithmask, "\t{ /patternstring exch def\n" "\t /ph exch def\n" "\t /pw exch def\n" "\t /h exch def\n" "\t /w exch def\n" "\t /y exch def\n" "\t /x exch def\n" "\t \n" "\t /pw8 pw 7 add 8 idiv 8 mul def\n" "\t \n" "\t /putpattern\n" "\t { translate 1 -1 scale\n" "\t newpath 0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto closepath\n" "\t clip\n" "\t pw8 ph false [pw 0 0 ph neg 0 ph] patternstring imagemask\n" "\t } def\n" "\t gsave\n" "\t clip\n" "\t gsave 1 setgray fill grestore\n" "\t x y translate pw ph scale\n" "\t 0 1 w pw div ceiling 1 sub\n" "\t { 1 1 h ph div ceiling\n" "\t { gsave 2 copy putpattern pop grestore\n" "\t } for\n" "\t } for\n" "\t grestore\n" "\t} def", NULL), PSMACRO(NAME_, NULL, NULL) /* closes the list */ }; Sheet makePSDefinitions() { Sheet sh = globalObject(NAME_postscriptDefs, ClassSheet, EAV); psmacro *m; for(m=macrodefs; m->def; m++) send(sh, NAME_value, m->name, CtoString(m->def), EAV); return sh; } static void psdef(Name macro) { if ( !memberChain(documentDefs, macro) ) { Sheet psdefs = findGlobal(NAME_postscriptDefs); StringObj def; psmacro *m; if ( !psdefs ) psdefs = makePSDefinitions(); for(m=macrodefs; m->def; m++) { if ( m->name == macro ) { if ( m->required ) { const char *r = m->required; const char *q; char name[100]; while((q = strchr(r, ','))) { strncpy(name, r, q-r); name[q-r] = EOS; psdef(CtoName(name)); r = q+1; } if ( r[0] ) { psdef(CtoName(r)); } } break; } } if ( psdefs && (def = getValueSheet(psdefs, macro)) ) { ps_output("/~s\n~s\n\n", strName(macro), strName(def)); appendChain(documentDefs, macro); } } } static void psdef_texture(Any obj) { Name texture = get(obj, NAME_texture, EAV); if ( texture == NAME_none ) psdef(NAME_nodash); else psdef(texture); } static void psdef_fill(Any gr, Name sel) { Any pattern = get(gr, sel, EAV); if ( instanceOfObject(pattern, ClassImage) && !getPostScriptGreyPattern(pattern) ) psdef(NAME_fillwithmask); } static void psdef_arrows(Any obj) { Joint j = obj; if ( notNil(j->first_arrow) ) postscriptGraphical(j->first_arrow, NAME_head); if ( notNil(j->second_arrow) ) postscriptGraphical(j->second_arrow, NAME_head); } /******************************** * POSTSCRIPT * *********************************/ status postscriptGraphical(Any obj, Name hb) { if ( hb == NAME_body ) ps_output("\n%%Object: ~O\n", obj); return send(obj, NAME_DrawPostScript, hb, EAV); } status drawPostScriptDevice(Device dev, Name hb) { Cell cell; if ( hb == NAME_body ) ps_output("gsave ~t ~C\n", dev, dev); for_cell(cell, dev->graphicals) { Graphical gr = cell->value; if ( gr->displayed == ON ) send(gr, NAME_Postscript, hb, EAV); } if ( hb == NAME_body ) ps_output("grestore\n"); succeed; } status drawPostScriptFigure(Figure f, Name hb) { if ( f->pen != ZERO || notNil(f->background) ) { if ( hb == NAME_head ) { psdef(NAME_boxpath); psdef(NAME_draw); psdef_texture(f); psdef_fill(f, NAME_background); } else { ps_output("gsave ~C ~T ~p ~x ~y ~w ~h ~d boxpath\n", f, f, f, f, f, f, f, f->radius); fill(f, NAME_background); ps_output("draw grestore\n"); } } return drawPostScriptDevice((Device) f, hb); } static void ps_line(int x1, int y1, int x2, int y2) { ps_output("~D ~D ~D ~D drawline\n", x1, y1, x2, y2); } static void ps_image(Image img, int sx, int sy, int x, int y, int w, int h, BoolObj transparent, Name hb) { if ( sx || sy ) Cprintf("ps_image(): sx/sy parameters currently ignored\n"); if ( hb == NAME_head ) { psdef(NAME_greymap); } else { Int depth = get(img, NAME_postscriptDepth, EAV); ps_output("~D ~D ~D ~D ~d greymap\n~P\n", x, y, w, h, depth, depth, img); } } static void drawPostScriptNode(Node node, Image cimg, Image eimg) { Graphical img = node->image; Tree t = node->tree; int lg = valInt(t->levelGap)/2; Node lastnode; int ly = valInt(img->area->y) + valInt(img->area->h)/2; int lx = valInt(img->area->x); Image i = NULL; if ( node->collapsed == OFF && eimg ) i = eimg; else if ( node->collapsed == ON && cimg ) i = cimg; if ( i || node != t->displayRoot ) ps_line(lx-lg, ly, lx, ly); /* line to parent */ if ( i ) { int iw = valInt(i->size->w); int ih = valInt(i->size->h); ps_image(i, 0, 0, lx-lg-(iw+1)/2, ly-(ih+1)/2, iw, ih, OFF, NAME_body); } if ( notNil(node->sons) && node->collapsed != ON && (lastnode = getTailChain(node->sons)) ) /* I have sons */ { int fy = valInt(getBottomSideGraphical(img)); Graphical last = lastnode->image; int ty = valInt(last->area->y) + valInt(last->area->h)/2; int lx = valInt(img->area->x) + lg; Cell cell; ps_line(lx, fy, lx, ty); for_cell(cell, node->sons) drawPostScriptNode(cell->value, cimg, eimg); } } status drawPostScriptTree(Tree tree, Name hb) { if ( tree->direction == NAME_list && notNil(tree->displayRoot) ) { Line proto = tree->link->line; if ( hb == NAME_head ) { psdef(NAME_greymap); psdef(NAME_drawline); psdef_texture(proto); psdef(NAME_pen); } else { if ( proto->pen != ZERO ) { Image cimg = getClassVariableValueObject(tree, NAME_collapsedImage); Image eimg = getClassVariableValueObject(tree, NAME_expandedImage); ps_output("gsave\n~t ~C ~T ~p pen\n", tree, proto, proto, proto); drawPostScriptNode(tree->displayRoot, cimg, eimg); ps_output("grestore\n"); } } } return drawPostScriptFigure((Figure)tree, hb); } status drawPostScriptBox(Box b, Name hb) { if ( hb == NAME_head ) { psdef(NAME_draw); psdef(NAME_boxpath); psdef_texture(b); psdef_fill(b, NAME_fillPattern); } else { Area a = b->area; int x = valInt(a->x); int y = valInt(a->y); int w = valInt(a->w); int h = valInt(a->h); int r = valInt(b->radius); int rmax; NormaliseArea(x, y, w, h); rmax = min(w, h)/2; if ( r > rmax ) r = rmax; if ( b->shadow != ZERO ) { int s = valInt(b->shadow); ps_output("gsave nodash 0 ~D ~D ~D ~D ~D boxpath\n", x+s, y+s, w-s, h-s, r); ps_output("0.0 setgray fill grestore\n"); ps_output("gsave ~C ~T ~p ~x ~y ~d ~d ~d boxpath\n", b, b, b, b, b, toInt(w-s), toInt(h-s), toInt(r)); if ( notNil(b->fill_pattern) ) fill(b, NAME_fillPattern); else ps_output("gsave 1.0 setgray fill grestore\n"); ps_output("draw grestore\n"); } else { ps_output("gsave ~C ~T ~p ~D ~D ~D ~D ~D boxpath\n", b, b, b, x, y, w, h, r); fill(b, NAME_fillPattern); ps_output("draw grestore\n"); } } succeed; } status drawPostScriptCircle(Circle c, Name hb) { if ( hb == NAME_head ) { psdef(NAME_draw); psdef(NAME_circlepath); psdef_texture(c); psdef_fill(c, NAME_fillPattern); } else { ps_output("gsave ~C ~T ~p ~x ~y ~d circlepath\n", c, c, c, c, c, div(c->area->w, TWO)); fill(c, NAME_fillPattern); ps_output("draw grestore\n"); } succeed; } status drawPostScriptEllipse(EllipseObj e, Name hb) { if ( hb == NAME_head ) { psdef(NAME_draw); psdef(NAME_nodash); psdef_texture(e); psdef(NAME_ellipsepath); psdef_fill(e, NAME_fillPattern); } else { if ( e->shadow != ZERO ) { Area a = e->area; Int s = e->shadow; ps_output("gsave nodash 0 ~d ~d ~d ~d ellipsepath\n", add(a->x, s), add(a->y, s), sub(a->w, s), sub(a->h, s)); ps_output("0.0 setgray fill grestore\n"); ps_output("gsave ~C ~T ~p ~x ~y ~d ~d ellipsepath\n", e, e, e, e, e, sub(a->w, s), sub(a->h, s)); if ( notNil(e->fill_pattern) ) fill(e, NAME_fillPattern); else ps_output("gsave 1.0 setgray fill grestore\n"); ps_output("draw grestore\n"); } else { ps_output("gsave ~C ~T ~p ~x ~y ~w ~h ellipsepath\n", e, e, e, e, e, e, e); fill(e, NAME_fillPattern); ps_output("draw grestore\n"); } } succeed; } status drawPostScriptPath(Path p, Name hb) { if ( hb == NAME_head ) { psdef(NAME_draw); psdef(NAME_startpath); psdef_texture(p); psdef_fill(p, NAME_fillPattern); psdef_arrows(p); if ( notNil(p->mark) ) draw_postscript_image(p->mark, ZERO, ZERO, hb); } else { if ( valInt(getSizeChain(p->points)) >= 2 ) { Chain points = (p->kind == NAME_smooth ? p->interpolation : p->points); if ( p->kind == NAME_smooth ) /* Smooth path */ { Cell cell; int i = -1; /* skip first */ int px, py, x0, y0; Point pt = getHeadChain(points); x0 = valInt(pt->x); y0 = valInt(pt->y); if ( p->closed == ON ) { Point end = getTailChain(points); px = valInt(end->x); py = valInt(end->y); } else { Point pn = getNth1Chain(points, TWO); px = x0 - (valInt(pn->x) - x0); py = y0 - (valInt(pn->y) - y0); } ps_output("gsave ~d ~d translate ~C ~T ~p ~c startpath\n", p->offset->x, p->offset->y, p, p, p, pt); for_cell(cell, points) { if ( i >= 0 ) { Point pt = cell->value; int x3 = valInt(pt->x); int y3 = valInt(pt->y); int nx, ny; float x1, y1, x2, y2; if ( notNil(cell->next) ) { Point np = cell->next->value; nx = valInt(np->x); ny = valInt(np->y); } else if ( p->closed == ON ) { Point np = getHeadChain(points); nx = valInt(np->x); ny = valInt(np->y); } else { nx = x3 + x3 - x0; ny = y3 + y3 -y0; } x1 = (float) x0 + (float) ((x0-px) + (x3-x0) + 4) / 8.0; y1 = (float) y0 + (float) ((y0-py) + (y3-y0) + 4) / 8.0; x2 = (float) x3 - (float) ((nx-x3) + (x3-x0) + 4) / 8.0; y2 = (float) y3 - (float) ((ny-y3) + (y3-y0) + 4) / 8.0; ps_output("~f ~f ~f ~f ~D ~D curveto\n", x1, y1, x2, y2, x3, y3); px = x0; py = y0; x0 = x3; y0 = y3; } i++; } if ( notNil(p->fill_pattern) || p->closed == ON ) ps_output(" closepath"); ps_output("\n"); fill(p, NAME_fillPattern); ps_output("draw\n"); } else /* poly-path */ { Cell cell; int i = -1; /* skip first */ ps_output("gsave ~d ~d translate ~C ~T ~p ~c startpath\n", p->offset->x, p->offset->y, p, p, p, getHeadChain(points)); for_cell(cell, p->points) { if ( i >= 0 ) { ps_output(" ~c lineto", cell->value); if ( i % 6 == 0 ) ps_output("\n"); } i++; } if ( notNil(p->fill_pattern) || p->closed == ON ) ps_output(" closepath"); ps_output("\n"); fill(p, NAME_fillPattern); ps_output("draw\n"); } if ( notNil(p->mark) ) { Cell cell; Image i = p->mark; int iw = valInt(i->size->w); int ih = valInt(i->size->h); int iw2 = (iw+1)/2; int ih2 = (ih+1)/2; int ox = valInt(p->offset->x); int oy = valInt(p->offset->y); for_cell(cell, p->points) { Point pt = cell->value; draw_postscript_image(i, toInt(valInt(pt->x) - iw2 + ox), toInt(valInt(pt->y) - ih2 + oy), hb); } } if ( adjustFirstArrowPath(p) ) postscriptGraphical(p->first_arrow, hb); if ( adjustSecondArrowPath(p) ) postscriptGraphical(p->second_arrow, hb); ps_output("grestore\n"); } } succeed; } status drawPostScriptBezier(Bezier b, Name hb) { if ( hb == NAME_head ) { psdef(NAME_draw); psdef(NAME_startpath); psdef_texture(b); psdef_arrows(b); } else { ps_output("gsave ~C\n", b); if ( b->pen != ZERO ) { ps_output("newpath ~d ~d moveto\n", b->start->x, b->start->y); ps_output("~T ~p pen\n", b, b); if ( isNil(b->control2) ) { /* TBD: This is not correct! */ ps_output("~d ~d ~d ~d ~d ~d curveto draw\n", b->control1->x, b->control1->y, b->control1->x, b->control1->y, b->end->x, b->end->y); } else { ps_output("~d ~d ~d ~d ~d ~d curveto draw\n", b->control1->x, b->control1->y, b->control2->x, b->control2->y, b->end->x, b->end->y); } } if ( adjustFirstArrowBezier(b) ) postscriptGraphical(b->first_arrow, hb); if ( adjustSecondArrowBezier(b) ) postscriptGraphical(b->second_arrow, hb); ps_output("grestore\n"); } succeed; } status drawPostScriptLine(Line ln, Name hb) { if ( hb == NAME_head ) { if ( ln->pen != ZERO ) { if ( ln->pen != ZERO ) { psdef(NAME_draw); psdef(NAME_linepath); psdef_texture(ln); } psdef_arrows(ln); } } else { int x1 = valInt(ln->start_x); int x2 = valInt(ln->end_x); int y1 = valInt(ln->start_y); int y2 = valInt(ln->end_y); ps_output("gsave ~C\n", ln); if ( ln->pen != ZERO ) ps_output("~T ~p ~D ~D ~D ~D linepath draw\n", ln, ln, x1, y1, x2-x1, y2-y1); if ( adjustFirstArrowLine(ln) ) { Colour old = ln->first_arrow->colour; ln->first_arrow->colour = ln->colour; postscriptGraphical(ln->first_arrow, hb); ln->first_arrow->colour = old; } if ( adjustSecondArrowLine(ln) ) { Colour old = ln->second_arrow->colour; ln->second_arrow->colour = ln->colour; postscriptGraphical(ln->second_arrow, hb); ln->second_arrow->colour = old; } ps_output("grestore\n"); } succeed; } status drawPostScriptArrow(Arrow a, Name hb) { if ( hb == NAME_head ) { psdef(NAME_draw); psdef_texture(a); psdef(NAME_pen); } else { ps_output("gsave ~C ~T ~p pen ", a, a, a); ps_output("newpath ~d ~d moveto ~d ~d lineto ~d ~d lineto", a->left->x, a->left->y, a->tip->x, a->tip->y, a->right->x, a->right->y); if ( a->style == NAME_closed || notNil(a->fill_pattern) ) ps_output(" closepath "); if ( notNil(a->fill_pattern) ) fill(a, NAME_fillPattern); if ( a->pen != ZERO ) ps_output(" ~T draw\n", a); ps_output(" grestore\n"); } succeed; } status drawPostScriptArc(ArcObj a, Name hb) { if ( hb == NAME_head ) { psdef(NAME_draw); psdef(NAME_arcpath); psdef_fill(a, NAME_fillPattern); psdef_arrows(a); } else { ps_output("gsave ~C ~T ~p ~D ~d ~d ~d ~d ~f ~f arcpath\n", a, a, a, a->close == NAME_none ? 0 : a->close == NAME_chord ? 1 : 2, a->position->x, a->position->y, a->size->w, a->size->h, valReal(a->start_angle), valReal(a->size_angle)); fill(a, NAME_fillPattern); ps_output("draw\n"); if ( notNil(a->first_arrow) || notNil(a->second_arrow) ) { int sx, sy, cx, cy, ex, ey; points_arc(a, &sx, &sy, &ex, &ey); cx = valInt(a->position->x); cy = valInt(a->position->y); if (notNil(a->first_arrow)) /* should be merged from arc.c */ { Any av[4]; av[0] = toInt(sx); av[1] = toInt(sy); if ( valReal(a->size_angle) >= 0.0 ) { av[2] = toInt(sx+(sy-cy)); av[3] = toInt(sy-(sx-cx)); } else { av[2] = toInt(sx-(sy-cy)); av[3] = toInt(sy+(sx-cx)); } if ( qadSendv(a->first_arrow, NAME_points, 4, av) ) { ComputeGraphical(a->first_arrow); postscriptGraphical(a->first_arrow, hb); } } if (notNil(a->second_arrow)) { Any av[4]; av[0] = toInt(ex); av[1] = toInt(ey); if ( valReal(a->size_angle) >= 0.0 ) { av[2] = toInt(ex-(ey-cy)); av[3] = toInt(ey+(ex-cx)); } else { av[2] = toInt(ex+(ey-cy)); av[3] = toInt(ey-(ex-cx)); } if ( qadSendv(a->second_arrow, NAME_points, 4, av) ) { ComputeGraphical(a->second_arrow); postscriptGraphical(a->second_arrow, hb); } } } ps_output("grestore\n"); } succeed; } static status draw_postscript_image(Image image, Int x, Int y, Name hb) { if ( image->depth == ONE /* && image->transparent == ON */ ) { if ( hb == NAME_head ) { psdef(NAME_bitmap); } else { Int iw = image->size->w; Int ih = image->size->h; ps_output("~d ~d ~d ~d bitmap\n~I\n", x, y, iw, ih, ONE, image); } } else { Name format = get(image, NAME_postscriptFormat, EAV); if ( format == NAME_colour ) { if ( hb == NAME_head ) { psdef(NAME_rgbimage); } else { Int depth = get(image, NAME_postscriptDepth, EAV); ps_output("~d ~d ~d ~d ~d rgbimage\n~I\n", x, y, image->size->w, image->size->h, depth, depth, image); } } else { if ( hb == NAME_head ) { psdef(NAME_greymap); } else { Int depth = get(image, NAME_postscriptDepth, EAV); ps_output("~d ~d ~d ~d ~d greymap\n~P\n", x, y, image->size->w, image->size->h, depth, depth, image); } } } succeed; } status drawPostScriptBitmap(BitmapObj bm, Name hb) { return draw_postscript_image(bm->image, bm->area->x, bm->area->y, hb); } status drawPostScriptImage(Image image, Name hb) { return draw_postscript_image(image, ZERO, ZERO, hb); } #define Wrapped(t) ((t)->wrap == NAME_wrap || \ (t)->wrap == NAME_wrapFixedWidth) status drawPostScriptText(TextObj t, Name hb) { PceString s = &t->string->data; if ( s[0].s_size > 0 ) /* i.e. non-empty */ { int x, y, w; int b = valInt(t->border); x = valInt(t->area->x); y = valInt(t->area->y); w = valInt(t->area->w); if ( isDefault(t->background) ) { if ( hb == NAME_head ) psdef(NAME_clear); else ps_output("~x ~y ~w ~h clear\n", t, t, t, t); } if ( hb == NAME_body ) ps_output("gsave ~C", t); else psdef(NAME_text); if ( t->pen != ZERO || notNil(t->background) ) { if ( hb == NAME_head ) { psdef_fill(t, NAME_background); psdef_texture(t); psdef(NAME_boxpath); if ( t->pen != ZERO ) psdef(NAME_draw); } else { ps_output("~T ~p ~x ~y ~w ~h 0 boxpath\n", t, t, t, t, t, t); fill(t, NAME_background); if ( t->pen != ZERO ) ps_output("draw\n"); } } if ( hb == NAME_head ) { if ( t->wrap == NAME_clip ) { psdef(NAME_boxpath); psdef_texture(t); } if ( t->underline == ON ) { psdef(NAME_nodash); psdef(NAME_linepath); psdef(NAME_draw); } } else { int flags = 0; if ( t->underline == ON ) flags |= TXT_UNDERLINED; if ( Wrapped(t) ) { LocalString(buf, s->s_iswide, s->s_size + MAX_WRAP_LINES); str_format(buf, s, valInt(t->margin), t->font); ps_string(buf, t->font, x+b, y+b, w-2*b, t->format, flags); } else if ( t->wrap == NAME_clip ) { ps_output("gsave 0 ~x ~y ~w ~h 0 boxpath clip\n", t, t, t, t); ps_string(s, t->font, x+b+valInt(t->x_offset), y+b, w-2*b, t->format, flags); ps_output("grestore\n"); } else ps_string(s, t->font, x+b, y+b, w-2*b, t->format, flags); ps_output("grestore\n", t); } } succeed; } /******************************** * WINDOWS AND DISPLAY * ********************************/ status postscriptFrame(FrameObj fr, Name hb) { if ( hb == NAME_head ) { psdef(NAME_rgbimage); succeed; } else return ws_postscript_frame(fr, TRUE); } status postscriptDisplay(DisplayObj d, Name hb) { if ( hb == NAME_head ) { psdef(NAME_rgbimage); succeed; } else return ws_postscript_display(d, TRUE); }