1395 lines
44 KiB
C
1395 lines
44 KiB
C
/*
|
||
* tkCanvPs.c --
|
||
*
|
||
* This module provides Postscript output support for canvases,
|
||
* including the "postscript" widget command plus a few utility
|
||
* procedures used for generating Postscript.
|
||
*
|
||
* Copyright (c) 1991-1994 The Regents of the University of California.
|
||
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||
*
|
||
* See the file "license.terms" for information on usage and redistribution
|
||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||
*
|
||
* SCCS: @(#) tkCanvPs.c 1.57 97/10/28 18:08:39
|
||
*/
|
||
|
||
#include "tkInt.h"
|
||
#include "tkCanvas.h"
|
||
#include "tkPort.h"
|
||
|
||
/*
|
||
* See tkCanvas.h for key data structures used to implement canvases.
|
||
*/
|
||
|
||
/*
|
||
* One of the following structures is created to keep track of Postscript
|
||
* output being generated. It consists mostly of information provided on
|
||
* the widget command line.
|
||
*/
|
||
|
||
typedef struct TkPostscriptInfo {
|
||
int x, y, width, height; /* Area to print, in canvas pixel
|
||
* coordinates. */
|
||
int x2, y2; /* x+width and y+height. */
|
||
char *pageXString; /* String value of "-pagex" option or NULL. */
|
||
char *pageYString; /* String value of "-pagey" option or NULL. */
|
||
double pageX, pageY; /* Postscript coordinates (in points)
|
||
* corresponding to pageXString and
|
||
* pageYString. Don't forget that y-values
|
||
* grow upwards for Postscript! */
|
||
char *pageWidthString; /* Printed width of output. */
|
||
char *pageHeightString; /* Printed height of output. */
|
||
double scale; /* Scale factor for conversion: each pixel
|
||
* maps into this many points. */
|
||
Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */
|
||
int rotate; /* Non-zero means output should be rotated
|
||
* on page (landscape mode). */
|
||
char *fontVar; /* If non-NULL, gives name of global variable
|
||
* containing font mapping information.
|
||
* Malloc'ed. */
|
||
char *colorVar; /* If non-NULL, give name of global variable
|
||
* containing color mapping information.
|
||
* Malloc'ed. */
|
||
char *colorMode; /* Mode for handling colors: "monochrome",
|
||
* "gray", or "color". Malloc'ed. */
|
||
int colorLevel; /* Numeric value corresponding to colorMode:
|
||
* 0 for mono, 1 for gray, 2 for color. */
|
||
char *fileName; /* Name of file in which to write Postscript;
|
||
* NULL means return Postscript info as
|
||
* result. Malloc'ed. */
|
||
char *channelName; /* If -channel is specified, the name of
|
||
* the channel to use. */
|
||
Tcl_Channel chan; /* Open channel corresponding to fileName. */
|
||
Tcl_HashTable fontTable; /* Hash table containing names of all font
|
||
* families used in output. The hash table
|
||
* values are not used. */
|
||
int prepass; /* Non-zero means that we're currently in
|
||
* the pre-pass that collects font information,
|
||
* so the Postscript generated isn't
|
||
* relevant. */
|
||
} TkPostscriptInfo;
|
||
|
||
/*
|
||
* The table below provides a template that's used to process arguments
|
||
* to the canvas "postscript" command and fill in TkPostscriptInfo
|
||
* structures.
|
||
*/
|
||
|
||
static Tk_ConfigSpec configSpecs[] = {
|
||
{TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, colorVar), 0},
|
||
{TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, colorMode), 0},
|
||
{TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, fileName), 0},
|
||
{TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, channelName), 0},
|
||
{TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, fontVar), 0},
|
||
{TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, height), 0},
|
||
{TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
|
||
{TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
|
||
{TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
|
||
{TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, pageXString), 0},
|
||
{TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, pageYString), 0},
|
||
{TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, rotate), 0},
|
||
{TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, width), 0},
|
||
{TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, x), 0},
|
||
{TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
|
||
"", Tk_Offset(TkPostscriptInfo, y), 0},
|
||
{TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
|
||
(char *) NULL, 0, 0}
|
||
};
|
||
|
||
/*
|
||
* The prolog data. Generated by str2c from prolog.ps
|
||
* This was split in small chunks by str2c because
|
||
* some C compiler have limitations on the size of static strings.
|
||
*/
|
||
static CONST char * CONST prolog[]= {
|
||
/* Start of part 1 (2000 characters) */
|
||
"%%BeginProlog\n\
|
||
50 dict begin\n\
|
||
\n\
|
||
% This is a standard prolog for Postscript generated by Tk's canvas\n\
|
||
% widget.\n\
|
||
% SCCS: @(#) prolog.ps 1.7 96/07/08 17:52:14\n\
|
||
\n\
|
||
% The definitions below just define all of the variables used in\n\
|
||
% any of the procedures here. This is needed for obscure reasons\n\
|
||
% explained on p. 716 of the Postscript manual (Section H.2.7,\n\
|
||
% \"Initializing Variables,\" in the section on Encapsulated Postscript).\n\
|
||
\n\
|
||
/baseline 0 def\n\
|
||
/stipimage 0 def\n\
|
||
/height 0 def\n\
|
||
/justify 0 def\n\
|
||
/lineLength 0 def\n\
|
||
/spacing 0 def\n\
|
||
/stipple 0 def\n\
|
||
/strings 0 def\n\
|
||
/xoffset 0 def\n\
|
||
/yoffset 0 def\n\
|
||
/tmpstip null def\n\
|
||
\n\
|
||
% Define the array ISOLatin1Encoding (which specifies how characters are\n\
|
||
% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript\n\
|
||
% level 2 is supposed to define it, but level 1 doesn't).\n\
|
||
\n\
|
||
systemdict /ISOLatin1Encoding known not {\n\
|
||
/ISOLatin1Encoding [\n\
|
||
/space /space /space /space /space /space /space /space\n\
|
||
/space /space /space /space /space /space /space /space\n\
|
||
/space /space /space /space /space /space /space /space\n\
|
||
/space /space /space /space /space /space /space /space\n\
|
||
/space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\
|
||
/quoteright\n\
|
||
/parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\
|
||
/zero /one /two /three /four /five /six /seven\n\
|
||
/eight /nine /colon /semicolon /less /equal /greater /question\n\
|
||
/at /A /B /C /D /E /F /G\n\
|
||
/H /I /J /K /L /M /N /O\n\
|
||
/P /Q /R /S /T /U /V /W\n\
|
||
/X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\
|
||
/quoteleft /a /b /c /d /e /f /g\n\
|
||
/h /i /j /k /l /m /n /o\n\
|
||
/p /q /r /s /t /u /v /w\n\
|
||
/x /y /z /braceleft /bar /braceright /asciitilde /space\n\
|
||
/space /space /space /space /space /space /space /space\n\
|
||
/space /space /space /space /space /space /space /space\n\
|
||
/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\
|
||
/dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\
|
||
/space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\
|
||
/dieresis /copyright /ordfem",
|
||
/* End of part 1 */
|
||
|
||
/* Start of part 2 (2000 characters) */
|
||
"inine /guillemotleft /logicalnot /hyphen\n\
|
||
/registered /macron\n\
|
||
/degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\
|
||
/periodcentered\n\
|
||
/cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\
|
||
/onehalf /threequarters /questiondown\n\
|
||
/Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\
|
||
/Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\
|
||
/Idieresis\n\
|
||
/Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\
|
||
/Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\
|
||
/germandbls\n\
|
||
/agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\
|
||
/egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\
|
||
/idieresis\n\
|
||
/eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\
|
||
/oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\
|
||
/ydieresis\n\
|
||
] def\n\
|
||
} if\n\
|
||
\n\
|
||
% font ISOEncode font\n\
|
||
% This procedure changes the encoding of a font from the default\n\
|
||
% Postscript encoding to ISOLatin1. It's typically invoked just\n\
|
||
% before invoking \"setfont\". The body of this procedure comes from\n\
|
||
% Section 5.6.1 of the Postscript book.\n\
|
||
\n\
|
||
/ISOEncode {\n\
|
||
dup length dict begin\n\
|
||
{1 index /FID ne {def} {pop pop} ifelse} forall\n\
|
||
/Encoding ISOLatin1Encoding def\n\
|
||
currentdict\n\
|
||
end\n\
|
||
\n\
|
||
% I'm not sure why it's necessary to use \"definefont\" on this new\n\
|
||
% font, but it seems to be important; just use the name \"Temporary\"\n\
|
||
% for the font.\n\
|
||
\n\
|
||
/Temporary exch definefont\n\
|
||
} bind def\n\
|
||
\n\
|
||
% StrokeClip\n\
|
||
%\n\
|
||
% This procedure converts the current path into a clip area under\n\
|
||
% the assumption of stroking. It's a bit tricky because some Postscript\n\
|
||
% interpreters get errors during strokepath for dashed lines. If\n\
|
||
% this happens then turn off dashes and try again.\n\
|
||
\n\
|
||
/StrokeClip {\n\
|
||
{strokepath} stopped {\n\
|
||
(This Postscript printer gets limitcheck overflows when) =\n\
|
||
(stippling dashed lines; lines will be printed solid instead.) =\n\
|
||
[] 0 setdash strokepath} if\n\
|
||
clip\n\
|
||
} bind def\n\
|
||
\n\
|
||
% d",
|
||
/* End of part 2 */
|
||
|
||
/* Start of part 3 (2000 characters) */
|
||
"esiredSize EvenPixels closestSize\n\
|
||
%\n\
|
||
% The procedure below is used for stippling. Given the optimal size\n\
|
||
% of a dot in a stipple pattern in the current user coordinate system,\n\
|
||
% compute the closest size that is an exact multiple of the device's\n\
|
||
% pixel size. This allows stipple patterns to be displayed without\n\
|
||
% aliasing effects.\n\
|
||
\n\
|
||
/EvenPixels {\n\
|
||
% Compute exact number of device pixels per stipple dot.\n\
|
||
dup 0 matrix currentmatrix dtransform\n\
|
||
dup mul exch dup mul add sqrt\n\
|
||
\n\
|
||
% Round to an integer, make sure the number is at least 1, and compute\n\
|
||
% user coord distance corresponding to this.\n\
|
||
dup round dup 1 lt {pop 1} if\n\
|
||
exch div mul\n\
|
||
} bind def\n\
|
||
\n\
|
||
% width height string StippleFill --\n\
|
||
%\n\
|
||
% Given a path already set up and a clipping region generated from\n\
|
||
% it, this procedure will fill the clipping region with a stipple\n\
|
||
% pattern. \"String\" contains a proper image description of the\n\
|
||
% stipple pattern and \"width\" and \"height\" give its dimensions. Each\n\
|
||
% stipple dot is assumed to be about one unit across in the current\n\
|
||
% user coordinate system. This procedure trashes the graphics state.\n\
|
||
\n\
|
||
/StippleFill {\n\
|
||
% The following code is needed to work around a NeWSprint bug.\n\
|
||
\n\
|
||
/tmpstip 1 index def\n\
|
||
\n\
|
||
% Change the scaling so that one user unit in user coordinates\n\
|
||
% corresponds to the size of one stipple dot.\n\
|
||
1 EvenPixels dup scale\n\
|
||
\n\
|
||
% Compute the bounding box occupied by the path (which is now\n\
|
||
% the clipping region), and round the lower coordinates down\n\
|
||
% to the nearest starting point for the stipple pattern. Be\n\
|
||
% careful about negative numbers, since the rounding works\n\
|
||
% differently on them.\n\
|
||
\n\
|
||
pathbbox\n\
|
||
4 2 roll\n\
|
||
5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll\n\
|
||
6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll\n\
|
||
\n\
|
||
% Stack now: width height string y1 y2 x1 x2\n\
|
||
% Below is a doubly-nested for loop to iterate across this area\n\
|
||
% in units of the stipple pattern size, going up columns then\n\
|
||
% acr",
|
||
/* End of part 3 */
|
||
|
||
/* Start of part 4 (2000 characters) */
|
||
"oss rows, blasting out a stipple-pattern-sized rectangle at\n\
|
||
% each position\n\
|
||
\n\
|
||
6 index exch {\n\
|
||
2 index 5 index 3 index {\n\
|
||
% Stack now: width height string y1 y2 x y\n\
|
||
\n\
|
||
gsave\n\
|
||
1 index exch translate\n\
|
||
5 index 5 index true matrix tmpstip imagemask\n\
|
||
grestore\n\
|
||
} for\n\
|
||
pop\n\
|
||
} for\n\
|
||
pop pop pop pop pop\n\
|
||
} bind def\n\
|
||
\n\
|
||
% -- AdjustColor --\n\
|
||
% Given a color value already set for output by the caller, adjusts\n\
|
||
% that value to a grayscale or mono value if requested by the CL\n\
|
||
% variable.\n\
|
||
\n\
|
||
/AdjustColor {\n\
|
||
CL 2 lt {\n\
|
||
currentgray\n\
|
||
CL 0 eq {\n\
|
||
.5 lt {0} {1} ifelse\n\
|
||
} if\n\
|
||
setgray\n\
|
||
} if\n\
|
||
} bind def\n\
|
||
\n\
|
||
% x y strings spacing xoffset yoffset justify stipple DrawText --\n\
|
||
% This procedure does all of the real work of drawing text. The\n\
|
||
% color and font must already have been set by the caller, and the\n\
|
||
% following arguments must be on the stack:\n\
|
||
%\n\
|
||
% x, y - Coordinates at which to draw text.\n\
|
||
% strings - An array of strings, one for each line of the text item,\n\
|
||
% in order from top to bottom.\n\
|
||
% spacing - Spacing between lines.\n\
|
||
% xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\
|
||
% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\
|
||
% yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\
|
||
% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\
|
||
% justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\
|
||
% stipple - Boolean value indicating whether or not text is to be\n\
|
||
% drawn in stippled fashion. If text is stippled,\n\
|
||
% procedure StippleText must have been defined to call\n\
|
||
% StippleFill in the right way.\n\
|
||
%\n\
|
||
% Also, when this procedure is invoked, the color and font must already\n\
|
||
% have been set for the text.\n\
|
||
\n\
|
||
/DrawText {\n\
|
||
/stipple exch def\n\
|
||
/justify exch def\n\
|
||
/yoffset exch def\n\
|
||
/xoffset exch def\n\
|
||
/spacing exch def\n\
|
||
/strings exch def\n\
|
||
\n\
|
||
% First scan through all of the text to find the widest line.\n\
|
||
\n\
|
||
/lineLength 0 def\n\
|
||
strings {\n\
|
||
stringwidth pop\n\
|
||
dup lineLength gt {/lineLength exch def}",
|
||
/* End of part 4 */
|
||
|
||
/* Start of part 5 (1546 characters) */
|
||
" {pop} ifelse\n\
|
||
newpath\n\
|
||
} forall\n\
|
||
\n\
|
||
% Compute the baseline offset and the actual font height.\n\
|
||
\n\
|
||
0 0 moveto (TXygqPZ) false charpath\n\
|
||
pathbbox dup /baseline exch def\n\
|
||
exch pop exch sub /height exch def pop\n\
|
||
newpath\n\
|
||
\n\
|
||
% Translate coordinates first so that the origin is at the upper-left\n\
|
||
% corner of the text's bounding box. Remember that x and y for\n\
|
||
% positioning are still on the stack.\n\
|
||
\n\
|
||
translate\n\
|
||
lineLength xoffset mul\n\
|
||
strings length 1 sub spacing mul height add yoffset mul translate\n\
|
||
\n\
|
||
% Now use the baseline and justification information to translate so\n\
|
||
% that the origin is at the baseline and positioning point for the\n\
|
||
% first line of text.\n\
|
||
\n\
|
||
justify lineLength mul baseline neg translate\n\
|
||
\n\
|
||
% Iterate over each of the lines to output it. For each line,\n\
|
||
% compute its width again so it can be properly justified, then\n\
|
||
% display it.\n\
|
||
\n\
|
||
strings {\n\
|
||
dup stringwidth pop\n\
|
||
justify neg mul 0 moveto\n\
|
||
stipple {\n\
|
||
\n\
|
||
% The text is stippled, so turn it into a path and print\n\
|
||
% by calling StippledText, which in turn calls StippleFill.\n\
|
||
% Unfortunately, many Postscript interpreters will get\n\
|
||
% overflow errors if we try to do the whole string at\n\
|
||
% once, so do it a character at a time.\n\
|
||
\n\
|
||
gsave\n\
|
||
/char (X) def\n\
|
||
{\n\
|
||
char 0 3 -1 roll put\n\
|
||
currentpoint\n\
|
||
gsave\n\
|
||
char true charpath clip StippleText\n\
|
||
grestore\n\
|
||
char stringwidth translate\n\
|
||
moveto\n\
|
||
} forall\n\
|
||
grestore\n\
|
||
} {show} ifelse\n\
|
||
0 spacing neg translate\n\
|
||
} forall\n\
|
||
} bind def\n\
|
||
\n\
|
||
%%EndProlog\n\
|
||
",
|
||
/* End of part 5 */
|
||
|
||
NULL /* End of data marker */
|
||
};
|
||
|
||
/*
|
||
* Forward declarations for procedures defined later in this file:
|
||
*/
|
||
|
||
static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
|
||
char *string, double *doublePtr));
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* TkCanvPostscriptCmd --
|
||
*
|
||
* This procedure is invoked to process the "postscript" options
|
||
* of the widget command for canvas widgets. See the user
|
||
* documentation for details on what it does.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* See the user documentation.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
/* ARGSUSED */
|
||
int
|
||
TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
|
||
TkCanvas *canvasPtr; /* Information about canvas widget. */
|
||
Tcl_Interp *interp; /* Current interpreter. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. Caller has
|
||
* already parsed this command enough
|
||
* to know that argv[1] is
|
||
* "postscript". */
|
||
{
|
||
TkPostscriptInfo psInfo, *oldInfoPtr;
|
||
int result;
|
||
Tk_Item *itemPtr;
|
||
#ifdef BGLK_CODE
|
||
char string[400+1], *p;
|
||
#else
|
||
#define STRING_LENGTH 400
|
||
char string[STRING_LENGTH+1], *p;
|
||
#endif
|
||
time_t now;
|
||
size_t length;
|
||
int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of
|
||
* area to be marked up, measured
|
||
* in canvas units from the positioning
|
||
* point on the page (reflects
|
||
* anchor position). Initial values
|
||
* needed only to stop compiler
|
||
* warnings. */
|
||
Tcl_HashSearch search;
|
||
Tcl_HashEntry *hPtr;
|
||
Tcl_DString buffer;
|
||
CONST char * CONST *chunk;
|
||
|
||
/*
|
||
*----------------------------------------------------------------
|
||
* Initialize the data structure describing Postscript generation,
|
||
* then process all the arguments to fill the data structure in.
|
||
*----------------------------------------------------------------
|
||
*/
|
||
|
||
oldInfoPtr = canvasPtr->psInfoPtr;
|
||
canvasPtr->psInfoPtr = &psInfo;
|
||
psInfo.x = canvasPtr->xOrigin;
|
||
psInfo.y = canvasPtr->yOrigin;
|
||
psInfo.width = -1;
|
||
psInfo.height = -1;
|
||
psInfo.pageXString = NULL;
|
||
psInfo.pageYString = NULL;
|
||
psInfo.pageX = 72*4.25;
|
||
psInfo.pageY = 72*5.5;
|
||
psInfo.pageWidthString = NULL;
|
||
psInfo.pageHeightString = NULL;
|
||
psInfo.scale = 1.0;
|
||
psInfo.pageAnchor = TK_ANCHOR_CENTER;
|
||
psInfo.rotate = 0;
|
||
psInfo.fontVar = NULL;
|
||
psInfo.colorVar = NULL;
|
||
psInfo.colorMode = NULL;
|
||
psInfo.colorLevel = 0;
|
||
psInfo.fileName = NULL;
|
||
psInfo.channelName = NULL;
|
||
psInfo.chan = NULL;
|
||
psInfo.prepass = 0;
|
||
Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
|
||
result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin,
|
||
configSpecs, argc-2, argv+2, (char *) &psInfo,
|
||
TK_CONFIG_ARGV_ONLY);
|
||
if (result != TCL_OK) {
|
||
goto cleanup;
|
||
}
|
||
|
||
if (psInfo.width == -1) {
|
||
psInfo.width = Tk_Width(canvasPtr->tkwin);
|
||
}
|
||
if (psInfo.height == -1) {
|
||
psInfo.height = Tk_Height(canvasPtr->tkwin);
|
||
}
|
||
psInfo.x2 = psInfo.x + psInfo.width;
|
||
psInfo.y2 = psInfo.y + psInfo.height;
|
||
|
||
if (psInfo.pageXString != NULL) {
|
||
if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString,
|
||
&psInfo.pageX) != TCL_OK) {
|
||
goto cleanup;
|
||
}
|
||
}
|
||
if (psInfo.pageYString != NULL) {
|
||
if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString,
|
||
&psInfo.pageY) != TCL_OK) {
|
||
goto cleanup;
|
||
}
|
||
}
|
||
if (psInfo.pageWidthString != NULL) {
|
||
if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString,
|
||
&psInfo.scale) != TCL_OK) {
|
||
goto cleanup;
|
||
}
|
||
psInfo.scale /= psInfo.width;
|
||
} else if (psInfo.pageHeightString != NULL) {
|
||
if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString,
|
||
&psInfo.scale) != TCL_OK) {
|
||
goto cleanup;
|
||
}
|
||
psInfo.scale /= psInfo.height;
|
||
} else {
|
||
psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(canvasPtr->tkwin));
|
||
psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin));
|
||
}
|
||
switch (psInfo.pageAnchor) {
|
||
case TK_ANCHOR_NW:
|
||
case TK_ANCHOR_W:
|
||
case TK_ANCHOR_SW:
|
||
deltaX = 0;
|
||
break;
|
||
case TK_ANCHOR_N:
|
||
case TK_ANCHOR_CENTER:
|
||
case TK_ANCHOR_S:
|
||
deltaX = -psInfo.width/2;
|
||
break;
|
||
case TK_ANCHOR_NE:
|
||
case TK_ANCHOR_E:
|
||
case TK_ANCHOR_SE:
|
||
deltaX = -psInfo.width;
|
||
break;
|
||
}
|
||
switch (psInfo.pageAnchor) {
|
||
case TK_ANCHOR_NW:
|
||
case TK_ANCHOR_N:
|
||
case TK_ANCHOR_NE:
|
||
deltaY = - psInfo.height;
|
||
break;
|
||
case TK_ANCHOR_W:
|
||
case TK_ANCHOR_CENTER:
|
||
case TK_ANCHOR_E:
|
||
deltaY = -psInfo.height/2;
|
||
break;
|
||
case TK_ANCHOR_SW:
|
||
case TK_ANCHOR_S:
|
||
case TK_ANCHOR_SE:
|
||
deltaY = 0;
|
||
break;
|
||
}
|
||
|
||
if (psInfo.colorMode == NULL) {
|
||
psInfo.colorLevel = 2;
|
||
} else {
|
||
length = strlen(psInfo.colorMode);
|
||
if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
|
||
psInfo.colorLevel = 0;
|
||
} else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
|
||
psInfo.colorLevel = 1;
|
||
} else if (strncmp(psInfo.colorMode, "color", length) == 0) {
|
||
psInfo.colorLevel = 2;
|
||
} else {
|
||
Tcl_AppendResult(canvasPtr->interp, "bad color mode \"",
|
||
psInfo.colorMode, "\": must be monochrome, ",
|
||
"gray, or color", (char *) NULL);
|
||
goto cleanup;
|
||
}
|
||
}
|
||
|
||
if (psInfo.fileName != NULL) {
|
||
|
||
/*
|
||
* Check that -file and -channel are not both specified.
|
||
*/
|
||
|
||
if (psInfo.channelName != NULL) {
|
||
Tcl_AppendResult(canvasPtr->interp, "can't specify both -file",
|
||
" and -channel", (char *) NULL);
|
||
result = TCL_ERROR;
|
||
goto cleanup;
|
||
}
|
||
|
||
/*
|
||
* Check that we are not in a safe interpreter. If we are, disallow
|
||
* the -file specification.
|
||
*/
|
||
|
||
if (Tcl_IsSafe(canvasPtr->interp)) {
|
||
Tcl_AppendResult(canvasPtr->interp, "can't specify -file in a",
|
||
" safe interpreter", (char *) NULL);
|
||
result = TCL_ERROR;
|
||
goto cleanup;
|
||
}
|
||
|
||
p = Tcl_TranslateFileName(canvasPtr->interp, psInfo.fileName, &buffer);
|
||
if (p == NULL) {
|
||
goto cleanup;
|
||
}
|
||
psInfo.chan = Tcl_OpenFileChannel(canvasPtr->interp, p, "w", 0666);
|
||
Tcl_DStringFree(&buffer);
|
||
if (psInfo.chan == NULL) {
|
||
goto cleanup;
|
||
}
|
||
}
|
||
|
||
if (psInfo.channelName != NULL) {
|
||
int mode;
|
||
|
||
#ifdef SCM_CODE
|
||
mode = 0;
|
||
#endif
|
||
/*
|
||
* Check that the channel is found in this interpreter and that it
|
||
* is open for writing.
|
||
*/
|
||
#ifdef NYI
|
||
psInfo.chan = Tcl_GetChannel(canvasPtr->interp, psInfo.channelName,
|
||
&mode);
|
||
#endif
|
||
if (psInfo.chan == (Tcl_Channel) NULL) {
|
||
result = TCL_ERROR;
|
||
goto cleanup;
|
||
}
|
||
if ((mode & TCL_WRITABLE) == 0) {
|
||
Tcl_AppendResult(canvasPtr->interp, "channel \"",
|
||
psInfo.channelName, "\" wasn't opened for writing",
|
||
(char *) NULL);
|
||
result = TCL_ERROR;
|
||
goto cleanup;
|
||
}
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------
|
||
* Make a pre-pass over all of the items, generating Postscript
|
||
* and then throwing it away. The purpose of this pass is just
|
||
* to collect information about all the fonts in use, so that
|
||
* we can output font information in the proper form required
|
||
* by the Document Structuring Conventions.
|
||
*--------------------------------------------------------
|
||
*/
|
||
|
||
psInfo.prepass = 1;
|
||
for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
|
||
itemPtr = itemPtr->nextPtr) {
|
||
if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
|
||
|| (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
|
||
continue;
|
||
}
|
||
if (itemPtr->typePtr->postscriptProc == NULL) {
|
||
continue;
|
||
}
|
||
result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
|
||
(Tk_Canvas) canvasPtr, itemPtr, 1);
|
||
Tcl_ResetResult(canvasPtr->interp);
|
||
if (result != TCL_OK) {
|
||
/*
|
||
* An error just occurred. Just skip out of this loop.
|
||
* There's no need to report the error now; it can be
|
||
* reported later (errors can happen later that don't
|
||
* happen now, so we still have to check for errors later
|
||
* anyway).
|
||
*/
|
||
break;
|
||
}
|
||
}
|
||
psInfo.prepass = 0;
|
||
|
||
/*
|
||
*--------------------------------------------------------
|
||
* Generate the header and prolog for the Postscript.
|
||
*--------------------------------------------------------
|
||
*/
|
||
|
||
Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
|
||
"%%Creator: Tk Canvas Widget\n", (char *) NULL);
|
||
#if !(defined(__WIN32__) || defined(MAC_TCL))
|
||
if (!Tcl_IsSafe(interp)) {
|
||
struct passwd *pwPtr = getpwuid(getuid());
|
||
Tcl_AppendResult(canvasPtr->interp, "%%For: ",
|
||
(pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
|
||
(char *) NULL);
|
||
endpwent();
|
||
}
|
||
#endif /* __WIN32__ || MAC_TCL */
|
||
Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ",
|
||
Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL);
|
||
time(&now);
|
||
Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ",
|
||
ctime(&now), (char *) NULL);
|
||
if (!psInfo.rotate) {
|
||
sprintf(string, "%d %d %d %d",
|
||
(int) (psInfo.pageX + psInfo.scale*deltaX),
|
||
(int) (psInfo.pageY + psInfo.scale*deltaY),
|
||
(int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
|
||
+ 1.0),
|
||
(int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
|
||
+ 1.0));
|
||
} else {
|
||
sprintf(string, "%d %d %d %d",
|
||
(int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
|
||
(int) (psInfo.pageY + psInfo.scale*deltaX),
|
||
(int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
|
||
(int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
|
||
+ 1.0));
|
||
}
|
||
Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string,
|
||
"\n", (char *) NULL);
|
||
Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n",
|
||
"%%DocumentData: Clean7Bit\n", (char *) NULL);
|
||
Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ",
|
||
psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
|
||
p = "%%DocumentNeededResources: font ";
|
||
for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
|
||
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
|
||
Tcl_AppendResult(canvasPtr->interp, p,
|
||
Tcl_GetHashKey(&psInfo.fontTable, hPtr),
|
||
"\n", (char *) NULL);
|
||
p = "%%+ font ";
|
||
}
|
||
Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL);
|
||
|
||
/*
|
||
* Insert the prolog
|
||
*/
|
||
for (chunk=prolog; *chunk; chunk++) {
|
||
Tcl_AppendResult(interp, *chunk, (char *) NULL);
|
||
}
|
||
|
||
if (psInfo.chan != NULL) {
|
||
Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
|
||
Tcl_ResetResult(canvasPtr->interp);
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------
|
||
* Document setup: set the color level and include fonts.
|
||
*-----------------------------------------------------------
|
||
*/
|
||
|
||
sprintf(string, "/CL %d def\n", psInfo.colorLevel);
|
||
Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string,
|
||
(char *) NULL);
|
||
for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
|
||
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
|
||
Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ",
|
||
Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
|
||
}
|
||
Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL);
|
||
|
||
/*
|
||
*-----------------------------------------------------------
|
||
* Page setup: move to page positioning point, rotate if
|
||
* needed, set scale factor, offset for proper anchor position,
|
||
* and set clip region.
|
||
*-----------------------------------------------------------
|
||
*/
|
||
|
||
Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n",
|
||
(char *) NULL);
|
||
sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
|
||
Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
|
||
if (psInfo.rotate) {
|
||
Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL);
|
||
}
|
||
sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
|
||
Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
|
||
sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
|
||
Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
|
||
sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
|
||
psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
|
||
psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
|
||
psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2),
|
||
psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2));
|
||
Tcl_AppendResult(canvasPtr->interp, string,
|
||
" lineto closepath clip newpath\n", (char *) NULL);
|
||
if (psInfo.chan != NULL) {
|
||
Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
|
||
Tcl_ResetResult(canvasPtr->interp);
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------
|
||
* Iterate through all the items, having each relevant one draw itself.
|
||
* Quit if any of the items returns an error.
|
||
*---------------------------------------------------------------------
|
||
*/
|
||
|
||
result = TCL_OK;
|
||
for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
|
||
itemPtr = itemPtr->nextPtr) {
|
||
if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
|
||
|| (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
|
||
continue;
|
||
}
|
||
if (itemPtr->typePtr->postscriptProc == NULL) {
|
||
continue;
|
||
}
|
||
Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL);
|
||
result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
|
||
(Tk_Canvas) canvasPtr, itemPtr, 0);
|
||
if (result != TCL_OK) {
|
||
char msg[100];
|
||
|
||
sprintf(msg, "\n (generating Postscript for item %d)",
|
||
itemPtr->id);
|
||
Tcl_AddErrorInfo(canvasPtr->interp, msg);
|
||
goto cleanup;
|
||
}
|
||
Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL);
|
||
if (psInfo.chan != NULL) {
|
||
Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
|
||
Tcl_ResetResult(canvasPtr->interp);
|
||
}
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------
|
||
* Output page-end information, such as commands to print the page
|
||
* and document trailer stuff.
|
||
*---------------------------------------------------------------------
|
||
*/
|
||
|
||
Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n",
|
||
"%%Trailer\nend\n%%EOF\n", (char *) NULL);
|
||
if (psInfo.chan != NULL) {
|
||
Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
|
||
Tcl_ResetResult(canvasPtr->interp);
|
||
}
|
||
|
||
/*
|
||
* Clean up psInfo to release malloc'ed stuff.
|
||
*/
|
||
|
||
cleanup:
|
||
if (psInfo.pageXString != NULL) {
|
||
ckfree(psInfo.pageXString);
|
||
}
|
||
if (psInfo.pageYString != NULL) {
|
||
ckfree(psInfo.pageYString);
|
||
}
|
||
if (psInfo.pageWidthString != NULL) {
|
||
ckfree(psInfo.pageWidthString);
|
||
}
|
||
if (psInfo.pageHeightString != NULL) {
|
||
ckfree(psInfo.pageHeightString);
|
||
}
|
||
if (psInfo.fontVar != NULL) {
|
||
ckfree(psInfo.fontVar);
|
||
}
|
||
if (psInfo.colorVar != NULL) {
|
||
ckfree(psInfo.colorVar);
|
||
}
|
||
if (psInfo.colorMode != NULL) {
|
||
ckfree(psInfo.colorMode);
|
||
}
|
||
if (psInfo.fileName != NULL) {
|
||
ckfree(psInfo.fileName);
|
||
}
|
||
if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
|
||
Tcl_Close(canvasPtr->interp, psInfo.chan);
|
||
}
|
||
if (psInfo.channelName != NULL) {
|
||
ckfree(psInfo.channelName);
|
||
}
|
||
Tcl_DeleteHashTable(&psInfo.fontTable);
|
||
canvasPtr->psInfoPtr = oldInfoPtr;
|
||
return result;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_CanvasPsColor --
|
||
*
|
||
* This procedure is called by individual canvas items when
|
||
* they want to set a color value for output. Given information
|
||
* about an X color, this procedure will generate Postscript
|
||
* commands to set up an appropriate color in Postscript.
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl return value. If an error occurs
|
||
* then an error message will be left in interp->result.
|
||
* If no error occurs, then additional Postscript will be
|
||
* appended to interp->result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_CanvasPsColor(interp, canvas, colorPtr)
|
||
Tcl_Interp *interp; /* Interpreter for returning Postscript
|
||
* or error message. */
|
||
Tk_Canvas canvas; /* Information about canvas. */
|
||
XColor *colorPtr; /* Information about color. */
|
||
{
|
||
TkCanvas *canvasPtr = (TkCanvas *) canvas;
|
||
TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
|
||
int tmp;
|
||
double red, green, blue;
|
||
char string[200];
|
||
|
||
if (psInfoPtr->prepass) {
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
* If there is a color map defined, then look up the color's name
|
||
* in the map and use the Postscript commands found there, if there
|
||
* are any.
|
||
*/
|
||
|
||
if (psInfoPtr->colorVar != NULL) {
|
||
char *cmdString;
|
||
|
||
cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
|
||
Tk_NameOfColor(colorPtr), 0);
|
||
if (cmdString != NULL) {
|
||
Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
|
||
return TCL_OK;
|
||
}
|
||
}
|
||
|
||
/*
|
||
* No color map entry for this color. Grab the color's intensities
|
||
* and output Postscript commands for them. Special note: X uses
|
||
* a range of 0-65535 for intensities, but most displays only use
|
||
* a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
|
||
* X scale. This means that there's no way to get perfect white,
|
||
* since the highest intensity is only 65280 out of 65535. To
|
||
* work around this problem, rescale the X intensity to a 0-255
|
||
* scale and use that as the basis for the Postscript colors. This
|
||
* scheme still won't work if the display only uses 4 bits per color,
|
||
* but most diplays use at least 8 bits.
|
||
*/
|
||
|
||
tmp = colorPtr->red;
|
||
red = ((double) (tmp >> 8))/255.0;
|
||
tmp = colorPtr->green;
|
||
green = ((double) (tmp >> 8))/255.0;
|
||
tmp = colorPtr->blue;
|
||
blue = ((double) (tmp >> 8))/255.0;
|
||
sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
|
||
red, green, blue);
|
||
Tcl_AppendResult(interp, string, (char *) NULL);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_CanvasPsFont --
|
||
*
|
||
* This procedure is called by individual canvas items when
|
||
* they want to output text. Given information about an X
|
||
* font, this procedure will generate Postscript commands
|
||
* to set up an appropriate font in Postscript.
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl return value. If an error occurs
|
||
* then an error message will be left in interp->result.
|
||
* If no error occurs, then additional Postscript will be
|
||
* appended to the interp->result.
|
||
*
|
||
* Side effects:
|
||
* The Postscript font name is entered into psInfoPtr->fontTable
|
||
* if it wasn't already there.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_CanvasPsFont(interp, canvas, tkfont)
|
||
Tcl_Interp *interp; /* Interpreter for returning Postscript
|
||
* or error message. */
|
||
Tk_Canvas canvas; /* Information about canvas. */
|
||
Tk_Font tkfont; /* Information about font in which text
|
||
* is to be printed. */
|
||
{
|
||
TkCanvas *canvasPtr = (TkCanvas *) canvas;
|
||
TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
|
||
char *end;
|
||
char pointString[20];
|
||
Tcl_DString ds;
|
||
int i, points;
|
||
|
||
/*
|
||
* First, look up the font's name in the font map, if there is one.
|
||
* If there is an entry for this font, it consists of a list
|
||
* containing font name and size. Use this information.
|
||
*/
|
||
|
||
Tcl_DStringInit(&ds);
|
||
|
||
if (psInfoPtr->fontVar != NULL) {
|
||
char *list, **argv;
|
||
int argc;
|
||
double size;
|
||
char *name;
|
||
|
||
name = Tk_NameOfFont(tkfont);
|
||
list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
|
||
if (list != NULL) {
|
||
if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
|
||
badMapEntry:
|
||
Tcl_ResetResult(interp);
|
||
Tcl_AppendResult(interp, "bad font map entry for \"", name,
|
||
"\": \"", list, "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (argc != 2) {
|
||
goto badMapEntry;
|
||
}
|
||
size = strtod(argv[1], &end);
|
||
if ((size <= 0) || (*end != 0)) {
|
||
goto badMapEntry;
|
||
}
|
||
|
||
Tcl_DStringAppend(&ds, argv[0], -1);
|
||
points = (int) size;
|
||
|
||
ckfree((char *) argv);
|
||
goto findfont;
|
||
}
|
||
}
|
||
|
||
points = Tk_PostscriptFontName(tkfont, &ds);
|
||
|
||
findfont:
|
||
sprintf(pointString, "%d", points);
|
||
Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ",
|
||
pointString, " scalefont ", (char *) NULL);
|
||
if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) {
|
||
Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
|
||
}
|
||
Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
|
||
Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
|
||
Tcl_DStringFree(&ds);
|
||
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_CanvasPsBitmap --
|
||
*
|
||
* This procedure is called to output the contents of a
|
||
* sub-region of a bitmap in proper image data format for
|
||
* Postscript (i.e. data between angle brackets, one bit
|
||
* per pixel).
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl return value. If an error occurs
|
||
* then an error message will be left in interp->result.
|
||
* If no error occurs, then additional Postscript will be
|
||
* appended to interp->result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
|
||
Tcl_Interp *interp; /* Interpreter for returning Postscript
|
||
* or error message. */
|
||
Tk_Canvas canvas; /* Information about canvas. */
|
||
Pixmap bitmap; /* Bitmap for which to generate
|
||
* Postscript. */
|
||
int startX, startY; /* Coordinates of upper-left corner
|
||
* of rectangular region to output. */
|
||
int width, height; /* Height of rectangular region. */
|
||
{
|
||
TkCanvas *canvasPtr = (TkCanvas *) canvas;
|
||
TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
|
||
XImage *imagePtr;
|
||
int charsInLine, x, y, lastX, lastY, value, mask;
|
||
unsigned int totalWidth, totalHeight;
|
||
char string[100];
|
||
Window dummyRoot;
|
||
int dummyX, dummyY;
|
||
unsigned dummyBorderwidth, dummyDepth;
|
||
|
||
if (psInfoPtr->prepass) {
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
* The following call should probably be a call to Tk_SizeOfBitmap
|
||
* instead, but it seems that we are occasionally invoked by custom
|
||
* item types that create their own bitmaps without registering them
|
||
* with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
|
||
* it shouldn't matter here.
|
||
*/
|
||
|
||
XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
|
||
(int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
|
||
(unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
|
||
imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
|
||
totalWidth, totalHeight, 1, XYPixmap);
|
||
Tcl_AppendResult(interp, "<", (char *) NULL);
|
||
mask = 0x80;
|
||
value = 0;
|
||
charsInLine = 0;
|
||
lastX = startX + width - 1;
|
||
lastY = startY + height - 1;
|
||
for (y = lastY; y >= startY; y--) {
|
||
for (x = startX; x <= lastX; x++) {
|
||
if (XGetPixel(imagePtr, x, y)) {
|
||
value |= mask;
|
||
}
|
||
mask >>= 1;
|
||
if (mask == 0) {
|
||
sprintf(string, "%02x", value);
|
||
Tcl_AppendResult(interp, string, (char *) NULL);
|
||
mask = 0x80;
|
||
value = 0;
|
||
charsInLine += 2;
|
||
if (charsInLine >= 60) {
|
||
Tcl_AppendResult(interp, "\n", (char *) NULL);
|
||
charsInLine = 0;
|
||
}
|
||
}
|
||
}
|
||
if (mask != 0x80) {
|
||
sprintf(string, "%02x", value);
|
||
Tcl_AppendResult(interp, string, (char *) NULL);
|
||
mask = 0x80;
|
||
value = 0;
|
||
charsInLine += 2;
|
||
}
|
||
}
|
||
Tcl_AppendResult(interp, ">", (char *) NULL);
|
||
XDestroyImage(imagePtr);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_CanvasPsStipple --
|
||
*
|
||
* This procedure is called by individual canvas items when
|
||
* they have created a path that they'd like to be filled with
|
||
* a stipple pattern. Given information about an X bitmap,
|
||
* this procedure will generate Postscript commands to fill
|
||
* the current clip region using a stipple pattern defined by the
|
||
* bitmap.
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl return value. If an error occurs
|
||
* then an error message will be left in interp->result.
|
||
* If no error occurs, then additional Postscript will be
|
||
* appended to interp->result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_CanvasPsStipple(interp, canvas, bitmap)
|
||
Tcl_Interp *interp; /* Interpreter for returning Postscript
|
||
* or error message. */
|
||
Tk_Canvas canvas; /* Information about canvas. */
|
||
Pixmap bitmap; /* Bitmap to use for stippling. */
|
||
{
|
||
TkCanvas *canvasPtr = (TkCanvas *) canvas;
|
||
TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
|
||
int width, height;
|
||
char string[100];
|
||
Window dummyRoot;
|
||
int dummyX, dummyY;
|
||
unsigned dummyBorderwidth, dummyDepth;
|
||
|
||
if (psInfoPtr->prepass) {
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
* The following call should probably be a call to Tk_SizeOfBitmap
|
||
* instead, but it seems that we are occasionally invoked by custom
|
||
* item types that create their own bitmaps without registering them
|
||
* with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
|
||
* it shouldn't matter here.
|
||
*/
|
||
|
||
XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
|
||
(int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
|
||
(unsigned *) &height, &dummyBorderwidth, &dummyDepth);
|
||
sprintf(string, "%d %d ", width, height);
|
||
Tcl_AppendResult(interp, string, (char *) NULL);
|
||
if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0,
|
||
width, height) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_CanvasPsY --
|
||
*
|
||
* Given a y-coordinate in canvas coordinates, this procedure
|
||
* returns a y-coordinate to use for Postscript output.
|
||
*
|
||
* Results:
|
||
* Returns the Postscript coordinate that corresponds to
|
||
* "y".
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
double
|
||
Tk_CanvasPsY(canvas, y)
|
||
Tk_Canvas canvas; /* Token for canvas on whose behalf
|
||
* Postscript is being generated. */
|
||
double y; /* Y-coordinate in canvas coords. */
|
||
{
|
||
TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
|
||
|
||
return psInfoPtr->y2 - y;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_CanvasPsPath --
|
||
*
|
||
* Given an array of points for a path, generate Postscript
|
||
* commands to create the path.
|
||
*
|
||
* Results:
|
||
* Postscript commands get appended to what's in interp->result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
void
|
||
Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
|
||
Tcl_Interp *interp; /* Put generated Postscript in this
|
||
* interpreter's result field. */
|
||
Tk_Canvas canvas; /* Canvas on whose behalf Postscript
|
||
* is being generated. */
|
||
double *coordPtr; /* Pointer to first in array of
|
||
* 2*numPoints coordinates giving
|
||
* points for path. */
|
||
int numPoints; /* Number of points at *coordPtr. */
|
||
{
|
||
TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
|
||
char buffer[200];
|
||
|
||
if (psInfoPtr->prepass) {
|
||
return;
|
||
}
|
||
sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
|
||
Tk_CanvasPsY(canvas, coordPtr[1]));
|
||
Tcl_AppendResult(interp, buffer, (char *) NULL);
|
||
for (numPoints--, coordPtr += 2; numPoints > 0;
|
||
numPoints--, coordPtr += 2) {
|
||
sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
|
||
Tk_CanvasPsY(canvas, coordPtr[1]));
|
||
Tcl_AppendResult(interp, buffer, (char *) NULL);
|
||
}
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* GetPostscriptPoints --
|
||
*
|
||
* Given a string, returns the number of Postscript points
|
||
* corresponding to that string.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl return result. If
|
||
* TCL_OK is returned, then everything went well and the
|
||
* screen distance is stored at *doublePtr; otherwise
|
||
* TCL_ERROR is returned and an error message is left in
|
||
* interp->result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
GetPostscriptPoints(interp, string, doublePtr)
|
||
Tcl_Interp *interp; /* Use this for error reporting. */
|
||
char *string; /* String describing a screen distance. */
|
||
double *doublePtr; /* Place to store converted result. */
|
||
{
|
||
char *end;
|
||
double d;
|
||
|
||
d = strtod(string, &end);
|
||
if (end == string) {
|
||
error:
|
||
Tcl_AppendResult(interp, "bad distance \"", string,
|
||
"\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
||
end++;
|
||
}
|
||
switch (*end) {
|
||
case 'c':
|
||
d *= 72.0/2.54;
|
||
end++;
|
||
break;
|
||
case 'i':
|
||
d *= 72.0;
|
||
end++;
|
||
break;
|
||
case 'm':
|
||
d *= 72.0/25.4;
|
||
end++;
|
||
break;
|
||
case 0:
|
||
break;
|
||
case 'p':
|
||
end++;
|
||
break;
|
||
default:
|
||
goto error;
|
||
}
|
||
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
||
end++;
|
||
}
|
||
if (*end != 0) {
|
||
goto error;
|
||
}
|
||
*doublePtr = d;
|
||
return TCL_OK;
|
||
}
|