Tk-Zinc

 view release on metacpan or  search on metacpan

PostScript.c  view on Meta::CPAN

            gc2->rgb->red/65535.0, gc2->rgb->green/65535.0, gc2->rgb->blue/65535.0);
    Tcl_AppendResult(interp, path, NULL);
    gc1 = gc2;
  }
  Tcl_AppendResult(interp, "      ] >>\n", NULL);
  Tcl_AppendResult(interp, "  >> >>\n", NULL);
  Tcl_AppendResult(interp, "matrix makepattern setpattern fill\n", NULL);

  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.
 *
 *--------------------------------------------------------------
 */
/*
 * The following definition is used in generating postscript for images
 * and windows.
 */
typedef struct TkColormapData {	/* Hold color information for a window */
    int separated;		/* Whether to use separate color bands */
    int color;			/* Whether window is color or black/white */
    int ncolors;		/* Number of color values stored */
    XColor *colors;		/* Pixel value -> RGB mappings */
    int red_mask, green_mask, blue_mask;	/* Masks and shifts for each */
    int red_shift, green_shift, blue_shift;	/* color band */
} TkColormapData;

#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))
*/
#else
#define GetRValue(rgb)	((rgb & cdata->red_mask) >> cdata->red_shift)
#define GetGValue(rgb)	((rgb & cdata->green_mask) >> cdata->green_shift)
#define GetBValue(rgb)	((rgb & cdata->blue_mask) >> cdata->blue_shift)
#endif

#if defined(WIN32) || defined(MAC_OSX_TK)
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 = GetRValue(pixel);
	int g = GetGValue(pixel);
	int b = GetBValue(pixel);
	*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

/*
 *--------------------------------------------------------------
 *
 * ZnPostscriptXImage --
 *
 *	This procedure is called to output the contents of an
 *	XImage 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.
 *
 *--------------------------------------------------------------
 */
/* TODO beaucoup de code à partager avec photo ci dessous
 * sans compter qu'il faut une autre fonction pour emettre
 * du code pour les tiling patterns.
 * Il faudrait un operateur central qui emette dans une
 * string postscript des bandes d'image afin de respecter
 * la taille max des strings (on peut aussi mettre les
 * bandes dans un tableau au préalable). Cet opérateur
 * gére le niveau de couleur (0, 1, ...) et sait gérer les
 * bits de transparence Postscript 3 en option.
 */
int
ZnPostscriptXImage(Tcl_Interp        *interp,
                   Tk_Window         tkwin,
                   Tk_PostscriptInfo psInfo,
                   XImage            *ximage,
                   int               x,
                   int               y,
                   int               width,
                   int               height)
{
  TkPostscriptInfo *psi = (TkPostscriptInfo *) psInfo;
  char             buffer[256];
  int              xx, yy, band, maxRows;
  double           red, green, blue;
  int              bytesPerLine=0, maxWidth=0;
  int              level = psi->colorLevel;
  Colormap         cmap;
  int              i, ncolors;
  Visual           *visual;
  TkColormapData   cdata;

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

  Tcl_AppendResult(interp, "%%%%%% Start of ZnPostscriptXImage\n", NULL);

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

  Tcl_AppendResult(interp, "%%%%%% End of ZnPostscriptXImage\n", NULL);

  return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ZnPostscriptPhoto --
 *
 *  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
ZnPostscriptPhoto(Tcl_Interp         *interp,
                  Tk_PhotoImageBlock *blockPtr,
                  Tk_PostscriptInfo  ps_info,
                  int                width,
                  int                height)
{
  TkPostscriptInfo *psi = (TkPostscriptInfo *) ps_info;
  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 (psi->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.
   */
  if( !codeIncluded && (psi->colorLevel != 0) ) {



( run in 0.694 second using v1.01-cache-2.11-cpan-d8267643d1d )