1/* STARTHEADER
2 *
3 * File :       pcx.c
4 *
5 * Author :     Paul Obermeier (paul@poSoft.de)
6 *
7 * Date :       Die Feb 20 14:27:18 CET 2001
8 *
9 * Copyright :  (C) 2001-2002 Paul Obermeier
10 *
11 * Description :
12 *
13 * A photo image handler for PaintBrush's PCX file format.
14 *
15 * The following image types are supported:
16 *
17 *  1-bit pixels: Black and White.
18 *  8-bit pixels: Grayscale or indexed.
19 * 24-bit pixels: True-color (RGB, each channel 8 bit).
20 *
21 * List of currently supported features:
22 *
23 * Type   |     Read      |     Write     |
24 *        | -file | -data | -file | -data |
25 * ----------------------------------------
26 *  1-bit | Yes   | Yes   | No    | No    |
27 *  8-bit | Yes   | Yes   | No    | No    |
28 * 24-bit | Yes   | Yes   | Yes   | Yes   |
29 *
30 * All images types may be either uncompressed or run-length encoded.
31 *
32 *
33 * The following format options are available:
34 *
35 * Read  PCX image: "pcx -verbose <bool>"
36 * Write PCX image: "pcx -verbose <bool> -compression <type>"
37 *
38 * -verbose <bool>:     If set to true, additional information about the file
39 *                      format is printed to stdout. Default is "false".
40 * -compression <type>: Set the compression mode to either "none" or "rle".
41 *			Default is "rle".
42 *
43 * Notes:
44 *
45 * - Part of this code was taken from the "pcx" GIMP plugin:
46 *
47 *  >> pcx.c GIMP plug-in for loading & saving PCX files
48 *  >>
49 *  >> This code is based in parts on code by Francisco Bustamante, but the
50 *  >> largest portion of the code has been rewritten and is now maintained
51 *  >> occasionally by Nick Lamb njl195@zepler.org.uk
52 *
53 * ENDHEADER
54 *
55 * $Id: pcx.c 278 2010-06-30 14:44:44Z nijtmans $
56 *
57 */
58
59/*
60 * Generic initialization code, parameterized via CPACKAGE and PACKAGE.
61 */
62
63#include "init.c"
64
65
66/* #define DEBUG_LOCAL */
67
68/* Some defines and typedefs. */
69#define TRUE  1
70#define FALSE 0
71typedef unsigned char Boln;	/* Boolean value: TRUE or FALSE */
72typedef unsigned char UByte;	/* Unsigned  8 bit integer */
73typedef char  Byte;		/* Signed    8 bit integer */
74typedef unsigned short UShort;	/* Unsigned 16 bit integer */
75typedef short Short;		/* Signed   16 bit integer */
76typedef int Int;		/* Signed   32 bit integer */
77
78typedef struct {
79  UByte manufacturer;
80  UByte version;
81  UByte compression;
82  UByte bpp;
83  Short x1;
84  Short y1;
85  Short x2;
86  Short y2;
87  Short hdpi;
88  Short vdpi;
89  UByte colormap[48];
90  UByte reserved;
91  UByte planes;
92  Short bytesperline;
93  Short color;
94  UByte filler[58];
95} PCXHEADER;
96
97/* This function determines at runtime, whether we have to swap bytes.
98   The PCX image format expects data to be in Intel (Little-endian) format. */
99
100static int isIntel (void)
101{
102    unsigned long val = 513;
103    /* On Intel (little-endian) systems this value is equal to "\01\02\00\00".
104       On big-endian systems this value equals "\00\00\02\01" */
105    return memcmp(&val, "\01\02", 2) == 0;
106}
107
108#define htoqs(x) qtohs(x)
109static UShort qtohs (UShort x)
110{
111    if (!isIntel ()) {
112	return ((UShort)((((UShort)(x) & 0x00ff) << 8) | \
113			 (((UShort)(x) & 0xff00) >> 8)));
114    } else {
115	return x;
116    }
117}
118
119/* Read 1 byte, representing an unsigned integer number. */
120
121#ifdef DEBUG_LOCAL
122static Boln readUByte (tkimg_MFile *handle, UByte *b)
123{
124    char buf[1];
125    if (1 != tkimg_Read(handle, (char *) buf, 1))
126        return FALSE;
127    *b = buf[0];
128    return TRUE;
129}
130#else
131    /* Use this macro for better performance, esp. when reading RLE files. */
132#   define readUByte(h,b) (1 == tkimg_Read((h),(char *)(b),1))
133#endif
134
135/* Write 1 byte, representing an unsigned integer to a file. */
136
137static Boln writeUByte (tkimg_MFile *handle, UByte b)
138{
139    UByte buf[1];
140    buf[0] = b;
141    if (1 != tkimg_Write(handle, (const char *)buf, 1))
142        return FALSE;
143    return TRUE;
144}
145
146static Boln read_pcx_header (tkimg_MFile *ifp, PCXHEADER *pcxhdr)
147{
148    if (tkimg_Read(ifp, (char *)pcxhdr, 128) != 128) {
149	return FALSE;
150    }
151
152    if (pcxhdr->manufacturer != 10) {
153	return FALSE;
154    }
155    if (pcxhdr->bpp != 1 && pcxhdr->bpp != 8) {
156        return FALSE;
157    }
158    if (pcxhdr->planes != 1 && pcxhdr->planes != 3 && pcxhdr->planes != 4) {
159        return FALSE;
160    }
161    return TRUE;
162}
163
164#define OUT Tcl_WriteChars (outChan, str, -1)
165static void printImgInfo (PCXHEADER *ph, const char *filename, const char *msg)
166{
167    Tcl_Channel outChan;
168    char str[256];
169    Int width, height;
170
171    outChan = Tcl_GetStdChannel (TCL_STDOUT);
172    if (!outChan) {
173        return;
174    }
175    width  = qtohs (ph->x2) - qtohs (ph->x1) + 1;
176    height = qtohs (ph->y2) - qtohs (ph->y1) + 1;
177
178    sprintf(str, "%s %s\n", msg, filename);                                 OUT;
179    sprintf(str, "\tSize in pixel   : %d x %d\n", width, height);           OUT;
180    sprintf(str, "\tNo. of channels : %d\n", ph->planes);                   OUT;
181    sprintf(str, "\tBytes per pixel : %d\n", ph->bpp);                      OUT;
182    sprintf(str, "\tRLE compression : %s\n", ph->compression? "yes": "no"); OUT;
183    Tcl_Flush(outChan);
184}
185#undef OUT
186
187static Boln readline (tkimg_MFile *handle, UByte *buffer, Int bytes, Int compr)
188{
189    static UByte count = 0, value = 0;
190
191    if (compr) {
192	while (bytes--) {
193	    if (count == 0) {
194	        if (!readUByte (handle, &value)) {
195		    return FALSE;
196		}
197	        if (value < 0xc0) {
198		    count = 1;
199		} else {
200		    count = value - 0xc0;
201		    if (!readUByte (handle, &value)) {
202			return FALSE;
203		    }
204		}
205	    }
206	    count--;
207	    *(buffer++) = value;
208	}
209    } else {
210	if (bytes != tkimg_Read(handle, (char *)buffer, bytes)) {
211	    return FALSE;
212	}
213    }
214    return TRUE;
215}
216
217static Boln writeline (tkimg_MFile *handle, UByte *buffer, Int bytes)
218{
219    UByte value, count;
220    UByte *finish = buffer + bytes;
221
222    while (buffer < finish) {
223        value = *(buffer++);
224        count = 1;
225
226        while (buffer < finish && count < 63 && *buffer == value) {
227	    count++;
228            buffer++;
229	}
230
231        if (value < 0xc0 && count == 1) {
232	    if (!writeUByte (handle, value)) {
233		return FALSE;
234	    }
235	} else {
236	    if (!writeUByte (handle, 0xc0 + count)) {
237		return FALSE;
238	    }
239	    if (!writeUByte (handle, value)) {
240		return FALSE;
241	    }
242	}
243    }
244    return TRUE;
245}
246
247static Boln load_8 (Tcl_Interp *interp, tkimg_MFile *ifp,
248                    Tk_PhotoHandle imageHandle, int destX, int destY,
249                    int width, int height, int srcX, int srcY,
250                    int fileWidth, int fileHeight, int bytesPerLine, int compr)
251{
252    Int x, y;
253    Int stopY, outY;
254    Tk_PhotoImageBlock block;
255    UByte *line, *buffer, *indBuf, *indBufPtr;
256    UByte cmap[768], sepChar;
257    Boln result = TRUE;
258
259    line   = (UByte *) ckalloc (fileWidth);
260    buffer = (UByte *) ckalloc (fileWidth * 3);
261    indBuf = (UByte *) ckalloc (fileWidth * fileHeight);
262    indBufPtr = indBuf;
263
264    block.pixelSize = 3;
265    block.pitch = fileWidth * 3;
266    block.width = width;
267    block.height = 1;
268    block.offset[0] = 0;
269    block.offset[1] = 1;
270    block.offset[2] = 2;
271    block.offset[3] = 0;
272
273    block.pixelPtr = buffer + srcX * 3;
274
275    stopY = srcY + height;
276    outY  = destY;
277
278    /* Read in the whole image data as indices. */
279    for (y=0; y<stopY; y++) {
280        if (!readline (ifp, line, bytesPerLine, compr)) {
281	    ckfree ((char *) line);
282	    ckfree ((char *) buffer);
283	    ckfree ((char *) indBuf);
284	    return FALSE;
285	}
286        memcpy (indBufPtr, line, fileWidth);
287	indBufPtr += fileWidth;
288    }
289    /* Read the colormap: 256 entries */
290    if ((tkimg_Read(ifp, (char *)&sepChar, 1) != 1) ||
291        (tkimg_Read(ifp, (char *)&cmap, 768) != 768)) {
292	ckfree ((char *) line);
293	ckfree ((char *) buffer);
294	ckfree ((char *) indBuf);
295	return FALSE;
296    }
297
298    for (y=srcY; y<stopY; y++) {
299        for (x=0; x<fileWidth; x++) {
300            buffer[x * 3 + 0] = cmap[indBuf[y*fileWidth + x]*3 + 0 ];
301            buffer[x * 3 + 1] = cmap[indBuf[y*fileWidth + x]*3 + 1 ];
302            buffer[x * 3 + 2] = cmap[indBuf[y*fileWidth + x]*3 + 2 ];
303        }
304        if (tkimg_PhotoPutBlock(interp, imageHandle, &block, destX, outY, width, 1, TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {
305            result = FALSE;
306            break;
307        }
308        outY++;
309    }
310    ckfree ((char *) line);
311    ckfree ((char *) buffer);
312    ckfree ((char *) indBuf);
313    return result;
314}
315
316static Boln load_24 (Tcl_Interp *interp, tkimg_MFile *ifp,
317                     Tk_PhotoHandle imageHandle, int destX, int destY,
318                     int width, int height, int srcX, int srcY,
319                     int fileWidth, int fileHeight, int bytesPerLine, int compr)
320{
321    Int x, y, c;
322    Int stopY, outY;
323    Tk_PhotoImageBlock block;
324    UByte *line, *buffer;
325    Boln result = TRUE;
326
327    line   = (UByte *) ckalloc (bytesPerLine);
328    buffer = (UByte *) ckalloc (fileWidth * 3);
329
330    block.pixelSize = 3;
331    block.pitch = fileWidth * 3;
332    block.width = width;
333    block.height = 1;
334    block.offset[0] = 0;
335    block.offset[1] = 1;
336    block.offset[2] = 2;
337    block.offset[3] = 0;
338
339    block.pixelPtr = buffer + srcX * 3;
340
341    stopY = srcY + height;
342    outY  = destY;
343
344    for (y=0; y<stopY; y++) {
345	for (c=0; c<3; c++) {
346	    if (!readline (ifp, line, bytesPerLine, compr)) {
347		ckfree ((char *) line);
348		ckfree ((char *) buffer);
349		return FALSE;
350	    }
351	    for (x=0; x<fileWidth; x++) {
352	        buffer[x * 3 + c] = line[x];
353	    }
354	}
355	if (y >= srcY) {
356	    if (tkimg_PhotoPutBlock(interp, imageHandle, &block, destX, outY, width, 1, TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {
357	    	result = FALSE;
358	    	break;
359	    }
360	    outY++;
361	}
362    }
363    ckfree ((char *) line);
364    ckfree ((char *) buffer);
365    return result;
366}
367
368static Boln load_1 (Tcl_Interp *interp, tkimg_MFile *ifp,
369                    Tk_PhotoHandle imageHandle, int destX, int destY,
370                    int width, int height, int srcX, int srcY,
371                    int fileWidth, int fileHeight, int bytesPerLine, int compr)
372{
373    Int x, y;
374    Int stopY, outY;
375    Tk_PhotoImageBlock block;
376    UByte *line, *buffer;
377    Boln result = TRUE;
378
379    line   = (UByte *) ckalloc (fileWidth);
380    buffer = (UByte *) ckalloc (fileWidth * 1);
381
382    block.pixelSize = 1;
383    block.pitch = fileWidth * 1;
384    block.width = width;
385    block.height = 1;
386    block.offset[0] = 0;
387    block.offset[1] = 0;
388    block.offset[2] = 0;
389    block.offset[3] = 0;
390
391    block.pixelPtr = buffer + srcX * 1;
392
393    stopY = srcY + height;
394    outY  = destY;
395
396    for (y=0; y<stopY; y++) {
397        if (!readline (ifp, line, bytesPerLine, compr)) {
398	    ckfree ((char *) line);
399	    ckfree ((char *) buffer);
400            return FALSE;
401        }
402        for (x=0; x<fileWidth; x++) {
403	    if (line[x/8] & (128 >> (x%8))) {
404	        buffer[x] = 255;
405	    } else {
406	        buffer[x] = 0;
407	    }
408	}
409        if (y >= srcY) {
410            if (tkimg_PhotoPutBlock(interp, imageHandle, &block, destX, outY, width, 1, TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {
411            	result = FALSE;
412            	break;
413            }
414            outY++;
415        }
416    }
417    ckfree ((char *) line);
418    ckfree ((char *) buffer);
419    return result;
420}
421
422/*
423 * Prototypes for local procedures defined in this file:
424 */
425
426static int ParseFormatOpts(Tcl_Interp *interp, Tcl_Obj *format,
427                 int *comp, int *verb, int *matte);
428static int CommonMatch(tkimg_MFile *handle, int *widthPtr,
429	         int *heightPtr, PCXHEADER *pcxHeaderPtr);
430static int CommonRead(Tcl_Interp *interp, tkimg_MFile *handle,
431	         const char *filename, Tcl_Obj *format,
432	         Tk_PhotoHandle imageHandle, int destX, int destY,
433		 int width, int height, int srcX, int srcY);
434static int CommonWrite(Tcl_Interp *interp,
435                 const char *filename, Tcl_Obj *format,
436                 tkimg_MFile *handle, Tk_PhotoImageBlock *blockPtr);
437
438static int ParseFormatOpts (interp, format, comp, verb, matte)
439    Tcl_Interp *interp;
440    Tcl_Obj *format;
441    int *comp;
442    int *verb;
443    int *matte;
444{
445    static const char *const pcxOptions[] = {"-compression", "-verbose", "-matte"};
446    int objc, length, c, i, index;
447    Tcl_Obj **objv;
448    const char *compression, *verbose, *transp;
449
450    *comp = 1;
451    *verb = 0;
452    *matte = 1;
453    if (tkimg_ListObjGetElements(interp, format, &objc, &objv) != TCL_OK)
454	return TCL_ERROR;
455    if (objc) {
456	compression = "rle";
457	verbose     = "0";
458	transp      = "1";
459	for (i=1; i<objc; i++) {
460	    if (Tcl_GetIndexFromObj(interp, objv[i], (CONST84 char *CONST86 *)pcxOptions,
461		    "format option", 0, &index) != TCL_OK) {
462		return TCL_ERROR;
463	    }
464	    if (++i >= objc) {
465		Tcl_AppendResult(interp, "No value for option \"",
466			Tcl_GetStringFromObj (objv[--i], (int *) NULL),
467			"\"", (char *) NULL);
468		return TCL_ERROR;
469	    }
470	    switch(index) {
471		case 0:
472		    compression = Tcl_GetStringFromObj(objv[i], (int *) NULL);
473		    break;
474		case 1:
475		    verbose = Tcl_GetStringFromObj(objv[i], (int *) NULL);
476		    break;
477		case 2:
478		    transp = Tcl_GetStringFromObj(objv[i], (int *) NULL);
479		    break;
480	    }
481	}
482
483	c = compression[0]; length = strlen (compression);
484	if ((c == 'n') && (!strncmp (compression, "none", length))) {
485	    *comp = 0;
486	} else if ((c == 'r') && (!strncmp (compression, "rle",length))) {
487	    *comp = 1;
488	} else {
489	    Tcl_AppendResult(interp, "invalid compression mode \"",
490		    compression, "\": should be rle or none", (char *) NULL);
491	    return TCL_ERROR;
492	}
493
494	c = verbose[0]; length = strlen (verbose);
495	if (!strncmp (verbose, "1", length) || \
496	    !strncmp (verbose, "true", length) || \
497	    !strncmp (verbose, "on", length)) {
498	    *verb = 1;
499	} else if (!strncmp (verbose, "0", length) || \
500	    !strncmp (verbose, "false", length) || \
501	    !strncmp (verbose, "off", length)) {
502	    *verb = 0;
503	} else {
504	    Tcl_AppendResult(interp, "invalid verbose mode \"", verbose,
505                              "\": should be 1 or 0, on or off, true or false",
506			      (char *) NULL);
507	    return TCL_ERROR;
508	}
509
510        c = transp[0]; length = strlen (transp);
511        if (!strncmp (transp, "1", length) || \
512            !strncmp (transp, "true", length) || \
513            !strncmp (transp, "on", length)) {
514            *matte = 1;
515        } else if (!strncmp (transp, "0", length) || \
516            !strncmp (transp, "false", length) || \
517            !strncmp (transp, "off", length)) {
518            *matte = 0;
519        } else {
520            Tcl_AppendResult(interp, "invalid alpha (matte) mode \"", verbose,
521                              "\": should be 1 or 0, on or off, true or false",
522                              (char *) NULL);
523            return TCL_ERROR;
524        }
525    }
526    return TCL_OK;
527}
528
529static int ChnMatch(
530    Tcl_Channel chan,
531    const char *filename,
532    Tcl_Obj *format,
533    int *widthPtr,
534    int *heightPtr,
535    Tcl_Interp *interp
536) {
537    tkimg_MFile handle;
538
539    handle.data = (char *) chan;
540    handle.state = IMG_CHAN;
541
542    return CommonMatch(&handle, widthPtr, heightPtr, NULL);
543}
544
545static int ObjMatch(
546    Tcl_Obj *data,
547    Tcl_Obj *format,
548    int *widthPtr,
549    int *heightPtr,
550    Tcl_Interp *interp
551) {
552    tkimg_MFile handle;
553
554    if (!tkimg_ReadInit(data, 10, &handle)) {
555	return 0;
556    }
557    return CommonMatch(&handle, widthPtr, heightPtr, NULL);
558}
559
560static int CommonMatch(handle, widthPtr, heightPtr, pcxHeaderPtr)
561    tkimg_MFile *handle;
562    int   *widthPtr;
563    int   *heightPtr;
564    PCXHEADER *pcxHeaderPtr;
565{
566    PCXHEADER ph;
567    Int offset_x, offset_y;
568
569    if (!read_pcx_header (handle, &ph))
570	return 0;
571
572    offset_x = qtohs (ph.x1);
573    offset_y = qtohs (ph.y1);
574
575    if (offset_x < 0 || offset_y < 0)
576	return 0;
577
578    *widthPtr  = qtohs (ph.x2) - offset_x + 1;
579    *heightPtr = qtohs (ph.y2) - offset_y + 1;
580
581    if (*widthPtr < 1 || *heightPtr < 1)
582	return 0;
583
584    if (pcxHeaderPtr)
585	*pcxHeaderPtr = ph;
586    return 1;
587}
588
589static int ChnRead(interp, chan, filename, format, imageHandle,
590	            destX, destY, width, height, srcX, srcY)
591    Tcl_Interp *interp;		/* Interpreter to use for reporting errors. */
592    Tcl_Channel chan;		/* The image channel, open for reading. */
593    const char *filename;	/* The name of the image file. */
594    Tcl_Obj *format;		/* User-specified format object, or NULL. */
595    Tk_PhotoHandle imageHandle;	/* The photo image to write into. */
596    int destX, destY;		/* Coordinates of top-left pixel in
597			         * photo image to be written to. */
598    int width, height;		/* Dimensions of block of photo image to
599			         * be written to. */
600    int srcX, srcY;		/* Coordinates of top-left pixel to be used
601				 * in image being read. */
602{
603    tkimg_MFile handle;
604
605    handle.data = (char *) chan;
606    handle.state = IMG_CHAN;
607
608    return CommonRead (interp, &handle, filename, format,
609		       imageHandle, destX, destY,
610		       width, height, srcX, srcY);
611}
612
613static int ObjRead (interp, data, format, imageHandle,
614	            destX, destY, width, height, srcX, srcY)
615    Tcl_Interp *interp;
616    Tcl_Obj *data;
617    Tcl_Obj *format;
618    Tk_PhotoHandle imageHandle;
619    int destX, destY;
620    int width, height;
621    int srcX, srcY;
622{
623    tkimg_MFile handle;
624
625    tkimg_ReadInit (data, 10, &handle);
626    return CommonRead (interp, &handle, "InlineData", format, imageHandle,
627		       destX, destY, width, height, srcX, srcY);
628}
629
630static int CommonRead (interp, handle, filename, format, imageHandle,
631		       destX, destY, width, height, srcX, srcY)
632    Tcl_Interp *interp;         /* Interpreter to use for reporting errors. */
633    tkimg_MFile *handle;        /* The image file, open for reading. */
634    const char *filename;       /* The name of the image file. */
635    Tcl_Obj *format;            /* User-specified format object, or NULL. */
636    Tk_PhotoHandle imageHandle; /* The photo image to write into. */
637    int destX, destY;           /* Coordinates of top-left pixel in
638				 * photo image to be written to. */
639    int width, height;          /* Dimensions of block of photo image to
640			         * be written to. */
641    int srcX, srcY;             /* Coordinates of top-left pixel to be used
642			         * in image being read. */
643{
644    int nchan;
645    int fileWidth, fileHeight;
646    int outWidth, outHeight;
647    int retCode = TCL_OK;
648    PCXHEADER ph;
649    int compr, verbose, matte;
650    char errMsg[200];
651
652    if (ParseFormatOpts(interp, format, &compr, &verbose, &matte) != TCL_OK) {
653        return TCL_ERROR;
654    }
655
656    CommonMatch(handle, &fileWidth, &fileHeight, &ph);
657    if (verbose)
658        printImgInfo (&ph, filename, "Reading image:");
659
660    if ((srcX + width) > fileWidth) {
661	outWidth = fileWidth - srcX;
662    } else {
663	outWidth = width;
664    }
665    if ((srcY + height) > fileHeight) {
666	outHeight = fileHeight - srcY;
667    } else {
668	outHeight = height;
669    }
670    if ((outWidth <= 0) || (outHeight <= 0)
671	|| (srcX >= fileWidth) || (srcY >= fileHeight)) {
672	return TCL_OK;
673    }
674
675    if (tkimg_PhotoExpand(interp, imageHandle, destX + outWidth, destY + outHeight) == TCL_ERROR) {
676	return TCL_ERROR;
677    }
678
679    if (ph.compression)
680	tkimg_ReadBuffer (1);
681
682    nchan = ph.planes;
683
684    if (ph.planes == 1 && ph.bpp == 1) {
685        if (!load_1 (interp, handle, imageHandle, destX, destY,
686                     outWidth, outHeight, srcX, srcY, fileWidth, fileHeight,
687                     qtohs (ph.bytesperline), ph.compression))
688	    retCode = TCL_ERROR;
689    } else if (ph.planes == 4 && ph.bpp == 1) {
690	Tcl_AppendResult(interp, "Format (4 channels, 1 bit per channel) ",
691                          "is not supported yet.", (char *)NULL);
692	retCode = TCL_ERROR;
693    } else if (ph.planes == 1 && ph.bpp == 8) {
694        if (!load_8 (interp, handle, imageHandle, destX, destY,
695                     outWidth, outHeight, srcX, srcY, fileWidth, fileHeight,
696                     qtohs (ph.bytesperline), ph.compression))
697	    retCode = TCL_ERROR;
698    } else if (ph.planes == 3 && ph.bpp == 8) {
699        if (!load_24 (interp, handle, imageHandle, destX, destY,
700                      outWidth, outHeight, srcX, srcY, fileWidth, fileHeight,
701                      qtohs (ph.bytesperline), ph.compression))
702	    retCode = TCL_ERROR;
703    } else {
704	sprintf(errMsg, "Image has invalid channel/bpp combination: (%d, %d)",
705			  ph.planes, ph.bpp);
706	Tcl_AppendResult(interp, errMsg, (char *)NULL);
707	retCode = TCL_ERROR;
708    }
709    tkimg_ReadBuffer (0);
710    return retCode;
711}
712
713static int ChnWrite (interp, filename, format, blockPtr)
714    Tcl_Interp *interp;
715    const char *filename;
716    Tcl_Obj *format;
717    Tk_PhotoImageBlock *blockPtr;
718{
719    Tcl_Channel chan;
720    tkimg_MFile handle;
721    int result;
722
723    chan = tkimg_OpenFileChannel (interp, filename, 0644);
724    if (!chan) {
725	return TCL_ERROR;
726    }
727
728    handle.data = (char *) chan;
729    handle.state = IMG_CHAN;
730
731    result = CommonWrite (interp, filename, format, &handle, blockPtr);
732    if (Tcl_Close(interp, chan) == TCL_ERROR) {
733	return TCL_ERROR;
734    }
735    return result;
736}
737
738static int StringWrite(
739    Tcl_Interp *interp,
740    Tcl_Obj *format,
741    Tk_PhotoImageBlock *blockPtr
742) {
743    tkimg_MFile handle;
744    int result;
745    Tcl_DString data;
746
747    Tcl_DStringInit(&data);
748    tkimg_WriteInit(&data, &handle);
749    result = CommonWrite (interp, "InlineData", format, &handle, blockPtr);
750    tkimg_Putc(IMG_DONE, &handle);
751
752    if (result == TCL_OK) {
753	Tcl_DStringResult(interp, &data);
754    } else {
755	Tcl_DStringFree(&data);
756    }
757    return result;
758}
759
760static int CommonWrite (interp, filename, format, handle, blockPtr)
761    Tcl_Interp *interp;
762    const char *filename;
763    Tcl_Obj *format;
764    tkimg_MFile *handle;
765    Tk_PhotoImageBlock *blockPtr;
766{
767    int     x, y, nchan, nBytes;
768    int     redOffset, greenOffset, blueOffset, alphaOffset;
769    UByte   *pixelPtr, *pixRowPtr;
770    PCXHEADER ph;
771    UByte *row;
772    int compr, verbose, matte; /* Format options */
773    char errMsg[200];
774
775    if (ParseFormatOpts(interp, format, &compr, &verbose, &matte) != TCL_OK) {
776        return TCL_ERROR;
777    }
778
779    redOffset   = 0;
780    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
781    blueOffset  = blockPtr->offset[2] - blockPtr->offset[0];
782    alphaOffset = blockPtr->offset[0];
783
784    if (alphaOffset < blockPtr->offset[2]) {
785        alphaOffset = blockPtr->offset[2];
786    }
787    if (++alphaOffset < blockPtr->pixelSize) {
788        alphaOffset -= blockPtr->offset[0];
789    } else {
790        alphaOffset = 0;
791    }
792
793    nchan   = 3;
794    nBytes  = blockPtr->width * nchan;
795
796    /* Fill the PCX header struct and write the header to the channel. */
797    memset (&ph, 0, sizeof (PCXHEADER));
798    ph.manufacturer = 0x0a;
799    ph.version = 5;
800    ph.compression = compr;
801    ph.bpp = 8;
802    ph.planes = 3;
803    ph.color = htoqs (1);
804    ph.bytesperline = htoqs (blockPtr->width);
805    ph.x1 = htoqs (0);
806    ph.y1 = htoqs (0);
807    ph.x2 = htoqs (blockPtr->width  - 1);
808    ph.y2 = htoqs (blockPtr->height - 1);
809
810    ph.hdpi = htoqs (300);
811    ph.vdpi = htoqs (300);
812    ph.reserved = 0;
813
814    if (tkimg_Write(handle, (const char *)&ph, 128) != 128) {
815	Tcl_AppendResult(interp, "Can't write PCX header.", (char *)NULL);
816	return TCL_ERROR;
817    }
818
819    row = (UByte *) ckalloc (nBytes);
820    /* Now write out the image data. */
821    pixRowPtr = blockPtr->pixelPtr + blockPtr->offset[0];
822    if (!compr) {
823	for (y=0; y<blockPtr->height; y++) {
824	    pixelPtr = pixRowPtr;
825	    for (x=0; x<blockPtr->width; x++) {
826		row[x + 0*blockPtr->width] = pixelPtr[redOffset];
827		row[x + 1*blockPtr->width] = pixelPtr[greenOffset];
828		row[x + 2*blockPtr->width] = pixelPtr[blueOffset];
829		pixelPtr += blockPtr->pixelSize;
830	    }
831	    if (nBytes != tkimg_Write(handle, (const char *)row, nBytes)) {
832		sprintf(errMsg, "Can't write %d bytes to image file.", nBytes);
833		Tcl_AppendResult(interp, errMsg, (char *)NULL);
834		ckfree ((char *)row);
835		return TCL_ERROR;
836	    }
837	    pixRowPtr += blockPtr->pitch;
838	}
839    } else { 			/* RLE compression */
840	for (y = 0; y < blockPtr->height; y++) {
841	    pixelPtr = pixRowPtr;
842	    for (x = 0; x < blockPtr->width; x++) {
843		row[x + 0*blockPtr->width] = pixelPtr[redOffset];
844		row[x + 1*blockPtr->width] = pixelPtr[greenOffset];
845		row[x + 2*blockPtr->width] = pixelPtr[blueOffset];
846		pixelPtr += blockPtr->pixelSize;
847	    }
848	    if (!writeline (handle, row, nBytes)) {
849		sprintf(errMsg, "Can't write %d bytes to image file.", nBytes);
850		Tcl_AppendResult(interp, errMsg, (char *)NULL);
851		ckfree ((char *)row);
852		return TCL_ERROR;
853	    }
854	    pixRowPtr += blockPtr->pitch;
855	}
856    }
857    if (verbose)
858        printImgInfo (&ph, filename, "Saving image:");
859    ckfree ((char *)row);
860    return TCL_OK;
861}
862