Tk

 view release on metacpan or  search on metacpan

pTk/mTk/generic/tkCanvPs.c  view on Meta::CPAN

	    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;
}

/*
 *--------------------------------------------------------------
 *
 * TkImageGetColor --
 *
 *	This procedure converts a pixel value to three floating
 *      point numbers, representing the amount of red, green, and
 *      blue in that pixel on the screen.  It makes use of colormap
 *      data passed as an argument, and should work for all Visual
 *      types.
 *
 *	This implementation is bogus on Windows because the colormap
 *	data is never filled in.  Instead all postscript generated
 *	data coming through here is expected to be RGB color data.
 *	To handle lower bit-depth images properly, XQueryColors
 *	must be implemented for Windows.
 *
 * Results:
 *	Returns red, green, and blue color values in the range
 *      0 to 1.  There are no error returns.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */
#ifdef WIN32
#include <windows.h>

/*
 * We could just define these instead of pulling in windows.h.
 #define GetRValue(rgb)	((BYTE)(rgb))
 #define GetGValue(rgb)	((BYTE)(((WORD)(rgb)) >> 8))
 #define GetBValue(rgb)	((BYTE)((rgb)>>16))
*/

static void
TkImageGetColor(cdata, pixel, red, green, blue)
    TkColormapData *cdata;              /* Colormap data */
    unsigned long pixel;                /* Pixel value to look up */
    double *red, *green, *blue;         /* Color data to return */
{
    *red   = (double) GetRValue(pixel) / 255.0;
    *green = (double) GetGValue(pixel) / 255.0;
    *blue  = (double) GetBValue(pixel) / 255.0;
}
#else
static void
TkImageGetColor(cdata, pixel, red, green, blue)
    TkColormapData *cdata;              /* Colormap data */
    unsigned long pixel;                /* Pixel value to look up */
    double *red, *green, *blue;         /* Color data to return */
{
    if (cdata->separated) {
	int r = (pixel & cdata->red_mask) >> cdata->red_shift;
	int g = (pixel & cdata->green_mask) >> cdata->green_shift;
	int b = (pixel & cdata->blue_mask) >> cdata->blue_shift;
	*red   = cdata->colors[r].red / 65535.0;
	*green = cdata->colors[g].green / 65535.0;
	*blue  = cdata->colors[b].blue / 65535.0;
    } else {
	*red   = cdata->colors[pixel].red / 65535.0;
	*green = cdata->colors[pixel].green / 65535.0;
	*blue  = cdata->colors[pixel].blue / 65535.0;
    }
}
#endif

