1/*
2 * xpm.c --
3 *
4 *	A photo image file handler for XPM files.
5 *
6 * Written by:
7 *	Jan Nijtmans
8 *	email: nijtmans@users.sourceforge.net
9 *	url:   http://purl.oclc.org/net/nijtmans/
10 *
11 * (with some code stolen from the XPM image type and the GIF handler)
12 *
13 * <mweilguni@sime.com> Mario Weilguni
14 * Jan 1997:
15 *      - fixed a bug when reading images with invalid color tables
16 *        (if a pixelchar is not in the colormap)
17 *      - added FileWriteXPM, StringWriteXPM and WriteXPM.
18 *      - modified FileReadXPM, ReadXPM and added StringReadXPM
19 *        This makes the XPM reader complete :-)
20 *
21 * <paul@poSoft.de> Paul Obermeier
22 * Jan 2001:
23 *      - Bugfix  in CommonWriteXPM: const char *fileName was overwritten.
24 *      - Bugfix  in CommonWriteXPM: If used with "-from" option, dumped core.
25 *      - Improve in CommonWriteXPM: Greater channel buffersize for better
26 *                                   Win98 (i.e. FAT32) performance.
27 *      - Improve in ChnRead: Better performance by using ReadBuffer.
28 *
29 * $Id: xpm.c 262 2010-05-31 15:03:33Z nijtmans $
30 */
31
32/*
33 * Generic initialization code, parameterized via CPACKAGE and PACKAGE.
34 */
35
36#include "init.c"
37
38#if defined(__WIN32__) && !defined(__GNUC__)
39#define strncasecmp strnicmp
40#endif
41
42#ifndef MAC_TCL
43#include <sys/types.h>
44#endif
45
46/* constants used only in this file */
47
48#define XPM_MONO		1
49#define XPM_GRAY_4		2
50#define XPM_GRAY		3
51#define XPM_COLOR		4
52#define XPM_SYMBOLIC		5
53#define XPM_UNKNOWN		6
54
55#define MAX_BUFFER 4096
56
57/*
58 * Prototypes for local procedures defined in this file:
59 */
60
61static int CommonRead(Tcl_Interp *interp, tkimg_MFile *handle,
62	Tcl_Obj *format, Tk_PhotoHandle imageHandle,
63	int destX, int destY, int width, int height,
64	int srcX, int srcY);
65static int CommonWrite(Tcl_Interp *interp, const char *fileName,
66	Tcl_DString *dataPtr, Tcl_Obj *format,
67	Tk_PhotoImageBlock *blockPtr);
68
69static int ReadXPMFileHeader(tkimg_MFile *handle,
70	int *widthPtr, int *heightPtr, int *numColors, int *byteSize);
71static char *GetType(char *colorDefn, int *type_ret);
72static char *GetColor(char *colorDefn, char *colorName, int *type_ret);
73static char *Gets(tkimg_MFile *handle, char *buffer, int size);
74
75/*
76 *----------------------------------------------------------------------
77 * Gets
78 *
79 *      Allows other routines to get their data from channels, files as well
80 *      as Tcl_DStrings.
81 *
82 * Results:
83 *      same as fgets: NULL pointer on any error, otherwise
84 *      it returns buffer
85 *
86 * Side effects:
87 *      The access position of the file changes OR
88 *      The access pointer dataPtr->p is changed
89 *
90 *----------------------------------------------------------------------
91 */
92
93static char *
94Gets(handle, buffer, size)
95    tkimg_MFile *handle;
96    char *buffer;
97    int size;
98{
99    char *p;
100
101    /* read data from tkimg_MFile */
102    p = buffer;
103    while ((tkimg_Read(handle, p, 1) == 1)) {
104	if (--size <= 0) {
105	    *p = 0; return buffer;
106	}
107	if (*p++ == '\n') {
108	    *p = 0;
109	    return buffer;
110	}
111    }
112    *p = 0;
113    return (p != buffer) ? buffer :(char *) NULL;
114}
115
116
117/*
118 *----------------------------------------------------------------------
119 *
120 * ObjMatch --
121 *
122 *	This procedure is invoked by the photo image type to see if
123 *	a datastring contains image data in XPM format.
124 *
125 * Results:
126 *	The return value is >0 if the first characters in data look
127 *	like XPM data, and 0 otherwise.
128 *
129 * Side effects:
130 *	none
131 *
132 *----------------------------------------------------------------------
133 */
134static int ObjMatch(
135    Tcl_Obj *data,		/* The data supplied by the image */
136    Tcl_Obj *format,		/* User-specified format object, or NULL. */
137    int *widthPtr,		/* The dimensions of the image are */
138	int *heightPtr,			/* returned here if the file is a valid
139				 * raw XPM file. */
140    Tcl_Interp *interp
141) {
142    int numColors, byteSize;
143    tkimg_MFile handle;
144
145    handle.data = (char *)tkimg_GetStringFromObj(data, &handle.length);
146    handle.state = IMG_STRING;
147
148    return ReadXPMFileHeader(&handle, widthPtr, heightPtr, &numColors, &byteSize);
149}
150
151/*
152 *----------------------------------------------------------------------
153 *
154 * ChnMatch --
155 *
156 *	This procedure is invoked by the photo image type to see if
157 *	a file contains image data in XPM format.
158 *
159 * Results:
160 *	The return value is >0 if the first characters in channel "chan"
161 *	look like XPM data, and 0 otherwise.
162 *
163 * Side effects:
164 *	The access position in chan may change.
165 *
166 *----------------------------------------------------------------------
167 */
168
169static int ChnMatch(
170    Tcl_Channel chan,		/* The image channel, open for reading. */
171    const char *fileName,	/* The name of the image file. */
172    Tcl_Obj *format,		/* User-specified format object, or NULL. */
173    int *widthPtr,        	/* The dimensions of the image are */
174	int *heightPtr,			/* returned here if the file is a valid
175				 * raw XPM file. */
176    Tcl_Interp *interp
177) {
178    int numColors, byteSize;
179    tkimg_MFile handle;
180
181    handle.data = (char *) chan;
182    handle.state = IMG_CHAN;
183
184    return ReadXPMFileHeader(&handle, widthPtr, heightPtr, &numColors, &byteSize);
185}
186
187/*
188 *----------------------------------------------------------------------
189 *
190 * CommonRead --
191 *
192 *	This procedure is called by the photo image type to read
193 *	XPM format data from a file or string and write it into a
194 *	given photo image.
195 *
196 * Results:
197 *	A standard TCL completion code.  If TCL_ERROR is returned
198 *	then an error message is left in interp->result.
199 *
200 * Side effects:
201 *	The access position in file f is changed (if read from file)
202 *	and new data is added to the image given by imageHandle.
203 *
204 *----------------------------------------------------------------------
205 */
206static int
207CommonRead(interp, handle, format, imageHandle, destX, destY,
208	width, height, srcX, srcY)
209    Tcl_Interp *interp;		/* Interpreter to use for reporting errors. */
210    tkimg_MFile *handle;	/* The image channel, open for reading. */
211    Tcl_Obj *format;		/* User-specified format object, or NULL. */
212    Tk_PhotoHandle imageHandle;	/* The photo image to write into. */
213    int destX, destY;		/* Coordinates of top-left pixel in
214				 * photo image to be written to. */
215    int width, height;		/* Dimensions of block of photo image to
216				 * be written to. */
217    int srcX, srcY;		/* Coordinates of top-left pixel to be used
218				 * in image being read. */
219{
220    int fileWidth = 0, fileHeight = 0, numColors = 0, byteSize = 0;
221    int h, type;
222    int nchan, matte = 1;
223    unsigned char *pixelPtr;
224    Tk_PhotoImageBlock block;
225    Tcl_HashTable colorTable;
226    Tk_Window tkwin = Tk_MainWindow(interp);
227    Display *display = Tk_Display(tkwin);
228    Colormap colormap = Tk_Colormap(tkwin);
229    int depth = Tk_Depth(tkwin);
230    char *p;
231    char buffer[MAX_BUFFER];
232    int i, isMono;
233    int color1;
234    unsigned int data;
235    Tcl_HashEntry *hPtr;
236    int result = TCL_OK;
237
238    Tcl_InitHashTable(&colorTable, TCL_ONE_WORD_KEYS);
239
240    switch ((Tk_Visual(tkwin))->class) {
241      case StaticGray:
242      case GrayScale:
243	isMono = 1;
244	break;
245      default:
246	isMono = 0;
247    }
248
249    type = ReadXPMFileHeader(handle, &fileWidth, &fileHeight, &numColors, &byteSize);
250    if (type == 0) {
251	Tcl_AppendResult(interp, "couldn't read raw XPM header", NULL);
252	return TCL_ERROR;
253    }
254    if ((fileWidth <= 0) || (fileHeight <= 0)) {
255	Tcl_AppendResult(interp, "XPM image file has dimension(s) <= 0",
256		(char *) NULL);
257	return TCL_ERROR;
258    }
259    if ((byteSize < 1) || (byteSize > 4)) {
260	Tcl_AppendResult(interp, "XPM image file has invalid byte size ",
261		"(should be 1, 2, 3 or 4)", (char *) NULL);
262	return TCL_ERROR;
263    }
264
265    if ((srcX + width) > fileWidth) {
266	width = fileWidth - srcX;
267    }
268    if ((srcY + height) > fileHeight) {
269	height = fileHeight - srcY;
270    }
271    if ((width <= 0) || (height <= 0)
272	|| (srcX >= fileWidth) || (srcY >= fileHeight)) {
273	return TCL_OK;
274    }
275
276    for (i=0; i<numColors; i++) {
277	char * colorDefn;		/* the color definition line */
278	char * colorName;		/* temp place to hold the color name
279					 * defined for one type of visual */
280	char * useName;			/* the color name used for this
281					 * color. If there are many names
282					 * defined, choose the name that is
283					 * "best" for the target visual
284					 */
285	XColor color;
286	int found;
287
288	p = Gets(handle, buffer,MAX_BUFFER);
289	while (((p = strchr(p,'\"')) == NULL)) {
290	    p = Gets(handle, buffer,MAX_BUFFER);
291	    if (p == NULL) {
292		return TCL_ERROR;
293	    }
294	    p = buffer;
295	}
296	colorDefn = p + byteSize + 1;
297	colorName = (char*)ckalloc(strlen(colorDefn)+1);
298	useName   = (char*)ckalloc(strlen(colorDefn)+1);
299	found     = 0;
300	color1 = 0;
301	data = 0;
302
303	while (colorDefn && *colorDefn) {
304	    int type;
305
306	    if ((colorDefn=GetColor(colorDefn, colorName, &type)) == NULL) {
307		break;
308	    }
309	    if (colorName[0] == '\0') {
310		continue;
311	    }
312
313	    switch (type) {
314	      case XPM_MONO:
315		if (isMono && depth == 1) {
316		    strcpy(useName, colorName);
317		    found = 1; goto gotcolor;
318		}
319		break;
320	      case XPM_GRAY_4:
321		if (isMono && depth == 4) {
322		    strcpy(useName, colorName);
323		    found = 1; goto gotcolor;
324		}
325		break;
326	      case XPM_GRAY:
327		if (isMono && depth > 4) {
328		    strcpy(useName, colorName);
329		    found = 1; goto gotcolor;
330		}
331		break;
332	      case XPM_COLOR:
333		if (!isMono) {
334		    strcpy(useName, colorName);
335		    found = 1; goto gotcolor;
336		}
337		break;
338	    }
339	    if (type != XPM_SYMBOLIC && type != XPM_UNKNOWN) {
340		if (!found) {			/* use this color as default */
341		    strcpy(useName, colorName);
342		    found = 1;
343		}
344	    }
345	}
346
347      gotcolor:
348
349	memcpy(&color1, p+1, byteSize);
350	p = useName;
351	while ((*p != 0) && (*p != '"') && (*p != '\t')) {
352	    p++;
353	}
354	*p = 0;
355
356	data = 0;
357	if (strncasecmp(useName, "none",4)) {
358	  if (XParseColor(display, colormap, useName, &color) == 0) {
359	    color.red = color.green = color.blue = 0;
360	  }
361	  ((unsigned char *) &data)[0] = color.red>>8;
362	  ((unsigned char *) &data)[1] = color.green>>8;
363	  ((unsigned char *) &data)[2] = color.blue>>8;
364	  ((unsigned char *) &data)[3] = 255;
365	}
366
367	hPtr = Tcl_CreateHashEntry(&colorTable, (char *) (size_t) color1, &found);
368	Tcl_SetHashValue(hPtr, (char *) (size_t) data);
369
370	ckfree(colorName);
371	ckfree(useName);
372    }
373
374    Tk_PhotoGetImage(imageHandle, &block);
375
376    if (tkimg_PhotoExpand(interp, imageHandle, destX + width, destY + height) == TCL_ERROR) {
377	return TCL_ERROR;
378    }
379
380    nchan = block.pixelSize;
381    block.pitch = nchan * fileWidth;
382    block.width = width;
383    block.height = 1;
384    block.offset[0] = 0;
385    block.offset[1] = 1;
386    block.offset[2] = 2;
387    block.offset[3] = (nchan == 4 && matte? 3: 0);
388    block.pixelPtr = (unsigned char *) ckalloc((unsigned) nchan * width);
389
390    i = srcY;
391    while (i-- > 0) {
392	p = Gets(handle, buffer,MAX_BUFFER);
393	while (((p = strchr(p,'\"')) == NULL)) {
394	    p = Gets(handle, buffer,MAX_BUFFER);
395	    if (p == NULL) {
396		return TCL_ERROR;
397	    }
398	    p = buffer;
399	}
400    }
401
402
403    for (h = height; h > 0; h--) {
404	p = Gets(handle, buffer,MAX_BUFFER);
405	while (((p = strchr(p,'\"')) == NULL)) {
406	    p = Gets(handle, buffer,MAX_BUFFER);
407	    if (p == NULL) {
408		return TCL_ERROR;
409	    }
410	    p = buffer;
411	}
412	p += byteSize * srcX + 1;
413	pixelPtr = block.pixelPtr;
414
415	for (i = 0; i < width; ) {
416	    unsigned int col;
417
418	    memcpy((char *) &color1, p, byteSize);
419	    hPtr = Tcl_FindHashEntry(&colorTable, (char *) (size_t) color1);
420
421	    /*
422	     * if hPtr == NULL, we have an invalid color entry in the XPM
423	     * file. We use transparant as default color
424	     */
425	    if (hPtr != (Tcl_HashEntry *)NULL)
426	        col = (unsigned int) (size_t) Tcl_GetHashValue(hPtr);
427	    else
428	        col = (unsigned int) 0;
429
430	    /*
431	     * we've found a non-transparent pixel, let's search the next
432	     * transparent pixel and copy this block to the image
433	     */
434	    if (col) {
435	        int len = 0, j;
436
437		j = i;
438		pixelPtr = block.pixelPtr;
439		do {
440		    memcpy(pixelPtr, &col, block.pixelSize);
441		    pixelPtr += block.pixelSize;
442		    i++;
443		    len++;
444		    p += byteSize;
445
446		    if (i < width) {
447		        memcpy((char *) &color1, p, byteSize);
448			hPtr = Tcl_FindHashEntry(&colorTable, (char *) (size_t) color1);
449			if (hPtr != (Tcl_HashEntry *)NULL)
450			    col = (unsigned int) (size_t) Tcl_GetHashValue(hPtr);
451			else
452			    col = (unsigned int) 0;
453		    }
454		} while ((i < width) && col);
455		if (tkimg_PhotoPutBlock(interp, imageHandle, &block, destX+j, destY, len, 1, TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {
456		    result = TCL_ERROR;
457		    break;
458		}
459	    } else {
460	        p += byteSize;
461	        i++;
462	    }
463	}
464	destY++;
465    }
466
467    Tcl_DeleteHashTable(&colorTable);
468
469    ckfree((char *) block.pixelPtr);
470    return result;
471}
472
473/*
474 *----------------------------------------------------------------------
475 *
476 * ChnRead --
477 *
478 *	This procedure is called by the photo image type to read
479 *	XPM format data from a channel and write it into a given
480 *	photo image.
481 *
482 * Results:
483 *	A standard TCL completion code.  If TCL_ERROR is returned
484 *	then an error message is left in interp->result.
485 *
486 * Side effects:
487 *	The access position in channel chan is changed, and new
488 *	data is added to the image given by imageHandle.
489 *
490 *----------------------------------------------------------------------
491 */
492
493static int
494ChnRead(interp, chan, fileName, format, imageHandle, destX, destY,
495	width, height, srcX, srcY)
496    Tcl_Interp *interp;		/* Interpreter to use for reporting errors. */
497    Tcl_Channel chan;		/* The image channel, open for reading. */
498    const char *fileName;	/* The name of the image file. */
499    Tcl_Obj *format;		/* User-specified format object, or NULL. */
500    Tk_PhotoHandle imageHandle;	/* The photo image to write into. */
501    int destX, destY;		/* Coordinates of top-left pixel in
502				 * photo image to be written to. */
503    int width, height;		/* Dimensions of block of photo image to
504				 * be written to. */
505    int srcX, srcY;		/* Coordinates of top-left pixel to be used
506				 * in image being read. */
507{
508    tkimg_MFile handle;
509    int retVal;
510
511    handle.data = (char *) chan;
512    handle.state = IMG_CHAN;
513
514    tkimg_ReadBuffer (1);
515    retVal = CommonRead (interp, &handle, format, imageHandle,
516		         destX, destY, width, height, srcX, srcY);
517    tkimg_ReadBuffer (0);
518    return retVal;
519}
520
521
522/*
523 *----------------------------------------------------------------------
524 *
525 * ObjRead --
526 *
527 *	This procedure is called by the photo image type to read
528 *	XPM format data from a string and write it into a given
529 *	photo image.
530 *
531 * Results:
532 *	A standard TCL completion code.  If TCL_ERROR is returned
533 *	then an error message is left in interp->result.
534 *
535 * Side effects:
536 *	New data is added to the image given by imageHandle.
537 *
538 *----------------------------------------------------------------------
539 */
540
541static int
542ObjRead(interp, data, format, imageHandle, destX, destY,
543	width, height, srcX, srcY)
544    Tcl_Interp *interp;		/* Interpreter to use for reporting errors. */
545    Tcl_Obj *data;
546    Tcl_Obj *format;		/* User-specified format object, or NULL. */
547    Tk_PhotoHandle imageHandle;	/* The photo image to write into. */
548    int destX, destY;		/* Coordinates of top-left pixel in
549				 * photo image to be written to. */
550    int width, height;		/* Dimensions of block of photo image to
551				 * be written to. */
552    int srcX, srcY;		/* Coordinates of top-left pixel to be used
553				 * in image being read. */
554{
555    tkimg_MFile handle;
556
557    handle.data = (char *)tkimg_GetStringFromObj(data, &handle.length);
558    handle.state = IMG_STRING;
559
560    return CommonRead(interp, &handle, format, imageHandle,
561	    destX, destY, width, height, srcX, srcY);
562}
563
564
565/*
566 *----------------------------------------------------------------------
567 *
568 * ReadXPMFileHeader --
569 *
570 *	This procedure reads the XPM header from the beginning of a
571 *	XPM file and returns information from the header.
572 *
573 * Results:
574 *	The return value is 1 if file "f" appears to start with a valid
575 *      XPM header, and 0 otherwise.  If the header is valid,
576 *	then *widthPtr and *heightPtr are modified to hold the
577 *	dimensions of the image and *numColors holds the number of
578 *	colors and byteSize the number of bytes used for 1 pixel.
579 *
580 * Side effects:
581 *	The access position in f advances.
582 *
583 *----------------------------------------------------------------------
584 */
585
586#define UCHAR(c) ((unsigned char) (c))
587
588static int
589ReadXPMFileHeader(handle, widthPtr, heightPtr, numColors, byteSize)
590    tkimg_MFile *handle;		/* handle to read the header from */
591    int *widthPtr, *heightPtr;	/* The dimensions of the image are
592				 * returned here. */
593    int *numColors;		/* the number of colors is returned here */
594    int *byteSize;		/* number of bytes per pixel */
595{
596    char buffer[MAX_BUFFER];
597    char *p;
598
599    p = Gets(handle, buffer,MAX_BUFFER);
600    if (p == NULL) {
601	return 0;
602    }
603    p = buffer;
604    while (*p && isspace(UCHAR(*p))) {
605	p++;
606    }
607    if (strncmp("/* XPM", p, 6) != 0) {
608	return 0;
609    }
610    while ((p = strchr(p,'{')) == NULL) {
611	p = Gets(handle, buffer,MAX_BUFFER);
612	if (p == NULL) {
613	    return 0;
614	}
615	p = buffer;
616    }
617    while ((p = strchr(p,'"')) == NULL) {
618	p = Gets(handle, buffer,MAX_BUFFER);
619	if (p == NULL) {
620	    return 0;
621	}
622	p = buffer;
623    }
624    p++;
625    while (p && *p && isspace(UCHAR(*p))) {
626	p++;
627    }
628    *widthPtr = strtoul(p, &p, 0);
629    if (p == NULL || *widthPtr <= 0) {
630	return 0;
631    }
632    while (p && *p && isspace(UCHAR(*p))) {
633	p++;
634    }
635    *heightPtr = strtoul(p, &p, 0);
636    if (p == NULL || *heightPtr <= 0) {
637	return 0;
638    }
639    while (p && *p && isspace(UCHAR(*p))) {
640	p++;
641    }
642    *numColors = strtoul(p, &p, 0);
643    if (p == NULL) {
644	return 0;
645    }
646    while (p && *p && isspace(UCHAR(*p))) {
647	p++;
648    }
649    *byteSize = strtoul(p, &p, 0);
650    if (p == NULL) {
651	return 0;
652    }
653    return 1;
654}
655
656static char * GetType(colorDefn, type_ret)
657    char * colorDefn;
658    int  * type_ret;
659{
660    char * p = colorDefn;
661
662    /* skip white spaces */
663    while (*p && isspace(UCHAR(*p))) {
664	p ++;
665    }
666
667    /* parse the type */
668    if (p[0] != '\0' && p[0] == 'm' &&
669	p[1] != '\0' && isspace(UCHAR(p[1]))) {
670	*type_ret = XPM_MONO;
671	p += 2;
672    }
673    else if (p[0] != '\0' && p[0] == 'g' &&
674	     p[1] != '\0' && p[1] == '4' &&
675	     p[2] != '\0' && isspace(UCHAR(p[2]))) {
676	*type_ret = XPM_GRAY_4;
677	p += 3;
678    }
679    else if (p[0] != '\0' && p[0] == 'g' &&
680	     p[1] != '\0' && isspace(UCHAR(p[1]))) {
681	*type_ret = XPM_GRAY;
682	p += 2;
683    }
684    else if (p[0] != '\0' && p[0] == 'c' &&
685	     p[1] != '\0' && isspace(UCHAR(p[1]))) {
686	*type_ret = XPM_COLOR;
687	p += 2;
688    }
689    else if (p[0] != '\0' && p[0] == 's' &&
690	     p[1] != '\0' && isspace(UCHAR(p[1]))) {
691	*type_ret = XPM_SYMBOLIC;
692	p += 2;
693    }
694    else {
695	*type_ret = XPM_UNKNOWN;
696	return NULL;
697    }
698
699    return p;
700}
701
702/* colorName is guaranteed to be big enough */
703static char * GetColor(colorDefn, colorName, type_ret)
704    char * colorDefn;
705    char * colorName;		/* if found, name is copied to this array */
706    int  * type_ret;
707{
708    int type;
709    char * p;
710
711    if (!colorDefn) {
712	return NULL;
713    }
714
715    if ((colorDefn = GetType(colorDefn, &type)) == NULL) {
716	/* unknown type */
717	return NULL;
718    }
719    else {
720	*type_ret = type;
721    }
722
723    /* skip white spaces */
724    while (*colorDefn && isspace(UCHAR(*colorDefn))) {
725	colorDefn ++;
726    }
727
728    p = colorName;
729
730    while (1) {
731	int dummy;
732
733	while (*colorDefn && !isspace(UCHAR(*colorDefn))) {
734	    *p++ = *colorDefn++;
735	}
736
737	if (!*colorDefn) {
738	    break;
739	}
740
741	if (GetType(colorDefn, &dummy) == NULL) {
742	    /* the next string should also be considered as a part of a color
743	     * name */
744
745	    while (*colorDefn && isspace(UCHAR(*colorDefn))) {
746		*p++ = *colorDefn++;
747	    }
748	} else {
749	    break;
750	}
751	if (!*colorDefn) {
752	    break;
753	}
754    }
755
756    /* Mark the end of the colorName */
757    *p = '\0';
758
759    return colorDefn;
760}
761
762
763/*
764 *----------------------------------------------------------------------
765 *
766 * ChnWrite
767 *
768 *	Writes a XPM image to a file. Just calls CommonWrite
769 *      with appropriate arguments.
770 *
771 * Results:
772 *	Returns the return value of CommonWrite
773 *
774 * Side effects:
775 *	A file is (hopefully) created on success.
776 *
777 *----------------------------------------------------------------------
778 */
779static int
780ChnWrite(interp, fileName, format, blockPtr)
781    Tcl_Interp *interp;
782    const char *fileName;
783    Tcl_Obj *format;
784    Tk_PhotoImageBlock *blockPtr;
785{
786    return CommonWrite(interp, fileName, (Tcl_DString *)NULL, format, blockPtr);
787}
788
789
790/*
791 *----------------------------------------------------------------------
792 *
793 * StringWrite
794 *
795 *	Writes a XPM image to a string. Just calls CommonWrite
796 *      with appropriate arguments.
797 *
798 * Results:
799 *	Returns the return value of CommonWrite
800 *
801 * Side effects:
802 *	The Tcl_DString dataPtr is modified on success.
803 *
804 *----------------------------------------------------------------------
805 */
806static int StringWrite(
807    Tcl_Interp *interp,
808    Tcl_Obj *format,
809    Tk_PhotoImageBlock *blockPtr
810) {
811    int result;
812    Tcl_DString data;
813
814    Tcl_DStringInit(&data);
815    result = CommonWrite(interp, "InlineData", &data, format, blockPtr);
816    if (result == TCL_OK) {
817	Tcl_DStringResult(interp, &data);
818    } else {
819	Tcl_DStringFree(&data);
820    }
821    return result;
822}
823
824
825/*
826 * Yes, I know these macros are dangerous. But it should work fine
827 */
828#define WRITE(buf) { if (!dataPtr) Tcl_Write(chan, buf, -1); else Tcl_DStringAppend(dataPtr, buf, -1);}
829
830/*
831 *----------------------------------------------------------------------
832 *
833 * CommonWrite
834 *
835 *	This procedure writes a XPM image to the file filename
836 *      (if filename != NULL) or to dataPtr.
837 *
838 * Results:
839 *	Returns TCL_OK on success, or TCL_ERROR on error.
840 *      Possible failures are:
841 *      1. cannot access file (permissions or path not found)
842 *      2. TkPhotoGetMask fails to retrieve the region mask
843 *         for the image (should not happen)
844 *
845 * Side effects:
846 *	varies (see StringWrite and ChnWrite)
847 *
848 *----------------------------------------------------------------------
849 */
850static int
851CommonWrite(interp, fileName, dataPtr, format, blockPtr)
852    Tcl_Interp *interp;
853    const char *fileName;
854    Tcl_DString *dataPtr;
855    Tcl_Obj *format;
856    Tk_PhotoImageBlock *blockPtr;
857{
858    int x, y, i;
859    int found;
860    Tcl_Channel chan = (Tcl_Channel) NULL;
861    Tcl_HashTable colors;
862    Tcl_HashEntry *entry;
863    Tcl_HashSearch search;
864    unsigned char *pp;
865    unsigned char *pixelPtr, *rowPixPtr;
866    int ncolors, chars_per_pixel;
867    int greenOffset, blueOffset, alphaOffset;
868    union {
869	ClientData value;
870	char component[3];
871    } col;
872    union {
873	ClientData value;
874	char component[5];
875    } temp;
876    char buffer[256], *p, *imgName;
877
878    /*
879     * xpm_chars[] must be 64 chars long
880     */
881    static char xpm_chars[] =
882	    ".#abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
883
884    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
885    blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
886    alphaOffset = blockPtr->offset[0];
887    if (alphaOffset < blockPtr->offset[1]) alphaOffset = blockPtr->offset[1];
888    if (alphaOffset < blockPtr->offset[2]) alphaOffset = blockPtr->offset[2];
889    if (++alphaOffset < blockPtr->pixelSize) {
890	alphaOffset -= blockPtr->offset[0];
891    } else {
892	alphaOffset = 0;
893    }
894
895    /* open the output file (if needed) */
896    if (!dataPtr) {
897      chan = Tcl_OpenFileChannel(interp, (CONST84 char *) fileName, "w", 0644);
898      if (!chan) {
899	return TCL_ERROR;
900      }
901      if (Tcl_SetChannelOption (interp, chan, "-buffersize", "131072") != TCL_OK) {
902        Tcl_Close(interp, chan);
903        return TCL_ERROR;
904      }
905    }
906
907    /* compute image name */
908
909    imgName = (char*)ckalloc(strlen(fileName)+1);
910    memcpy (imgName, fileName, strlen(fileName)+1);
911    p = strrchr(imgName, '/');
912    if (p) {
913	imgName = p+1;
914    }
915    p = strrchr(imgName, '\\');
916    if (p) {
917	imgName = p+1;
918    }
919    p = strrchr(imgName, ':');
920    if (p) {
921	imgName = p+1;
922    }
923    p = strchr(imgName, '.');
924    if (p) {
925	*p = 0;
926    }
927    sprintf(buffer, "/* XPM */\nstatic char * %s[] = {\n", imgName);
928    WRITE(buffer);
929
930    /*
931     * Compute size of colortable
932     */
933    Tcl_InitHashTable(&colors, TCL_ONE_WORD_KEYS);
934    ncolors = 0;
935    col.value = 0;
936    for (y = 0; y < blockPtr->height; y++) {
937	pp = blockPtr->pixelPtr + y * blockPtr->pitch + blockPtr->offset[0];
938	for (x = blockPtr->width; x >0; x--) {
939	    if (!alphaOffset || pp[alphaOffset]) {
940		col.component[0] = pp[0];
941		col.component[1] = pp[greenOffset];
942		col.component[2] = pp[blueOffset];
943		if (Tcl_FindHashEntry(&colors, (char *) col.value) == NULL) {
944		    ncolors++;
945		    entry = Tcl_CreateHashEntry(&colors, (char *) col.value,
946		    	    &found);
947		}
948	    }
949	    pp += blockPtr->pixelSize;
950	}
951    }
952
953    /* compute number of characters per pixel */
954    chars_per_pixel = 1;
955    i = ncolors;
956    while (i > 64) {
957	chars_per_pixel++;
958	i /= 64;
959    }
960
961    /* write image info into XPM */
962    sprintf(buffer, "\"%d %d %d %d\",\n", blockPtr->width, blockPtr->height,
963	    ncolors+(alphaOffset != 0), chars_per_pixel);
964    WRITE(buffer);
965
966    /* write transparent color id if transparency is available*/
967    if (alphaOffset) {
968	strcpy(temp.component, "    ");
969	temp.component[chars_per_pixel] = 0;
970 	sprintf(buffer, "\"%s s None c None\",\n", temp.component);
971	WRITE(buffer);
972    }
973
974    /* write colormap strings */
975    entry = Tcl_FirstHashEntry(&colors, &search);
976    y = 0;
977    temp.component[chars_per_pixel] = 0;
978    while (entry) {
979	/* compute a color identifier for color #y */
980	for (i = 0, x = y++; i < chars_per_pixel; i++, x /= 64)
981	    temp.component[i] = xpm_chars[x & 63];
982
983	/*
984	 * and put it in the hashtable
985	 * this is a little bit tricky
986	 */
987	Tcl_SetHashValue(entry, (char *) temp.value);
988	pp = (unsigned char *)&entry->key.oneWordValue;
989	sprintf(buffer, "\"%s c #%02x%02x%02x\",\n",
990		temp.component, pp[0], pp[1], pp[2]);
991	WRITE(buffer);
992	entry = Tcl_NextHashEntry(&search);
993    }
994
995    /* write image itself */
996    rowPixPtr = blockPtr->pixelPtr + blockPtr->offset[0];
997    buffer[chars_per_pixel] = 0;
998    for (y = 0; y < blockPtr->height; y++) {
999	WRITE("\"");
1000	pixelPtr = rowPixPtr;
1001	for (x = 0; x < blockPtr->width; x++) {
1002	    if (!alphaOffset || pixelPtr[alphaOffset]) {
1003		col.component[0] = pixelPtr[0];
1004		col.component[1] = pixelPtr[greenOffset];
1005		col.component[2] = pixelPtr[blueOffset];
1006		entry = Tcl_FindHashEntry(&colors, (char *) col.value);
1007		temp.value = Tcl_GetHashValue(entry);
1008		memcpy(buffer, temp.component, chars_per_pixel);
1009	    } else {
1010		/* make transparent pixel */
1011		memcpy(buffer, "    ", chars_per_pixel);
1012	    }
1013	    pixelPtr += blockPtr->pixelSize;
1014	    WRITE(buffer);
1015	}
1016	if (y == blockPtr->height - 1) {
1017	    WRITE("\"};");
1018	} else {
1019	    WRITE("\",\n");
1020	}
1021	rowPixPtr += blockPtr->pitch;
1022    }
1023
1024    /* Delete the hash table */
1025    Tcl_DeleteHashTable(&colors);
1026
1027    /* close the file */
1028    if (chan) {
1029	Tcl_Close(interp, chan);
1030    }
1031    return TCL_OK;
1032}
1033