geos_one/archie
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
5839cd4bca
archie/tk3.6/tkCanvPs.c

1189 lines
38 KiB
C
Raw Normal View History

Intial commit
2024-05-27 16:13:40 +02:00
/*
* 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-1993 The Regents of the University of California.
* All rights reserved.
*
* Permission is hereby granted, without written agreement and without
* license or royalty fees, to use, copy, modify, and distribute this
* software and its documentation for any purpose, provided that the
* above copyright notice and the following two paragraphs appear in
* all copies of this software.
*
* IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
* DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
* OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
* CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
* THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
* AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
* ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
* PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
*/
#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkCanvPs.c,v 1.18 93/08/18 16:26:03 ouster Exp $ SPRITE (Berkeley)";
#endif
#include <stdio.h>
#include "tkInt.h"
#include "tkCanvas.h"
#include "tkConfig.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 PostscriptInfo {
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. */
FILE *f; /* Open file 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. */
} PostscriptInfo;
/*
* The table below provides a template that's used to process arguments
* to the canvas "postscript" command and fill in PostscriptInfo
* structures.
*/
static Tk_ConfigSpec configSpecs[] = {
{TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, colorVar), 0},
{TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, colorMode), 0},
{TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, fileName), 0},
{TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, fontVar), 0},
{TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, height), 0},
{TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, pageAnchor), 0},
{TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, pageHeightString), 0},
{TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, pageWidthString), 0},
{TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, pageXString), 0},
{TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, pageYString), 0},
{TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, rotate), 0},
{TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, width), 0},
{TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, x), 0},
{TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
"", Tk_Offset(PostscriptInfo, y), 0},
{TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
(char *) NULL, 0, 0}
};
/*
* Forward declarations for procedures defined later in this file:
*/
static int CaseCmp _ANSI_ARGS_((char *s1, char *s2, int length));
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)
register Tk_Canvas *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". */
{
PostscriptInfo psInfo;
int result = TCL_ERROR;
register Tk_Item *itemPtr;
#define STRING_LENGTH 400
char string[STRING_LENGTH+1], *p;
time_t now;
struct passwd *pwPtr;
FILE *f;
int 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;
char *libDir;
/*
*----------------------------------------------------------------
* Initialize the data structure describing Postscript generation,
* then process all the arguments to fill the data structure in.
*----------------------------------------------------------------
*/
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.f = 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) {
p = Tcl_TildeSubst(canvasPtr->interp, psInfo.fileName, &buffer);
if (p == NULL) {
goto cleanup;
}
psInfo.f = fopen(p, "w");
Tcl_DStringFree(&buffer);
if (psInfo.f == NULL) {
Tcl_AppendResult(canvasPtr->interp, "couldn't write file \"",
psInfo.fileName, "\": ",
Tcl_PosixError(canvasPtr->interp), (char *) NULL);
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, itemPtr,
(Tk_PostscriptInfo *) &psInfo);
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);
pwPtr = getpwuid(getuid());
Tcl_AppendResult(canvasPtr->interp, "%%For: ",
(pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
(char *) NULL);
endpwent();
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);
/*
* Read a standard prolog file from disk and insert it into
* the Postscript.
*/
libDir = Tcl_GetVar(canvasPtr->interp, "tk_library", TCL_GLOBAL_ONLY);
if (libDir == NULL) {
Tcl_ResetResult(canvasPtr->interp);
Tcl_AppendResult(canvasPtr->interp, "couldn't find library directory: ",
"tk_library variable doesn't exist", (char *) NULL);
goto cleanup;
}
sprintf(string, "%.350s/prolog.ps", libDir);
f = fopen(string, "r");
if (f == NULL) {
Tcl_ResetResult(canvasPtr->interp);
Tcl_AppendResult(canvasPtr->interp, "couldn't open prolog file \"",
string, "\": ", Tcl_PosixError(canvasPtr->interp),
(char *) NULL);
goto cleanup;
}
while (fgets(string, STRING_LENGTH, f) != NULL) {
Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
}
if (ferror(f)) {
fclose(f);
Tcl_ResetResult(canvasPtr->interp);
Tcl_AppendResult(canvasPtr->interp, "error reading prolog file \"",
string, "\": ",
Tcl_PosixError(canvasPtr->interp), (char *) NULL);
goto cleanup;
}
fclose(f);
if (psInfo.f != NULL) {
fputs(canvasPtr->interp->result, psInfo.f);
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,
TkCanvPsY((Tk_PostscriptInfo *) &psInfo, (double) psInfo.y),
psInfo.x2,
TkCanvPsY((Tk_PostscriptInfo *) &psInfo, (double) psInfo.y),
psInfo.x2,
TkCanvPsY((Tk_PostscriptInfo *) &psInfo, (double) psInfo.y2),
psInfo.x,
TkCanvPsY((Tk_PostscriptInfo *) &psInfo, (double) psInfo.y2));
Tcl_AppendResult(canvasPtr->interp, string,
" lineto closepath clip newpath\n", (char *) NULL);
if (psInfo.f != NULL) {
fputs(canvasPtr->interp->result, psInfo.f);
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, itemPtr,
(Tk_PostscriptInfo *) &psInfo);
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.f != NULL) {
fputs(canvasPtr->interp->result, psInfo.f);
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.f != NULL) {
fputs(canvasPtr->interp->result, psInfo.f);
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.f != NULL) {
fclose(psInfo.f);
}
Tcl_DeleteHashTable(&psInfo.fontTable);
return result;
}
/*
*--------------------------------------------------------------
*
* TkCanvPsColor --
*
* 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 canvasPtr->interp->result.
* If no error occurs, then additional Postscript will be
* appended to canvasPtr->interp->result.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
int
TkCanvPsColor(canvasPtr, handle, colorPtr)
Tk_Canvas *canvasPtr; /* Information about canvas. */
Tk_PostscriptInfo *handle; /* Information about Postscript being
* generated. */
XColor *colorPtr; /* Information about color. */
{
PostscriptInfo *psInfoPtr = (PostscriptInfo *) handle;
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(canvasPtr->interp, psInfoPtr->colorVar,
Tk_NameOfColor(colorPtr), 0);
if (cmdString != NULL) {
Tcl_AppendResult(canvasPtr->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.
*/
red = colorPtr->red/65535.0;
green = colorPtr->green/65535.0;
blue = colorPtr->blue/65535.0;
sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
red, green, blue);
Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* TkCanvPsFont --
*
* 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 canvasPtr->interp->result.
* If no error occurs, then additional Postscript will be
* appended to the canvasPtr->interp->result.
*
* Side effects:
* The Postscript font name is entered into psInfoPtr->fontTable
* if it wasn't already there.
*
*--------------------------------------------------------------
*/
int
TkCanvPsFont(canvasPtr, handle, fontStructPtr)
register Tk_Canvas *canvasPtr; /* Information about canvas. */
Tk_PostscriptInfo *handle; /* Information about Postscript being
* generated. */
XFontStruct *fontStructPtr; /* Information about font in which text
* is to be printed. */
{
PostscriptInfo *psInfoPtr = (PostscriptInfo *) handle;
char *name, *end, *weightString, *slantString;
#define TOTAL_FIELDS 8
#define FAMILY_FIELD 1
#define WEIGHT_FIELD 2
#define SLANT_FIELD 3
#define SIZE_FIELD 7
char *fieldPtrs[TOTAL_FIELDS];
#define MAX_NAME_SIZE 100
char fontName[MAX_NAME_SIZE+50], pointString[20];
int i, c, weightSize, nameSize, points;
register char *p;
name = Tk_NameOfFontStruct(fontStructPtr);
/*
* 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.
*/
if (psInfoPtr->fontVar != NULL) {
char *list, **argv;
int argc;
double size;
list = Tcl_GetVar2(canvasPtr->interp, psInfoPtr->fontVar,
name, 0);
if (list != NULL) {
if (Tcl_SplitList(canvasPtr->interp, list, &argc, &argv)
!= TCL_OK) {
badMapEntry:
Tcl_ResetResult(canvasPtr->interp);
Tcl_AppendResult(canvasPtr->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;
}
sprintf(pointString, "%.15g", size);
Tcl_AppendResult(canvasPtr->interp, "/", argv[0], " findfont ",
pointString, " scalefont setfont\n", (char *) NULL);
Tcl_CreateHashEntry(&psInfoPtr->fontTable, argv[0], &i);
ckfree((char *) argv);
return TCL_OK;
}
}
/*
* Not in the font map. Try to parse the name to get four fields:
* family name, weight, slant, and point size. To do this, split the
* font name up into fields, storing pointers to the first character
* of each field in fieldPtrs.
*/
if (name[0] != '-') {
goto error;
}
for (p = name+1, i = 0; i < TOTAL_FIELDS; i++) {
fieldPtrs[i] = p;
while (*p != '-') {
if (*p == 0) {
goto error;
}
p++;
}
p++;
}
/*
* Use the information from the X font name to make a guess at a
* Postscript font name of the form "<family>-<weight><slant>" where
* <weight> and <slant> may be omitted and if both are omitted then
* the dash is also omitted. Postscript is very picky about font names,
* so there are several heuristics in the code below (e.g. don't
* include a "Roman" slant except for "Times" font, and make sure
* that the first letter of each field is capitalized but no other
* letters are in caps).
*/
nameSize = fieldPtrs[FAMILY_FIELD+1] - 1 - fieldPtrs[FAMILY_FIELD];
if ((nameSize == 0) || (nameSize > MAX_NAME_SIZE)) {
goto error;
}
strncpy(fontName, fieldPtrs[FAMILY_FIELD], nameSize);
if (islower(UCHAR(fontName[0]))) {
fontName[0] = toupper(fontName[0]);
}
for (p = fontName+1, i = nameSize-1; i > 0; p++, i--) {
if (isupper(UCHAR(*p))) {
*p = tolower(*p);
}
}
*p = 0;
weightSize = fieldPtrs[WEIGHT_FIELD+1] - 1 - fieldPtrs[WEIGHT_FIELD];
if (weightSize == 0) {
goto error;
}
if (CaseCmp(fieldPtrs[WEIGHT_FIELD], "medium", weightSize) == 0) {
weightString = "";
} else if (CaseCmp(fieldPtrs[WEIGHT_FIELD], "bold", weightSize) == 0) {
weightString = "Bold";
} else {
goto error;
}
if (fieldPtrs[SLANT_FIELD+1] != (fieldPtrs[SLANT_FIELD] + 2)) {
goto error;
}
c = fieldPtrs[SLANT_FIELD][0];
if ((c == 'r') || (c == 'R')) {
slantString = "";
if ((weightString[0] == 0) && (nameSize == 5)
&& (strncmp(fontName, "Times", 5) == 0)) {
slantString = "Roman";
}
} else if ((c == 'i') || (c == 'I')) {
slantString = "Italic";
} else if ((c == 'o') || (c == 'O')) {
slantString = "Oblique";
} else {
goto error;
}
if ((weightString[0] != 0) || (slantString[0] != 0)) {
sprintf(p, "-%s%s", weightString, slantString);
}
points = strtoul(fieldPtrs[SIZE_FIELD], &end, 0);
if (points == 0) {
goto error;
}
sprintf(pointString, "%.15g", ((double) points)/10.0);
Tcl_AppendResult(canvasPtr->interp, "/", fontName, " findfont ",
pointString, " scalefont setfont\n", (char *) NULL);
Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontName, &i);
return TCL_OK;
error:
Tcl_ResetResult(canvasPtr->interp);
Tcl_AppendResult(canvasPtr->interp, "couldn't translate font name \"",
name, "\" to Postscript", (char *) NULL);
return TCL_ERROR;
}
/*
*--------------------------------------------------------------
*
* TkCanvPsBitmap --
*
* This procedure is called to output the contents 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 canvasPtr->interp->result.
* If no error occurs, then additional Postscript will be
* appended to canvasPtr->interp->result.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
int
TkCanvPsBitmap(canvasPtr, handle, bitmap)
Tk_Canvas *canvasPtr; /* Information about canvas. */
Tk_PostscriptInfo *handle; /* Information about Postscript being
* generated. */
Pixmap bitmap; /* Bitmap to use for stippling. */
{
PostscriptInfo *psInfoPtr = (PostscriptInfo *) handle;
unsigned int width, height;
XImage *imagePtr;
int charsInLine, x, y, value, mask;
char string[100];
if (psInfoPtr->prepass) {
return TCL_OK;
}
Tk_SizeOfBitmap(canvasPtr->display, bitmap, &width, &height);
imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
width, height, 1, XYPixmap);
Tcl_AppendResult(canvasPtr->interp, "<", (char *) NULL);
mask = 0x80;
value = 0;
charsInLine = 0;
for (y = 1; y <= height; y++) {
for (x = 0; x < width; x++) {
if (XGetPixel(imagePtr, x, height-y)) {
value |= mask;
}
mask >>= 1;
if (mask == 0) {
sprintf(string, "%02x", value);
Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
mask = 0x80;
value = 0;
charsInLine += 2;
if (charsInLine >= 60) {
Tcl_AppendResult(canvasPtr->interp, "\n", (char *) NULL);
charsInLine = 0;
}
}
}
if (mask != 0x80) {
sprintf(string, "%02x", value);
Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
mask = 0x80;
value = 0;
charsInLine += 2;
}
}
Tcl_AppendResult(canvasPtr->interp, ">", (char *) NULL);
XDestroyImage(imagePtr);
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* TkCanvPsStipple --
*
* 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 path 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 canvasPtr->interp->result.
* If no error occurs, then additional Postscript will be
* appended to canvasPtr->interp->result.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
int
TkCanvPsStipple(canvasPtr, handle, bitmap, filled)
Tk_Canvas *canvasPtr; /* Information about canvas. */
Tk_PostscriptInfo *handle; /* Information about Postscript being
* generated. */
Pixmap bitmap; /* Bitmap to use for stippling. */
int filled; /* Non-zero means the area defined by
* the path should be filled with the
* stipple pattern; zero means the
* path should be stroked in the
* stipple pattern. */
{
PostscriptInfo *psInfoPtr = (PostscriptInfo *) handle;
unsigned int width, height;
char string[100];
if (psInfoPtr->prepass) {
return TCL_OK;
}
Tk_SizeOfBitmap(canvasPtr->display, bitmap, &width, &height);
sprintf(string, "%d %d ", width, height);
Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
if (TkCanvPsBitmap(canvasPtr, handle, bitmap) != TCL_OK) {
return TCL_ERROR;
}
Tcl_AppendResult(canvasPtr->interp, filled ? " true" : " false",
" StippleFill\n", (char *) NULL);
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* TkCanvPsY --
*
* 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
TkCanvPsY(handle, y)
Tk_PostscriptInfo *handle; /* Information about Postscript being
* generated. */
double y; /* Y-coordinate in canvas coords. */
{
PostscriptInfo *psInfoPtr = (PostscriptInfo *) handle;
return psInfoPtr->y2 - y;
}
/*
*--------------------------------------------------------------
*
* TkCanvPsPath --
*
* 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
TkCanvPsPath(interp, coordPtr, numPoints, handle)
Tcl_Interp *interp; /* Put generated Postscript in this
* interpreter's result field. */
register double *coordPtr; /* Pointer to first in array of
* 2*numPoints coordinates giving
* points for path. */
int numPoints; /* Number of points at *coordPtr. */
Tk_PostscriptInfo *handle; /* Information about the Postscript;
* must be passed back to Postscript
* utility procedures. */
{
PostscriptInfo *psInfoPtr = (PostscriptInfo *) handle;
char buffer[200];
if (psInfoPtr->prepass) {
return;
}
sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
TkCanvPsY(handle, 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],
TkCanvPsY(handle, 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:
case 'p':
end++;
break;
default:
goto error;
}
while ((*end != '\0') && isspace(UCHAR(*end))) {
end++;
}
if (*end != 0) {
goto error;
}
*doublePtr = d;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* CaseCmp --
*
* Compares two strings, ignoring case differences.
*
* Results:
* Compares up to length chars of s1 and s2, returning -1, 0, or 1
* if s1 is lexicographically less than, equal to, or greater
* than s2 over those characters.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
CaseCmp(s1, s2, length)
char *s1; /* First string. */
char *s2; /* Second string. */
int length; /* Maximum number of characters to compare
* (stop earlier if the end of either string
* is reached). */
{
register unsigned char u1, u2;
/*
* This array is designed for mapping upper and lower case letter
* together for a case independent comparison. The mappings are
* based upon ASCII character sequences.
*/
static unsigned char charmap[] = {
'\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007',
'\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017',
'\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027',
'\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037',
'\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047',
'\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057',
'\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067',
'\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077',
'\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
'\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
'\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
'\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137',
'\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
'\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
'\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
'\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177',
'\200', '\201', '\202', '\203', '\204', '\205', '\206', '\207',
'\210', '\211', '\212', '\213', '\214', '\215', '\216', '\217',
'\220', '\221', '\222', '\223', '\224', '\225', '\226', '\227',
'\230', '\231', '\232', '\233', '\234', '\235', '\236', '\237',
'\240', '\241', '\242', '\243', '\244', '\245', '\246', '\247',
'\250', '\251', '\252', '\253', '\254', '\255', '\256', '\257',
'\260', '\261', '\262', '\263', '\264', '\265', '\266', '\267',
'\270', '\271', '\272', '\273', '\274', '\275', '\276', '\277',
'\300', '\341', '\342', '\343', '\344', '\345', '\346', '\347',
'\350', '\351', '\352', '\353', '\354', '\355', '\356', '\357',
'\360', '\361', '\362', '\363', '\364', '\365', '\366', '\367',
'\370', '\371', '\372', '\333', '\334', '\335', '\336', '\337',
'\340', '\341', '\342', '\343', '\344', '\345', '\346', '\347',
'\350', '\351', '\352', '\353', '\354', '\355', '\356', '\357',
'\360', '\361', '\362', '\363', '\364', '\365', '\366', '\367',
'\370', '\371', '\372', '\373', '\374', '\375', '\376', '\377',
};
for (; length != 0; length--, s1++, s2++) {
u1 = (unsigned char) *s1;
u2 = (unsigned char) *s2;
if (charmap[u1] != charmap[u2]) {
return charmap[u1] - charmap[u2];
}
if (u1 == '\0') {
return 0;
}
}
return 0;
}
Reference in New Issue Copy Permalink