/*
 *--------------------------------------------------------------
 *
 * TkPostscriptImage --
 *
 *	This procedure is called to output the contents of an
 *	image in Postscript, using a format appropriate for the
 *      current color mode (i.e. one bit per pixel in monochrome,
 *      one byte per pixel in gray, and three bytes per pixel in
 *      color).
 *
 * 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
TkPostscriptImage(interp, tkwin, psInfo, ximage, x, y, width, height)
    Tcl_Interp *interp;
    Tk_Window tkwin;
    Tk_PostscriptInfo psInfo;	/* postscript info */
    XImage *ximage;		/* Image to draw */
    int x, y;			/* First pixel to output */
    int width, height;		/* Width and height of area */
{
    TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
    char buffer[256];
    int xx, yy, band, maxRows;
    double red, green, blue;
    int bytesPerLine=0, maxWidth=0;
    int level = psInfoPtr->colorLevel;
    Colormap cmap;
    int i, ncolors;
    Visual *visual;
    TkColormapData cdata;

    if (psInfoPtr->prepass) {
	return TCL_OK;
    }

    cmap = Tk_Colormap(tkwin);
    visual = Tk_Visual(tkwin);

    /*
     * Obtain information about the colormap, ie the mapping between
     * pixel values and RGB values.  The code below should work
     * for all Visual types.
     */

    ncolors = visual->map_entries;
    cdata.colors = (XColor *) ckalloc(sizeof(XColor) * ncolors);
    cdata.ncolors = ncolors;

    if (visual->class == DirectColor || visual->class == TrueColor) {
	cdata.separated = 1;
	cdata.red_mask = visual->red_mask;
	cdata.green_mask = visual->green_mask;
	cdata.blue_mask = visual->blue_mask;
	cdata.red_shift = 0;
	cdata.green_shift = 0;
	cdata.blue_shift = 0;
	while ((0x0001 & (cdata.red_mask >> cdata.red_shift)) == 0)
	    cdata.red_shift ++;
	while ((0x0001 & (cdata.green_mask >> cdata.green_shift)) == 0)
	    cdata.green_shift ++;
	while ((0x0001 & (cdata.blue_mask >> cdata.blue_shift)) == 0)
	    cdata.blue_shift ++;
	for (i = 0; i < ncolors; i ++)
	    cdata.colors[i].pixel =
		((i << cdata.red_shift) & cdata.red_mask) |
		((i << cdata.green_shift) & cdata.green_mask) |
		((i << cdata.blue_shift) & cdata.blue_mask);
    } else {
	cdata.separated=0;
	for (i = 0; i < ncolors; i ++)
	    cdata.colors[i].pixel = i;
    }
    if (visual->class == StaticGray || visual->class == GrayScale)
	cdata.color = 0;
    else
	cdata.color = 1;

    XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors);

    /*
     * Figure out which color level to use (possibly lower than the
     * one specified by the user).  For example, if the user specifies
     * color with monochrome screen, use gray or monochrome mode instead.
     */

    if (!cdata.color && level == 2) {
	level = 1;
    }

    if (!cdata.color && cdata.ncolors == 2) {
	level = 0;
    }

    /*
     * Check that at least one row of the image can be represented
     * with a string less than 64 KB long (this is a limit in the
     * Postscript interpreter).
     */

    switch (level) {
	case 0: bytesPerLine = (width + 7) / 8;  maxWidth = 240000;  break;
	case 1: bytesPerLine = width;  maxWidth = 60000;  break;
	case 2: bytesPerLine = 3 * width;  maxWidth = 20000;  break;
    }

    if (bytesPerLine > 60000) {
	Tcl_ResetResult(interp);
	sprintf(buffer,
		"Can't generate Postscript for images more than %d pixels wide",
		maxWidth);
	Tcl_AppendResult(interp, buffer, (char *) NULL);
	ckfree((char *) cdata.colors);
	return TCL_ERROR;
    }

    maxRows = 60000 / bytesPerLine;

    for (band = height-1; band >= 0; band -= maxRows) {
	int rows = (band >= maxRows) ? maxRows : band + 1;
	int lineLen = 0;
	switch (level) {
	    case 0:
		sprintf(buffer, "%d %d 1 matrix {\n<", width, rows);
		Tcl_AppendResult(interp, buffer, (char *) NULL);
		break;
	    case 1:
		sprintf(buffer, "%d %d 8 matrix {\n<", width, rows);
		Tcl_AppendResult(interp, buffer, (char *) NULL);
		break;
	    case 2:
		sprintf(buffer, "%d %d 8 matrix {\n<",
			width, rows);
		Tcl_AppendResult(interp, buffer, (char *) NULL);
		break;
	}
	for (yy = band; yy > band - rows; yy--) {
	    switch (level) {
		case 0: {
		    /*
		     * Generate data for image in monochrome mode.
		     * No attempt at dithering is made--instead, just
		     * set a threshold.
		     */
		    unsigned char mask=0x80;
		    unsigned char data=0x00;
		    for (xx = x; xx< x+width; xx++) {
			TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
					&red, &green, &blue);
			if (0.30 * red + 0.59 * green + 0.11 * blue > 0.5)
			    data |= mask;
			mask >>= 1;
			if (mask == 0) {
			    sprintf(buffer, "%02X", data);
			    Tcl_AppendResult(interp, buffer, (char *) NULL);
			    lineLen += 2;
			    if (lineLen > 60) {
			        lineLen = 0;
			        Tcl_AppendResult(interp, "\n", (char *) NULL);
			    }
			    mask=0x80;
			    data=0x00;
			}
		    }
		    if ((width % 8) != 0) {
		        sprintf(buffer, "%02X", data);
		        Tcl_AppendResult(interp, buffer, (char *) NULL);
		        mask=0x80;
		        data=0x00;
		    }
		    break;
		}
		case 1: {
		    /*
		     * Generate data in gray mode--in this case, take a
		     * weighted sum of the red, green, and blue values.
		     */
		    for (xx = x; xx < x+width; xx ++) {
			TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
					&red, &green, &blue);
			sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 *
				(0.30 * red + 0.59 * green + 0.11 * blue)));
			Tcl_AppendResult(interp, buffer, (char *) NULL);
			lineLen += 2;
			if (lineLen > 60) {
			    lineLen = 0;
			    Tcl_AppendResult(interp, "\n", (char *) NULL);
			}
		    }
		    break;
		}
		case 2: {
		    /*
		     * Finally, color mode.  Here, just output the red, green,
		     * and blue values directly.
		     */
		    for (xx = x; xx < x+width; xx++) {
			TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
				&red, &green, &blue);
			sprintf(buffer, "%02X%02X%02X",
				(int) floor(0.5 + 255.0 * red),
				(int) floor(0.5 + 255.0 * green),
				(int) floor(0.5 + 255.0 * blue));
			Tcl_AppendResult(interp, buffer, (char *) NULL);
			lineLen += 6;
			if (lineLen > 60) {
			    lineLen = 0;
			    Tcl_AppendResult(interp, "\n", (char *) NULL);
			}
		    }
		    break;
		}
	    }
	}
	switch (level) {
	    case 0: sprintf(buffer, ">\n} image\n"); break;
	    case 1: sprintf(buffer, ">\n} image\n"); break;
	    case 2: sprintf(buffer, ">\n} false 3 colorimage\n"); break;
	}
	Tcl_AppendResult(interp, buffer, (char *) NULL);
	sprintf(buffer, "0 %d translate\n", rows);
	Tcl_AppendResult(interp, buffer, (char *) NULL);
    }
    ckfree((char *) cdata.colors);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_PostscriptPhoto --
 *
 *	This procedure is called to output the contents of a
 *	photo image in Postscript, using a format appropriate for
 *	the requested postscript color mode (i.e. one byte per pixel
 *	in gray, and three bytes per pixel in color).
 *
 * 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 interpreter's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */
int
Tk_PostscriptPhoto(interp, blockPtr, psInfo, width, height)
    Tcl_Interp *interp;
    Tk_PhotoImageBlock *blockPtr;
    Tk_PostscriptInfo psInfo;
    int width, height;
{
    TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
    int colorLevel = psInfoPtr->colorLevel;
    static int codeIncluded = 0;

    unsigned char *pixelPtr;
    char buffer[256], cspace[40], decode[40];
    int bpc;
    int xx, yy, lineLen;
    float red, green, blue;
    int alpha;
    int bytesPerLine=0, maxWidth=0;

    unsigned char opaque = 255;
    unsigned char *alphaPtr;
    int alphaOffset, alphaPitch, alphaIncr;

    if (psInfoPtr->prepass) {
	codeIncluded = 0;
	return TCL_OK;
    }

    /*
     * Define the "TkPhoto" function, which is a modified version
     * of the original "transparentimage" function posted
     * by ian@five-d.com (Ian Kemmish) to comp.lang.postscript.
     * For a monochrome colorLevel this is a slightly different
     * version that uses the imagemask command instead of image.
     */



( run in 3.434 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )