/* STARTHEADER
 *
 * File :       sun.c
 *
 * Author :     Paul Obermeier (paul@poSoft.de)
 *
 * Date :       2001 / 01 / 22
 *
 * Copyright :  (C) 2001-2019 Paul Obermeier
 *
 * Description :
 *
 * A photo image handler for SUN's Raster file format.
 *
 * The following image types are supported:
 *
 *  1-bit pixels: Black and White.
 *  8-bit pixels: Grayscale or indexed.
 * 24-bit pixels: True-color (RGB, each channel 8 bit).
 * 32-bit pixels: True-color with alpha channel (RGBA, each channel 8 bit).
 *
 * List of currently supported features:
 *
 * Type   |     Read      |     Write     |
 *        | -file | -data | -file | -data |
 * ----------------------------------------
 *  1-bit | Yes   | Yes   | No    | No    |
 *  8-bit | Yes   | Yes   | No    | No    |
 * 24-bit | Yes   | Yes   | Yes   | Yes   |
 * 32-bit | Yes   | Yes   | Yes   | Yes   |
 *
 * All images types may be either uncompressed or run-length encoded.
 *
 *
 * The following format options are available:
 *
 * Read  SUN image: "sun -matte <bool> -verbose <bool>"
 * Write SUN image: "sun -matte <bool> -verbose <bool> -compression <type>"
 *
 * -matte <bool>:       If set to false, a matte (alpha) channel is ignored
 *                      during reading or writing. Default is true.
 * -verbose <bool>:     If set to true, additional information about the file
 *                      format is printed to stdout. Default is false.
 * -compression <type>: Set the compression mode to either "none" or "rle".
 *                      Default is "rle".
 *
 * Notes:
 *
 * - The "UNIX" encoding of SUN's "imagetool" is not supported.
 *
 * - Part of this code was taken from the "sunras" GIMP plugin:
 *
 *  >> The GIMP -- an image manipulation program
 *  >> Copyright (C) 1995 Spencer Kimball and Peter Mattis
 *  >> SUN raster reading and writing code Copyright (C) 1996 Peter Kirchgessner
 *  >> (email: pkirchg@aol.com, WWW: http://members.aol.com/pkirchg)
 *
 * ENDHEADER
 *
 */

/*
 * Generic initialization code, parameterized via CPACKAGE and PACKAGE.
 */

#include "init.c"

/* #define DEBUG_LOCAL */

/* Some defines and typedefs. */
#define TRUE  1
#define FALSE 0
typedef unsigned char  Boln;    /* Boolean value: TRUE or FALSE */
typedef char           Byte;    /* Signed    8 bit integer */
typedef unsigned char  UByte;   /* Unsigned  8 bit integer */
typedef unsigned short UShort;  /* Unsigned 16 bit integer */
typedef int            Int;     /* Signed   32 bit integer */
typedef unsigned int   UInt;    /* Unsigned 32 bit integer */

/* SunRaster magic number */
#define RAS_MAGIC 0x59a66a95

/* Supported SunRaster types */
#define RAS_TYPE_STD 1    /* Standard uncompressed format */
#define RAS_TYPE_RLE 2    /* Runlength compression format */

/* The SunRaster header structure */
typedef struct {
    UInt ras_magic;     /* Magic Number */
    UInt ras_width;     /* Width */
    UInt ras_height;    /* Height */
    UInt ras_depth;     /* Number of bits per pixel (1,8,24,32) */
    UInt ras_length;    /* Length of image data (but may also be 0) */
    UInt ras_type;      /* Encoding */
    UInt ras_maptype;   /* Type of colormap */
    UInt ras_maplength; /* Number of bytes for colormap */
} SUNHEADER;

/* Buffer for run-length encoding and decoding. */
typedef struct {
    int val;   /* The value that is to be repeated */
    int n;     /* How many times it is repeated */
} RLEBUF;

/* Format options structure for use with ParseFormatOpts */
typedef struct {
    Int   compression;
    Boln  verbose;
    Boln  matte;
} FMTOPT;

/* Forward declarations of static functions. */

static void rle_startread (tkimg_MFile *ifp);
static int rle_fread (char *ptr, int sz, int nelem, tkimg_MFile *ifp);
static int sun_fread (char *ptr, int sz, int nelem, tkimg_MFile *ifp);
static int rle_fgetc (tkimg_MFile *ifp);
static int sun_getc (tkimg_MFile *ifp);
#define rle_getc(fp) ((rlebuf.n > 0) ? (rlebuf.n)--,rlebuf.val : rle_fgetc (fp))

static void rle_startwrite (tkimg_MFile *ofp);
static int rle_fputc (int val, tkimg_MFile *ofp);
static int rle_putrun (int n, int val, tkimg_MFile *ofp);
static void rle_endwrite (tkimg_MFile *ofp);

static Boln read_sun_header  (tkimg_MFile *ifp, SUNHEADER *sunhdr);
static Boln write_sun_header (tkimg_MFile *ofp, SUNHEADER *sunhdr);
static Boln read_sun_cols  (tkimg_MFile *ifp, SUNHEADER *sunhdr, UByte *colormap);

static RLEBUF rlebuf;

#ifdef DEBUG_LOCAL
static Boln readUByte (tkimg_MFile *handle, UByte *b)
{
    char buf[1];
    if (1 != tkimg_Read2(handle, buf, 1)) {
        return FALSE;
    }
    *b = (UByte) buf[0];
    return TRUE;
}
#else
    /* Use this macro for better performance, esp. when reading RLE files. */
#   define readUByte(h,b) (1 == tkimg_Read2((h),(char *)(b),1))
#endif

static Boln writeUByte (tkimg_MFile *handle, UByte b)
{
    UByte buf[1];
    buf[0] = b;
    if (1 != tkimg_Write2(handle, (const char *)buf, 1)) {
        return FALSE;
    }
    return TRUE;
}

static Boln readUInt (tkimg_MFile *ifp, UInt *i)
{
    UByte buf[4];
    UInt  c;

    if (4 != tkimg_Read2(ifp, (char *)buf, 4)) {
        return FALSE;
    }

    c  = (((UInt)(buf[0])) << 24);
    c |= (((UInt)(buf[1])) << 16);
    c |= (((UInt)(buf[2])) << 8);
    c |=  ((UInt)(buf[3]));
    *i = c;
    return TRUE;
}

static Boln writeUInt (tkimg_MFile *ofp, UInt c)
{
    UByte buf[4];

    buf[0] = (c >> 24) & 0xff;
    buf[1] = (c >> 16) & 0xff;
    buf[2] = (c >>  8) & 0xff;
    buf[3] = (c      ) & 0xff;
    if (4 != tkimg_Write2(ofp, (const char *)buf, 4)) {
        return FALSE;
    }
    return TRUE;
}

/* Start reading Runlength Encoded Data */
static void rle_startread (tkimg_MFile *ifp)
{
    (void) ifp;
    rlebuf.val = rlebuf.n = 0;
}

/* Read pixels from RLE-stream */
static int rle_fread (char *ptr, int sz, int nelem, tkimg_MFile *ifp)
{
    int elem_read, cnt, val, err = 0;

    for (elem_read = 0; elem_read < nelem; elem_read++) {
        for (cnt = 0; cnt < sz; cnt++) {
            val = rle_getc (ifp);
            if (val < 0) {
                err = 1;
                break;
            }
            *(ptr++) = (char)val;
        }
        if (err) {
            break;
        }
    }
    return elem_read;
}

/* Read uncompressed pixels from input stream "ifp" */
static int sun_fread (char *ptr, int sz, int nelem, tkimg_MFile *ifp)
{
    if (nelem*sz != tkimg_Read2(ifp, ptr, nelem*sz)) {
        return -1;
    }
    return nelem;
}

/* Get one pixel from RLE-stream */
static int rle_fgetc (tkimg_MFile *ifp)
{
    UByte flag, runcnt, runval;

    if (rlebuf.n > 0) {
       /* Something in the buffer ? */
       (rlebuf.n)--;
       return rlebuf.val;
    }

    /* Nothing in the buffer. We have to read something */
    if (!readUByte (ifp, &flag)) return -1;
    if (flag != 0x80)            return flag;     /* Single byte run ? */

    if (!readUByte (ifp, &runcnt)) return -1;
    if (runcnt == 0)               return (0x80); /* Single 0x80 ? */

    /* The run */
    if (!readUByte (ifp, &runval)) return -1;

    rlebuf.n = runcnt;
    rlebuf.val = runval;
    return runval;
}

/* Read one byte from input stream "ifp" */
static int sun_getc (tkimg_MFile *ifp)
{
    UByte val;
    if (!readUByte (ifp, &val)) {
        return -1;
    }
    return val;
}

/* Start writing Runlength Encoded Data */
static void rle_startwrite (tkimg_MFile *ofp)
{
    (void) ofp;
    rlebuf.val = 0;
    rlebuf.n   = 0;
}

/* Write uncompressed character to RLE-stream */
static int rle_fputc (int val, tkimg_MFile *ofp)
{
    int retval;

    if (rlebuf.n == 0) {
        /* Nothing in the buffer ? Save the value */
        rlebuf.n   = 1;
        rlebuf.val = val;
        return val;
    }

    /* Something in the buffer */
    if (rlebuf.val == val) {
        /* Same value in the buffer ? */
        rlebuf.n++;
        if (rlebuf.n == 257) {
            /* Can not be encoded in a single run ? */
            retval = rle_putrun (256, rlebuf.val, ofp);
            if (retval < 0) {
                return retval;
            }
            rlebuf.n -= 256;
        }
        return val;
    }

    /* Something different in the buffer ? Write out the run */
    retval = rle_putrun (rlebuf.n, rlebuf.val, ofp);
    if (retval < 0) {
        return retval;
    }

    /* Save the new value */
    rlebuf.n = 1;
    return (rlebuf.val = val);
}

/* Write out a run with 0 < n < 257 */
static int rle_putrun (int n, int val, tkimg_MFile *ofp)
{
    int retval = 1;
    int flag   = 0x80;

    /* Useful to write a 3 byte run ? */
    if ((n > 2) || ((n == 2) && (val == flag))) {
        if (!writeUByte (ofp, flag) ||
            !writeUByte (ofp, n-1) ||
            !writeUByte (ofp, val)) {
            retval = -1;
        }
    } else if (n == 2) {
        /* Write two single runs (could not be value 0x80) */
        if (!writeUByte (ofp, val) || !writeUByte (ofp, val)) {
            retval = -1;
        }
    } else {
        /* Write a single run */
        if (val == flag) {
            if (!writeUByte (ofp, flag) || !writeUByte (ofp, 0)) {
                retval = -1;
            }
        } else {
            if (!writeUByte (ofp, val)) {
                retval = -1;
            }
        }
    }

    return ((retval < 0) ? retval : val);
}

/* End writing Runlength Encoded Data */
static void rle_endwrite (tkimg_MFile *ofp)
{
    if (rlebuf.n > 0) {
        rle_putrun (rlebuf.n, rlebuf.val, ofp);
        rlebuf.val = rlebuf.n = 0;      /* Clear RLE-buffer */
    }
}

#define OUT Tcl_WriteChars (outChan, str, -1)
static void printImgInfo (SUNHEADER *sh, const char *filename, const char *msg)
{
    Tcl_Channel outChan;
    char str[256];
    UInt type = sh->ras_type;

    outChan = Tcl_GetStdChannel (TCL_STDOUT);
    if (!outChan) {
        return;
    }

    sprintf(str, "%s %s\n", msg, filename);                                       OUT;
    sprintf(str, "\tSize in pixel   : %d x %d\n", sh->ras_width, sh->ras_height); OUT;
    sprintf(str, "\tDepth of pixels : %d\n", sh->ras_depth);                      OUT;
    sprintf(str, "\tCompression     : %s\n", (type == RAS_TYPE_STD? "None":
                                              (type == RAS_TYPE_RLE? "RLE":
                                                                     "Unknown"))); OUT;
    sprintf(str, "\tColormap type   : %d\n", sh->ras_maptype);                    OUT;
    Tcl_Flush(outChan);
}
#undef OUT

static Boln read_sun_header (tkimg_MFile *ifp, SUNHEADER *sunhdr)
{
    int  i;
    UInt *cp;

    cp = (UInt *)sunhdr;

    /* Read in all 32-bit values of the header and check for byte order */
    for (i=0; i<sizeof(SUNHEADER) / sizeof(sunhdr->ras_magic); i++) {
        if (!readUInt (ifp, cp)) {
            return FALSE;
        }
        cp++;
    }
    if (sunhdr->ras_magic != RAS_MAGIC) {
        return FALSE;
    }
    return TRUE;
}

/* Write out a SUN-fileheader */
static Boln write_sun_header (tkimg_MFile *ofp, SUNHEADER *sunhdr)
{
    int i, hdr_entries;
    UInt *cp;

    cp = (UInt *)sunhdr;

    hdr_entries = sizeof (SUNHEADER)/sizeof(sunhdr->ras_magic);
    /* Write out all 32-bit values of the header and check for byte order */
    for (i=0; i<hdr_entries; i++) {
        if (!writeUInt (ofp, *(cp++))) {
            return FALSE;
        }
    }
    return TRUE;
}

/* Read the sun colourmap */
static Boln read_sun_cols (tkimg_MFile *ifp, SUNHEADER *sunhdr, UByte *colormap)
{
    int ncols;

    /* Read in SUN-raster Colormap */
    ncols = sunhdr->ras_maplength / 3;
    if (ncols <= 0)
        return FALSE;

    if (3*ncols != tkimg_Read2(ifp, (char *)colormap, 3*ncols)) {
        return FALSE;
    }
    return TRUE;
}

/* Load SUN Raster file with depth 1 */
static Boln load_sun_d1 (Tcl_Interp *interp, tkimg_MFile *ifp,
                         Tk_PhotoHandle imageHandle, int destX, int destY,
                         int width, int height, int srcX, int srcY,
                         int fileWidth, int fileHeight, int type)
{
    UByte *dest, bit2byte[256*8];
    UByte *pixbuf;
    Tk_PhotoImageBlock block;
    int pix8;
    int linepad;
    int x, y;
    int stopY, outY;
    int i, j;
    int err = 0, rle;
    char errMsg[200];
    Boln result = TRUE;

    pixbuf = (UByte *) ckalloc (fileWidth);
    if (!pixbuf) {
        sprintf(errMsg, "Can't allocate memory of size %d", fileWidth);
        Tcl_AppendResult(interp, errMsg, (char *)NULL);
        return TCL_ERROR;
    }

    block.pixelSize = 1;
    block.pitch     = fileWidth;
    block.width     = width;
    block.height    = 1;
    block.offset[0] = 0;
    block.offset[1] = 0;
    block.offset[2] = 0;
    block.offset[3] = 0;
    block.pixelPtr  = pixbuf + srcX;

    rle = (type == RAS_TYPE_RLE);
    linepad = ((fileWidth+7)/8) % 2;    /* Check for 16bit align */

    if (rle) {
        rle_startread (ifp);
    }

    /* Get an array for mapping 8 bits in a byte to 8 bytes */
    dest = bit2byte;
    for (j=0; j<256; j++) {
        for (i=7; i>=0; i--) {
            *(dest++) = ((j & (1 << i)) == 0) * 255;
        }
    }

    stopY = srcY + height;
    outY = destY;

    for (y=0; y<stopY; y++) {
        dest = pixbuf;
        x = fileWidth;
        while (x >= 8) {
            pix8 = rle ? rle_getc (ifp) : sun_getc (ifp);
            if (pix8 < 0) {
                err = 1;
                pix8 = 0;
            }

            memcpy (dest, bit2byte + pix8*8, 8);
            dest += 8;
            x -= 8;
        }

        if (x>0) {
            pix8 = rle ? rle_getc (ifp) : sun_getc (ifp);
            if (pix8 < 0) {
                err = 1;
                pix8 = 0;
            }

            memcpy (dest, bit2byte + pix8*8, x);
            dest += x;
        }

        if (linepad) {
            err |= ((rle ? rle_getc (ifp) : sun_getc (ifp)) < 0);
        }

        if (err) {
            sprintf(errMsg, "Unexpected EOF while reading scanline %d", y);
            Tcl_AppendResult(interp, errMsg, (char *) NULL);
            return FALSE;
        }
        if (y >= srcY) {
            if (tkimg_PhotoPutBlock(interp, imageHandle, &block, destX, outY, width, 1,
                TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {
                result = FALSE;
                break;
            }
            outY++;
        }
    }
    return result;
}

/* Load SUN Raster file with depth 8 */
static Boln load_sun_d8 (Tcl_Interp *interp, tkimg_MFile *ifp,
                         Tk_PhotoHandle imageHandle, int destX, int destY,
                         int width, int height, int srcX, int srcY,
                         int fileWidth, int fileHeight,
                         int type, UByte *suncolmap, int maplength)
{
    UByte *dest, *indData = NULL, *src;
    UByte *pixbuf = NULL;
    Tk_PhotoImageBlock block;
    int linepad;
    int x, y;
    int stopY, outY;
    int ncols;
    int greyscale, nchan;
    int err, rle;
    char errMsg[200];
    Boln result = TRUE;

    rle     = (type == RAS_TYPE_RLE);
    linepad = fileWidth % 2;
    ncols   = maplength / 3;

    /* Check, if it's a greyscale or color indexed image. */
    greyscale = 1;
    nchan     = 1;
    if ((ncols > 0) && (suncolmap != NULL)) {
        greyscale = 0;
        nchan     = 3;
    }

    if (!greyscale) {
        pixbuf = (UByte *) ckalloc (fileWidth * nchan);
        if (!pixbuf) {
            sprintf(errMsg, "Can't allocate memory of size %d",
                              fileWidth * nchan);
            Tcl_AppendResult(interp, errMsg, (char *)NULL);
            if (suncolmap) {
                ckfree ((char *)suncolmap);
            }
            return TCL_ERROR;
        }
    }

    /* This buffer contains either the color indices or the greyscale value. */
    indData = (UByte *)ckalloc (fileWidth * sizeof (UByte));
    if (!indData) {
        sprintf(errMsg, "Can't allocate memory of size %d",
                          (int) (fileWidth * sizeof (UByte)));
        Tcl_AppendResult(interp, errMsg, (char *)NULL);
        return TCL_ERROR;
    }

    block.pixelSize = nchan;
    block.pitch     = fileWidth * nchan;
    block.width     = width;
    block.height    = 1;
    block.offset[0] = 0;
    block.offset[1] = greyscale? 0: 1;
    block.offset[2] = greyscale? 0: 2;
    block.offset[3] = 0;
    block.pixelPtr  = (greyscale?
                      (indData + srcX * nchan):
                      (pixbuf + srcX * nchan));

    if (rle) {
        rle_startread (ifp);  /* Initialize RLE-buffer */
    }

    stopY = srcY + height;
    outY = destY;

    for (y=0; y<stopY; y++) {
        src  = indData;
        memset ((char *)src, 0, fileWidth);
        err = ((rle ? rle_fread ((char *)src, 1, fileWidth, ifp) :
                      sun_fread ((char *)src, 1, fileWidth, ifp)) != fileWidth);
        if (err && (y != height -1)) {
            sprintf(errMsg, "Unexpected EOF while reading scanline %d", y);
            Tcl_AppendResult(interp, errMsg, (char *) NULL);
            ckfree ((char *)indData);
            return FALSE;
        }
        if (linepad) {
            err = ((rle ? rle_getc (ifp) : sun_getc (ifp)) < 0);
            if (err) {
                sprintf(errMsg, "Unexpected EOF while reading scanline %d", y);
                Tcl_AppendResult(interp, errMsg, (char *) NULL);
                ckfree ((char *)indData);
                return FALSE;
            }
        }

        if (!greyscale) {
            src  = indData;
            dest = pixbuf;
            for (x=0; x<width; x++) {
                *dest++ = suncolmap[*src];
                *dest++ = suncolmap[*src + ncols];
                *dest++ = suncolmap[*src + 2*ncols];
                src++;
            }
        }

        if (y >= srcY) {
            if (tkimg_PhotoPutBlock(interp, imageHandle, &block, destX, outY, width, 1,
                TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {
                result = FALSE;
                break;
            }
            outY++;
        }
    }
    ckfree ((char *)indData);
    return result;
}

/* Load SUN Raster file with true color image: depth = 24 or 32 */

static Boln load_rgb (Tcl_Interp *interp, tkimg_MFile *ifp,
                      Tk_PhotoHandle imageHandle, int destX, int destY,
                      int width, int height, int srcX, int srcY,
                      int fileWidth, int fileHeight,
                      int nchan, int type, int showMatte)
{
    UByte *dest, tmp;
    UByte *pixbuf;
    Tk_PhotoImageBlock block;
    int linepad;
    int x, y;
    int stopY, outY;
    int err, rle;
    char errMsg[200];
    Boln result = TRUE;

    pixbuf = (UByte *) ckalloc (fileWidth * nchan);
    if (!pixbuf) {
        sprintf(errMsg, "Can't allocate memory of size %d",
                          fileWidth * nchan);
        Tcl_AppendResult(interp, errMsg, (char *)NULL);
        return TCL_ERROR;
    }

    block.pixelSize = nchan;
    block.pitch = fileWidth * nchan;
    block.width = width;
    block.height = 1;
    block.offset[0] = 0;
    block.offset[1] = 1;
    block.offset[2] = 2;
    if (nchan < 4) {
        showMatte = 0;
    }
    block.offset[3] = showMatte? 3: 0;

    block.pixelPtr = pixbuf + srcX * nchan;

    rle     = (type == RAS_TYPE_RLE);
    linepad = (fileWidth*nchan) % 2;

    if (rle) {
        rle_startread (ifp);    /* Initialize RLE-buffer */
    }

    stopY = srcY + height;
    outY  = destY;

    for (y=0; y<stopY; y++) {
        dest = pixbuf;
        memset ((char *)dest, 0, nchan*fileWidth);
        err = ((rle ? rle_fread ((char *)dest, nchan, fileWidth, ifp) :
                      sun_fread ((char *)dest, nchan, fileWidth, ifp)) != fileWidth);
        if (err && (y != height -1)) {
            sprintf(errMsg, "Unexpected EOF while reading scanline %d", y);
            Tcl_AppendResult(interp, errMsg, (char *) NULL);
            ckfree ((char *)pixbuf);
            return FALSE;
        }
        if (linepad) {
            err = ((rle ? rle_getc (ifp) : sun_getc (ifp)) < 0);
            if (err) {
                sprintf(errMsg, "Unexpected EOF while reading scanline %d", y);
                Tcl_AppendResult(interp, errMsg, (char *) NULL);
                ckfree ((char *)pixbuf);
                return FALSE;
            }
        }

        if (y >= srcY) {
            dest = pixbuf + srcX * nchan;
            if (type != 3) {
                if (nchan == 3) {               /* GBR Format. Swap to RGB. */
                    for (x=0; x<width; x++) {
                        tmp = dest[0];
                        dest[0] = dest[2];
                        dest[2] = tmp;

                        dest += 3;
                    }
                } else {                        /* AGBR Format. Swap to RGBA. */
                    for (x=0; x<width; x++) {
                        tmp = dest[0];
                        dest[0] = dest[3];
                        dest[3] = tmp;

                        tmp = dest[1];
                        dest[1] = dest[2];
                        dest[2] = tmp;

                        dest += 4;
                    }
                }
            }
            if (tkimg_PhotoPutBlock(interp, imageHandle, &block, destX, outY, width, 1,
                showMatte? TK_PHOTO_COMPOSITE_OVERLAY: TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {
                result = FALSE;
                break;
            }
            outY++;
        }
    }
    ckfree ((char *)pixbuf);
    return result;
}

/*
 * Here is the start of the standard functions needed for every image format.
 */

/*
 * Prototypes for local procedures defined in this file:
 */

static int ParseFormatOpts(Tcl_Interp *interp, Tcl_Obj *format, FMTOPT *opts);
static int CommonMatch(tkimg_MFile *handle, int *widthPtr,
        int *heightPtr, SUNHEADER *sunHeaderPtr);
static int CommonRead(Tcl_Interp *interp, tkimg_MFile *handle,
        const char *filename, Tcl_Obj *format,
        Tk_PhotoHandle imageHandle, int destX, int destY,
        int width, int height, int srcX, int srcY);
static int CommonWrite(Tcl_Interp *interp,
        const char *filename, Tcl_Obj *format,
        tkimg_MFile *handle, Tk_PhotoImageBlock *blockPtr);

static int ParseFormatOpts (interp, format, opts)
    Tcl_Interp *interp;
    Tcl_Obj *format;
    FMTOPT *opts;
{
    static const char *const sunOptions[] = {
        "-compression", "-verbose", "-matte", NULL
    };
    int objc, i, index;
    char *optionStr;
    Tcl_Obj **objv;
    int boolVal;

    /* Initialize options with default values. */
    opts->compression = 1;
    opts->verbose     = 0;
    opts->matte       = 1;

    if (tkimg_ListObjGetElements(interp, format, &objc, &objv) != TCL_OK) {
        return TCL_ERROR;
    }
    if (objc) {
        for (i=1; i<objc; i++) {
            if (Tcl_GetIndexFromObj(interp, objv[i], (const char *CONST86 *)sunOptions,
                    "format option", 0, &index) != TCL_OK) {
                return TCL_ERROR;
            }
            if (++i >= objc) {
                Tcl_AppendResult(interp, "No value for option \"",
                        Tcl_GetStringFromObj (objv[--i], (int *) NULL),
                        "\"", (char *) NULL);
                return TCL_ERROR;
            }
            optionStr = Tcl_GetStringFromObj(objv[i], (int *) NULL);
            switch(index) {
                case 0:
                    if (!strncmp (optionStr, "none", strlen ("none"))) {
                        opts->compression = 0;
                    } else if (!strncmp (optionStr, "rle", strlen ("rle"))) {
                        opts->compression = 1;
                    } else {
                        Tcl_AppendResult (interp, "Invalid compression mode \"", optionStr,
                                          "\": Must be \"none\" or \"rle\"", (char *) NULL);
                        return TCL_ERROR;
                    }
                    break;
                case 1:
                    if (Tcl_GetBoolean(interp, optionStr, &boolVal) == TCL_ERROR) {
                        Tcl_AppendResult (interp, "Invalid verbose mode \"", optionStr,
                                          "\": should be 1 or 0, on or off, true or false",
                                          (char *) NULL);
                        return TCL_ERROR;
                    }
                    opts->verbose = boolVal;
                    break;
                case 2:
                    if (Tcl_GetBoolean(interp, optionStr, &boolVal) == TCL_ERROR) {
                        Tcl_AppendResult (interp, "Invalid matte mode \"", optionStr,
                                          "\": should be 1 or 0, on or off, true or false",
                                          (char *) NULL);
                        return TCL_ERROR;
                    }
                    opts->matte = boolVal;
                    break;
            }
        }
    }
    return TCL_OK;
}

static int ChnMatch(
    Tcl_Channel chan,
    const char *filename,
    Tcl_Obj *format,
    int *widthPtr,
    int *heightPtr,
    Tcl_Interp *interp
) {
    tkimg_MFile handle;

#ifdef DEBUG_LOCAL
    printf("ChnMatch\n"); fflush(stdout);
#endif

    handle.data = (char *) chan;
    handle.state = IMG_CHAN;

    return CommonMatch(&handle, widthPtr, heightPtr, NULL);
}

static int ObjMatch(
    Tcl_Obj *data,
    Tcl_Obj *format,
    int *widthPtr,
    int *heightPtr,
    Tcl_Interp *interp
) {
    tkimg_MFile handle;

#ifdef DEBUG_LOCAL
    printf("ObjMatch\n"); fflush(stdout);
#endif

    if (!tkimg_ReadInit(data, 'Y', &handle)) {
        return 0;
    }
    return CommonMatch(&handle, widthPtr, heightPtr, NULL);
}

static int CommonMatch(handle, widthPtr, heightPtr, sunHeaderPtr)
    tkimg_MFile *handle;
    int   *widthPtr;
    int   *heightPtr;
    SUNHEADER *sunHeaderPtr;
{
    SUNHEADER sh;

    if (!read_sun_header (handle, &sh)) {
        return 0;
    }

    *widthPtr  = sh.ras_width;
    *heightPtr = sh.ras_height;
    if (sunHeaderPtr) {
        *sunHeaderPtr = sh;
    }
    return 1;
}

static int ChnRead(interp, chan, filename, format, imageHandle,
                   destX, destY, width, height, srcX, srcY)
    Tcl_Interp *interp;         /* Interpreter to use for reporting errors. */
    Tcl_Channel chan;           /* The image channel, open for reading. */
    const char *filename;       /* The name of the image file. */
    Tcl_Obj *format;            /* User-specified format object, or NULL. */
    Tk_PhotoHandle imageHandle; /* The photo image to write into. */
    int destX, destY;           /* Coordinates of top-left pixel in
                                 * photo image to be written to. */
    int width, height;          /* Dimensions of block of photo image to
                                 * be written to. */
    int srcX, srcY;             /* Coordinates of top-left pixel to be used
                                 * in image being read. */
{
    tkimg_MFile handle;

    handle.data = (char *) chan;
    handle.state = IMG_CHAN;

    return CommonRead (interp, &handle, filename, format,
                       imageHandle, destX, destY,
                       width, height, srcX, srcY);
}

static int ObjRead (interp, data, format, imageHandle,
                    destX, destY, width, height, srcX, srcY)
    Tcl_Interp *interp;
    Tcl_Obj *data;
    Tcl_Obj *format;
    Tk_PhotoHandle imageHandle;
    int destX, destY;
    int width, height;
    int srcX, srcY;
{
    tkimg_MFile handle;

    tkimg_ReadInit (data, 'Y', &handle);
    return CommonRead (interp, &handle, "InlineData", format, imageHandle,
                       destX, destY, width, height, srcX, srcY);
}

static int CommonRead (interp, handle, filename, format, imageHandle,
                       destX, destY, width, height, srcX, srcY)
    Tcl_Interp *interp;         /* Interpreter to use for reporting errors. */
    tkimg_MFile *handle;        /* The image file, open for reading. */
    const char *filename;       /* The name of the image file. */
    Tcl_Obj *format;            /* User-specified format object, or NULL. */
    Tk_PhotoHandle imageHandle; /* The photo image to write into. */
    int destX, destY;           /* Coordinates of top-left pixel in
                                 * photo image to be written to. */
    int width, height;          /* Dimensions of block of photo image to
                                 * be written to. */
    int srcX, srcY;             /* Coordinates of top-left pixel to be used
                                 * in image being read. */
{
    int nchan;
    int fileWidth, fileHeight;
    int outWidth, outHeight;
    int retCode = TCL_OK;
    SUNHEADER sh;
    FMTOPT opts;
    UByte *suncolmap = NULL;
    char errMsg[200];

    if (ParseFormatOpts(interp, format, &opts) != TCL_OK) {
        return TCL_ERROR;
    }

    if (!CommonMatch(handle, &fileWidth, &fileHeight, &sh)) {
        if (interp) {
            Tcl_AppendResult(interp, "Cannot read image data",
                (char *) NULL);
        }
        return TCL_ERROR;
    }
    if (opts.verbose) {
        printImgInfo (&sh, filename, "Reading image:");
    }

    if ((srcX + width) > fileWidth) {
        outWidth = fileWidth - srcX;
    } else {
        outWidth = width;
    }
    if ((srcY + height) > fileHeight) {
        outHeight = fileHeight - srcY;
    } else {
        outHeight = height;
    }
    if ((outWidth <= 0) || (outHeight <= 0)
        || (srcX >= fileWidth) || (srcY >= fileHeight)) {
        return TCL_OK;
    }

    if (sh.ras_type > 5) {
        sprintf(errMsg, "Unknown Sun Raster type: %d", sh.ras_type);
        Tcl_AppendResult(interp, errMsg, (char *)NULL);
        return TCL_ERROR;
    }

    if (sh.ras_type == RAS_TYPE_RLE) {
        tkimg_ReadBuffer (1);
    }

    /* Is there a RGB colourmap ? */
    if ((sh.ras_maptype == 1) && (sh.ras_maplength > 0)) {
        suncolmap = (UByte *)ckalloc (sh.ras_maplength);
        if (!suncolmap) {
            sprintf(errMsg, "Can't allocate memory of size %d",
                              sh.ras_maplength);
            Tcl_AppendResult(interp, errMsg, (char *)NULL);
            tkimg_ReadBuffer (0);
            return TCL_ERROR;
        }

        if (!read_sun_cols (handle, &sh, suncolmap)) {
            Tcl_AppendResult(interp, "Unable to read color map", (char *)NULL);
            ckfree ((char *)suncolmap);
            tkimg_ReadBuffer (0);
            return TCL_ERROR;
        }
#ifdef DEBUG_LOCAL
        {
            int j, ncols;
            printf("Colormap values:\n");
            ncols = sh.ras_maplength/3;
            for (j=0; j < ncols; j++) {
                printf("Entry 0x%08x: 0x%04x,  0x%04x, 0x%04x\n",
                       j,suncolmap[j],suncolmap[j+ncols],suncolmap[j+2*ncols]);
            }
        }
#endif
    } else if (sh.ras_maplength > 0) {
        UByte dummy[1];
        int d, length;

        /* This type of colourmap is not supported. Ignore it. */
        length = (sizeof (SUNHEADER)/sizeof (UInt)) * 4 + sh.ras_maplength;
        for (d=0; d<length; d++) {
            (void) readUByte (handle, dummy);
        }
    }

    if (tkimg_PhotoExpand(interp, imageHandle, destX + outWidth, destY + outHeight) == TCL_ERROR) {
        if (suncolmap) {
            ckfree ((char *)suncolmap);
        }
        tkimg_ReadBuffer(0);
        return TCL_ERROR;
    }

    nchan = (sh.ras_depth == 32? 4: 3);

    switch (sh.ras_depth) {
        case 1:    /* 2 colors B/W */
            if (!load_sun_d1 (interp, handle, imageHandle, destX, destY,
                              outWidth, outHeight, srcX, srcY,
                              fileWidth, fileHeight, sh.ras_type))
                retCode = TCL_ERROR;
            break;

        case 8:    /* 256 colours */
            if (!load_sun_d8 (interp, handle, imageHandle, destX, destY,
                              outWidth, outHeight, srcX, srcY,
                              fileWidth, fileHeight, sh.ras_type,
                              suncolmap, sh.ras_maplength))
                retCode = TCL_ERROR;
            break;

        case 24:   /* True color */
        case 32:   /* True color with matte channel */
            if (!load_rgb (interp, handle, imageHandle, destX, destY,
                           outWidth, outHeight, srcX, srcY,
                           fileWidth, fileHeight,
                           nchan, sh.ras_type, opts.matte))
                retCode = TCL_ERROR;
            break;

        default:
            sprintf(errMsg, "Image has invalid pixel depth: %d", sh.ras_depth);
            Tcl_AppendResult(interp, errMsg, (char *)NULL);
            retCode = TCL_ERROR;
            break;
    }
    if (suncolmap) {
        ckfree ((char *)suncolmap);
    }
    tkimg_ReadBuffer (0);
    return retCode;
}

static int ChnWrite (interp, filename, format, blockPtr)
    Tcl_Interp *interp;
    const char *filename;
    Tcl_Obj *format;
    Tk_PhotoImageBlock *blockPtr;
{
    Tcl_Channel chan;
    tkimg_MFile handle;
    int result;

    chan = tkimg_OpenFileChannel (interp, filename, 0644);
    if (!chan) {
        return TCL_ERROR;
    }

    handle.data = (char *) chan;
    handle.state = IMG_CHAN;

    result = CommonWrite (interp, filename, format, &handle, blockPtr);
    if (Tcl_Close(interp, chan) == TCL_ERROR) {
        return TCL_ERROR;
    }
    return result;
}

static int StringWrite(
    Tcl_Interp *interp,
    Tcl_Obj *format,
    Tk_PhotoImageBlock *blockPtr
) {
    tkimg_MFile handle;
    int result;
    Tcl_DString data;

    Tcl_DStringInit(&data);
    tkimg_WriteInit(&data, &handle);
    result = CommonWrite(interp, "InlineData", format, &handle, blockPtr);
    tkimg_Putc(IMG_DONE, &handle);

    if (result == TCL_OK) {
        Tcl_DStringResult(interp, &data);
    } else {
        Tcl_DStringFree(&data);
    }
    return result;
}

static int CommonWrite (interp, filename, format, handle, blockPtr)
    Tcl_Interp *interp;
    const char *filename;
    Tcl_Obj *format;
    tkimg_MFile *handle;
    Tk_PhotoImageBlock *blockPtr;
{
    int     x, y, nchan, nBytes, linepad;
    int     redOffset, greenOffset, blueOffset, alphaOffset;
    UByte   *pixelPtr, *pixRowPtr;
    SUNHEADER sh;
    FMTOPT opts;
    UByte *row, *rowPtr;
    char errMsg[200];

    if (ParseFormatOpts(interp, format, &opts) != TCL_OK) {
        return TCL_ERROR;
    }

    redOffset   = 0;
    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
    blueOffset  = blockPtr->offset[2] - blockPtr->offset[0];
    alphaOffset = blockPtr->offset[0];

    if (alphaOffset < blockPtr->offset[2]) {
        alphaOffset = blockPtr->offset[2];
    }
    if (++alphaOffset < blockPtr->pixelSize) {
        alphaOffset -= blockPtr->offset[0];
    } else {
        alphaOffset = 0;
    }

    nchan   = ((opts.matte && alphaOffset)? 4: 3);
    nBytes  = blockPtr->width * nchan;
    linepad = nBytes % 2;

    /* Fill the Sun header struct and write the header to the channel. */
    sh.ras_magic     = RAS_MAGIC;
    sh.ras_width     = blockPtr->width;
    sh.ras_height    = blockPtr->height;
    sh.ras_depth     = 8 * nchan;
    sh.ras_length    = (nBytes + linepad) * blockPtr->height;
    sh.ras_type      = (opts.compression) ? RAS_TYPE_RLE : RAS_TYPE_STD;
    sh.ras_maptype   = 0;               /* No colourmap */
    sh.ras_maplength = 0;               /* Length of colourmap */

    write_sun_header (handle, &sh);

    /* Now write out the image data. */
    pixRowPtr = blockPtr->pixelPtr + blockPtr->offset[0];
    if (!opts.compression) {
        row = (UByte *) ckalloc (nBytes);
        if (!row) {
            sprintf(errMsg, "Can't allocate memory of size %d", nBytes);
            Tcl_AppendResult(interp, errMsg, (char *)NULL);
            return TCL_ERROR;
        }
        for (y=0; y<blockPtr->height; y++) {
            rowPtr = row;
            pixelPtr = pixRowPtr;
            for (x=0; x<blockPtr->width; x++) {
                if (nchan == 4) {
                    /* Have a matte channel and write it. */
                    *(rowPtr++) = pixelPtr[alphaOffset];
                }
                *(rowPtr++) = pixelPtr[blueOffset];
                *(rowPtr++) = pixelPtr[greenOffset];
                *(rowPtr++) = pixelPtr[redOffset];
                pixelPtr += blockPtr->pixelSize;
            }
            if (nBytes != tkimg_Write2(handle, (const char *)row, nBytes)) {
                sprintf(errMsg, "Can't write %d bytes to image file", nBytes);
                Tcl_AppendResult(interp, errMsg, (char *)NULL);
                ckfree ((char *)row);
                return TCL_ERROR;
            }
            for (x=0; x<linepad; x++) {
                writeUByte (handle, 0);
            }
            pixRowPtr += blockPtr->pitch;
        }
        ckfree ((char *)row);
    } else {                    /* RLE compression */
        rle_startwrite (handle);
        for (y = 0; y < blockPtr->height; y++) {
            pixelPtr = pixRowPtr;
            for (x = 0; x < blockPtr->width; x++) {
                if (nchan == 4) {
                    /* Have a matte channel and write it. */
                    rle_fputc (pixelPtr[alphaOffset], handle);
                }
                rle_fputc (pixelPtr[blueOffset], handle);
                rle_fputc (pixelPtr[greenOffset], handle);
                rle_fputc (pixelPtr[redOffset], handle);
                pixelPtr += blockPtr->pixelSize;
            }
            for (x=0; x<linepad; x++) {
                rle_fputc (0, handle);
            }
            pixRowPtr += blockPtr->pitch;
        }
        rle_endwrite (handle);
    }
    if (opts.verbose) {
        printImgInfo (&sh, filename, "Saving image:");
    }
    return TCL_OK;
}