tk/generic/tkImgGIF.c

   1 /*
   2  * tkImgGIF.c --
   3  *
   4  *      A photo image file handler for GIF files. Reads 87a and 89a GIF
   5  *      files. At present, there only is a file write function. GIF images
   6  *      may be read using the -data option of the photo image.  The data may be
   7  *      given as a binary string in a Tcl_Obj or by representing
   8  *      the data as BASE64 encoded ascii.  Derived from the giftoppm code
   9  *      found in the pbmplus package and tkImgFmtPPM.c in the tk4.0b2
  10  *      distribution.
  11  *
  12  * Copyright (c) Reed Wade (wade@cs.utk.edu), University of Tennessee
  13  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  14  * Copyright (c) 1997 Australian National University
  15  *
  16  * See the file "license.terms" for information on usage and redistribution
  17  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  18  *
  19  * This file also contains code from the giftoppm program, which is
  20  * copyrighted as follows:
  21  *
  22  * +--------------------------------------------------------------------+
  23  * | Copyright 1990, David Koblas.                                      |
  24  * |   Permission to use, copy, modify, and distribute this software    |
  25  * |   and its documentation for any purpose and without fee is hereby  |
  26  * |   granted, provided that the above copyright notice appear in all  |
  27  * |   copies and that both that copyright notice and this permission   |
  28  * |   notice appear in supporting documentation.  This software is     |
  29  * |   provided "as is" without express or implied warranty.            |
  30  * +-------------------------------------------------------------------+
  31  *
  32  * RCS: @(#) $Id$
  33  */
  34
  35 /*
  36  * GIF's are represented as data in base64 format.
  37  * base64 strings consist of 4 6-bit characters -> 3 8 bit bytes.
  38  * A-Z, a-z, 0-9, + and / represent the 64 values (in order).
  39  * '=' is a trailing padding char when the un-encoded data is not a
  40  * multiple of 3 bytes.  We'll ignore white space when encountered.
  41  * Any other invalid character is treated as an EOF
  42  */
  43
  44 #define GIF_SPECIAL     (256)
  45 #define GIF_PAD         (GIF_SPECIAL+1)
  46 #define GIF_SPACE       (GIF_SPECIAL+2)
  47 #define GIF_BAD         (GIF_SPECIAL+3)
  48 #define GIF_DONE        (GIF_SPECIAL+4)
  49
  50 /*
  51  * structure to "mimic" FILE for Mread, so we can look like fread.
  52  * The decoder state keeps track of which byte we are about to read,
  53  * or EOF.
  54  */
  55
  56 typedef struct mFile {
  57     unsigned char *data;        /* mmencoded source string */
  58     int c;                      /* bits left over from previous character */
  59     int state;                  /* decoder state (0-4 or GIF_DONE) */
  60 } MFile;
  61
  62 #include "tkInt.h"
  63 #include "tkPort.h"
  64
  65 /*
  66  * Non-ASCII encoding support:
  67  * Most data in a GIF image is binary and is treated as such.  However,
  68  * a few key bits are stashed in ASCII.  If we try to compare those pieces
  69  * to the char they represent, it will fail on any non-ASCII (eg, EBCDIC)
  70  * system.  To accomodate these systems, we test against the numeric value
  71  * of the ASCII characters instead of the characters themselves.  This is
  72  * encoding independant.
  73  */
  74
  75 static CONST char GIF87a[] = {                  /* ASCII GIF87a */
  76     0x47, 0x49, 0x46, 0x38, 0x37, 0x61, 0x00
  77 };
  78 static CONST char GIF89a[] = {                  /* ASCII GIF89a */
  79     0x47, 0x49, 0x46, 0x38, 0x39, 0x61, 0x00
  80 };
  81 #  define GIF_TERMINATOR 0x3b                   /* ASCII ; */
  82 #  define GIF_EXTENSION  0x21                   /* ASCII ! */
  83 #  define GIF_START      0x2c                   /* ASCII , */
  84
  85 /*
  86  *                       HACK ALERT!!  HACK ALERT!!  HACK ALERT!!
  87  * This code is hard-wired for reading from files.  In order to read
  88  * from a data stream, we'll trick fread so we can reuse the same code.
  89  * 0==from file; 1==from base64 encoded data; 2==from binary data
  90  */
  91
  92 typedef struct ThreadSpecificData {
  93     int fromData;
  94 } ThreadSpecificData;
  95 static Tcl_ThreadDataKey dataKey;
  96
  97 /*
  98  * The format record for the GIF file format:
  99  */
 100
 101 static int      FileMatchGIF _ANSI_ARGS_((Tcl_Channel chan, CONST char *fileName,
 102                     Tcl_Obj *format, int *widthPtr, int *heightPtr,
 103                     Tcl_Interp *interp));
 104 static int      FileReadGIF  _ANSI_ARGS_((Tcl_Interp *interp,
 105                     Tcl_Channel chan, CONST char *fileName, Tcl_Obj *format,
 106                     Tk_PhotoHandle imageHandle, int destX, int destY,
 107                     int width, int height, int srcX, int srcY));
 108 static int      StringMatchGIF _ANSI_ARGS_(( Tcl_Obj *dataObj,
 109                     Tcl_Obj *format, int *widthPtr, int *heightPtr,
 110                     Tcl_Interp *interp));
 111 static int      StringReadGIF _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *dataObj,
 112                     Tcl_Obj *format, Tk_PhotoHandle imageHandle,
 113                     int destX, int destY, int width, int height,
 114                     int srcX, int srcY));
 115 static int      FileWriteGIF _ANSI_ARGS_((Tcl_Interp *interp,
 116                     CONST char *filename, Tcl_Obj *format,
 117                     Tk_PhotoImageBlock *blockPtr));
 118 static int      CommonWriteGIF _ANSI_ARGS_((Tcl_Interp *interp,
 119                     Tcl_Channel handle, Tcl_Obj *format,
 120                     Tk_PhotoImageBlock *blockPtr));
 121
 122 Tk_PhotoImageFormat tkImgFmtGIF = {
 123     "gif",              /* name */
 124     FileMatchGIF,       /* fileMatchProc */
 125     StringMatchGIF,     /* stringMatchProc */
 126     FileReadGIF,        /* fileReadProc */
 127     StringReadGIF,      /* stringReadProc */
 128     FileWriteGIF,       /* fileWriteProc */
 129     NULL,               /* stringWriteProc */
 130 };
 131
 132 #define INTERLACE               0x40
 133 #define LOCALCOLORMAP           0x80
 134 #define BitSet(byte, bit)       (((byte) & (bit)) == (bit))
 135 #define MAXCOLORMAPSIZE         256
 136 #define CM_RED                  0
 137 #define CM_GREEN                1
 138 #define CM_BLUE                 2
 139 #define CM_ALPHA                3
 140 #define MAX_LWZ_BITS            12
 141 #define LM_to_uint(a,b)         (((b)<<8)|(a))
 142 #define ReadOK(file,buffer,len) (Fread(buffer, len, 1, file) != 0)
 143
 144 /*
 145  * Prototypes for local procedures defined in this file:
 146  */
 147
 148 static int              DoExtension _ANSI_ARGS_((Tcl_Channel chan, int label,
 149                             int *transparent));
 150 static int              GetCode _ANSI_ARGS_((Tcl_Channel chan, int code_size,
 151                             int flag));
 152 static int              GetDataBlock _ANSI_ARGS_((Tcl_Channel chan,
 153                             unsigned char *buf));
 154 static int              ReadColorMap _ANSI_ARGS_((Tcl_Channel chan, int number,
 155                             unsigned char buffer[MAXCOLORMAPSIZE][4]));
 156 static int              ReadGIFHeader _ANSI_ARGS_((Tcl_Channel chan,
 157                             int *widthPtr, int *heightPtr));
 158 static int              ReadImage _ANSI_ARGS_((Tcl_Interp *interp,
 159                             char *imagePtr, Tcl_Channel chan,
 160                             int len, int rows,
 161                             unsigned char cmap[MAXCOLORMAPSIZE][4],
 162                             int width, int height, int srcX, int srcY,
 163                             int interlace, int transparent));
 164
 165 /*
 166  * these are for the BASE64 image reader code only
 167  */
 168
 169 static int              Fread _ANSI_ARGS_((unsigned char *dst, size_t size,
 170                             size_t count, Tcl_Channel chan));
 171 static int              Mread _ANSI_ARGS_((unsigned char *dst, size_t size,
 172                             size_t count, MFile *handle));
 173 static int              Mgetc _ANSI_ARGS_((MFile *handle));
 174 static int              char64 _ANSI_ARGS_((int c));
 175 static void             mInit _ANSI_ARGS_((unsigned char *string,
 176                             MFile *handle));
 177
 178 \f
 179 /*
 180  *----------------------------------------------------------------------
 181  *
 182  * FileMatchGIF --
 183  *
 184  *      This procedure is invoked by the photo image type to see if
 185  *      a file contains image data in GIF format.
 186  *
 187  * Results:
 188  *      The return value is 1 if the first characters in file f look
 189  *      like GIF data, and 0 otherwise.
 190  *
 191  * Side effects:
 192  *      The access position in f may change.
 193  *
 194  *----------------------------------------------------------------------
 195  */
 196
 197 static int
 198 FileMatchGIF(chan, fileName, format, widthPtr, heightPtr, interp)
 199     Tcl_Channel chan;           /* The image file, open for reading. */
 200     CONST char *fileName;       /* The name of the image file. */
 201     Tcl_Obj *format;            /* User-specified format object, or NULL. */
 202     int *widthPtr, *heightPtr;  /* The dimensions of the image are
 203                                  * returned here if the file is a valid
 204                                  * raw GIF file. */
 205     Tcl_Interp *interp;         /* not used */
 206 {
 207         return ReadGIFHeader(chan, widthPtr, heightPtr);
 208 }
 209 \f
 210 /*
 211  *----------------------------------------------------------------------
 212  *
 213  * FileReadGIF --
 214  *
 215  *      This procedure is called by the photo image type to read
 216  *      GIF format data from a file and write it into a given
 217  *      photo image.
 218  *
 219  * Results:
 220  *      A standard TCL completion code.  If TCL_ERROR is returned
 221  *      then an error message is left in the interp's result.
 222  *
 223  * Side effects:
 224  *      The access position in file f is changed, and new data is
 225  *      added to the image given by imageHandle.
 226  *
 227  *----------------------------------------------------------------------
 228  */
 229
 230 static int
 231 FileReadGIF(interp, chan, fileName, format, imageHandle, destX, destY,
 232         width, height, srcX, srcY)
 233     Tcl_Interp *interp;         /* Interpreter to use for reporting errors. */
 234     Tcl_Channel chan;           /* The image file, open for reading. */
 235     CONST char *fileName;       /* The name of the image file. */
 236     Tcl_Obj *format;            /* User-specified format object, or NULL. */
 237     Tk_PhotoHandle imageHandle; /* The photo image to write into. */
 238     int destX, destY;           /* Coordinates of top-left pixel in
 239                                  * photo image to be written to. */
 240     int width, height;          /* Dimensions of block of photo image to
 241                                  * be written to. */
 242     int srcX, srcY;             /* Coordinates of top-left pixel to be used
 243                                  * in image being read. */
 244 {
 245     int fileWidth, fileHeight;
 246     int nBytes, index = 0, argc = 0, i;
 247     Tcl_Obj **objv;
 248     Tk_PhotoImageBlock block;
 249     unsigned char buf[100];
 250     unsigned char *trashBuffer = NULL;
 251     int bitPixel;
 252     unsigned char colorMap[MAXCOLORMAPSIZE][4];
 253     int transparent = -1;
 254     static CONST char *optionStrings[] = {
 255         "-index",       NULL
 256     };
 257
 258     if (format && Tcl_ListObjGetElements(interp, format,
 259             &argc, &objv) != TCL_OK) {
 260         return TCL_ERROR;
 261     }
 262     for (i = 1; i < argc; i++) {
 263         if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option name", 0,
 264                 &nBytes) != TCL_OK) {
 265             return TCL_ERROR;
 266         }
 267         if (i == (argc-1)) {
 268             Tcl_AppendResult(interp, "no value given for \"",
 269                     Tcl_GetStringFromObj(objv[i], NULL),
 270                     "\" option", (char *) NULL);
 271             return TCL_ERROR;
 272         }
 273         if (Tcl_GetIntFromObj(interp, objv[++i], &index) != TCL_OK) {
 274             return TCL_ERROR;
 275         }
 276     }
 277     if (!ReadGIFHeader(chan, &fileWidth, &fileHeight)) {
 278         Tcl_AppendResult(interp, "couldn't read GIF header from file \"",
 279                 fileName, "\"", NULL);
 280         return TCL_ERROR;
 281     }
 282     if ((fileWidth <= 0) || (fileHeight <= 0)) {
 283         Tcl_AppendResult(interp, "GIF image file \"", fileName,
 284                 "\" has dimension(s) <= 0", (char *) NULL);
 285         return TCL_ERROR;
 286     }
 287
 288     if (Fread(buf, 1, 3, chan) != 3) {
 289         return TCL_OK;
 290     }
 291     bitPixel = 2<<(buf[0]&0x07);
 292
 293     if (BitSet(buf[0], LOCALCOLORMAP)) {        /* Global Colormap */
 294         if (!ReadColorMap(chan, bitPixel, colorMap)) {
 295             Tcl_AppendResult(interp, "error reading color map",
 296                     (char *) NULL);
 297             return TCL_ERROR;
 298         }
 299     }
 300
 301     if ((srcX + width) > fileWidth) {
 302         width = fileWidth - srcX;
 303     }
 304     if ((srcY + height) > fileHeight) {
 305         height = fileHeight - srcY;
 306     }
 307     if ((width <= 0) || (height <= 0)
 308             || (srcX >= fileWidth) || (srcY >= fileHeight)) {
 309         return TCL_OK;
 310     }
 311
 312     Tk_PhotoExpand(imageHandle, destX + width, destY + height);
 313
 314     block.width = width;
 315     block.height = height;
 316     block.pixelSize = 4;
 317     block.pitch = block.pixelSize * block.width;
 318     block.offset[0] = 0;
 319     block.offset[1] = 1;
 320     block.offset[2] = 2;
 321     block.offset[3] = 3;
 322     block.pixelPtr = NULL;
 323
 324     while (1) {
 325         if (Fread(buf, 1, 1, chan) != 1) {
 326             /*
 327              * Premature end of image.  We should really notify
 328              * the user, but for now just show garbage.
 329              */
 330
 331             break;
 332         }
 333
 334         if (buf[0] == GIF_TERMINATOR) {
 335             /*
 336              * GIF terminator.
 337              */
 338
 339             Tcl_AppendResult(interp,"no image data for this index",
 340                     (char *) NULL);
 341             goto error;
 342         }
 343
 344         if (buf[0] == GIF_EXTENSION) {
 345             /*
 346              * This is a GIF extension.
 347              */
 348
 349             if (Fread(buf, 1, 1, chan) != 1) {
 350                 Tcl_SetResult(interp,
 351                         "error reading extension function code in GIF image",
 352                         TCL_STATIC);
 353                 goto error;
 354             }
 355             if (DoExtension(chan, buf[0], &transparent) < 0) {
 356                 Tcl_SetResult(interp, "error reading extension in GIF image",
 357                         TCL_STATIC);
 358                 goto error;
 359             }
 360             continue;
 361         }
 362
 363         if (buf[0] != GIF_START) {
 364             /*
 365              * Not a valid start character; ignore it.
 366              */
 367             continue;
 368         }
 369
 370         if (Fread(buf, 1, 9, chan) != 9) {
 371             Tcl_SetResult(interp,
 372                     "couldn't read left/top/width/height in GIF image",
 373                     TCL_STATIC);
 374             goto error;
 375         }
 376
 377         fileWidth = LM_to_uint(buf[4],buf[5]);
 378         fileHeight = LM_to_uint(buf[6],buf[7]);
 379
 380         bitPixel = 1<<((buf[8]&0x07)+1);
 381
 382         if (index--) {
 383             /*
 384              * This is not the image we want to read: skip it.
 385              */
 386             if (BitSet(buf[8], LOCALCOLORMAP)) {
 387                 if (!ReadColorMap(chan, bitPixel, colorMap)) {
 388                     Tcl_AppendResult(interp,
 389                             "error reading color map", (char *) NULL);
 390                     goto error;
 391                 }
 392             }
 393
 394             /*
 395              * If we've not yet allocated a trash buffer, do so now.
 396              */
 397             if (trashBuffer == NULL) {
 398                 nBytes = fileWidth * fileHeight * 3;
 399                 trashBuffer =
 400                     (unsigned char *) ckalloc((unsigned int) nBytes);
 401             }
 402
 403             /*
 404              * Slurp!  Process the data for this image and stuff it in
 405              * a trash buffer.
 406              *
 407              * Yes, it might be more efficient here to *not* store the
 408              * data (we're just going to throw it away later).
 409              * However, I elected to implement it this way for good
 410              * reasons.  First, I wanted to avoid duplicating the
 411              * (fairly complex) LWZ decoder in ReadImage.  Fine, you
 412              * say, why didn't you just modify it to allow the use of
 413              * a NULL specifier for the output buffer?  I tried that,
 414              * but it negatively impacted the performance of what I
 415              * think will be the common case: reading the first image
 416              * in the file.  Rather than marginally improve the speed
 417              * of the less frequent case, I chose to maintain high
 418              * performance for the common case.
 419              */
 420             if (ReadImage(interp, (char *) trashBuffer, chan, fileWidth,
 421                     fileHeight, colorMap, 0, 0, 0, 0, 0, -1) != TCL_OK) {
 422                 goto error;
 423             }
 424             continue;
 425         }
 426
 427         /*
 428          * If a trash buffer has been allocated, free it now.
 429          */
 430         if (trashBuffer != NULL) {
 431             ckfree((char *)trashBuffer);
 432             trashBuffer = NULL;
 433         }
 434         if (BitSet(buf[8], LOCALCOLORMAP)) {
 435             if (!ReadColorMap(chan, bitPixel, colorMap)) {
 436                     Tcl_AppendResult(interp, "error reading color map",
 437                             (char *) NULL);
 438                     goto error;
 439             }
 440         }
 441
 442         index = LM_to_uint(buf[0],buf[1]);
 443         srcX -= index;
 444         if (srcX<0) {
 445             destX -= srcX; width += srcX;
 446             srcX = 0;
 447         }
 448
 449         if (width > fileWidth) {
 450             width = fileWidth;
 451         }
 452
 453         index = LM_to_uint(buf[2],buf[3]);
 454         srcY -= index;
 455         if (index > srcY) {
 456             destY -= srcY; height += srcY;
 457             srcY = 0;
 458         }
 459         if (height > fileHeight) {
 460             height = fileHeight;
 461         }
 462
 463         if ((width <= 0) || (height <= 0)) {
 464             block.pixelPtr = 0;
 465             goto noerror;
 466         }
 467
 468         block.width = width;
 469         block.height = height;
 470         block.pixelSize = (transparent>=0) ? 4 : 3;
 471         block.offset[3] = (transparent>=0) ? 3 : 0;
 472         block.pitch = block.pixelSize * fileWidth;
 473         nBytes = block.pitch * fileHeight;
 474         block.pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
 475
 476         if (ReadImage(interp, (char *) block.pixelPtr, chan, fileWidth,
 477                 fileHeight, colorMap, fileWidth, fileHeight, srcX, srcY,
 478                 BitSet(buf[8], INTERLACE), transparent) != TCL_OK) {
 479             goto error;
 480         }
 481         break;
 482     }
 483
 484     Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, height,
 485             TK_PHOTO_COMPOSITE_SET);
 486
 487     noerror:
 488     if (block.pixelPtr) {
 489         ckfree((char *) block.pixelPtr);
 490     }
 491     Tcl_AppendResult(interp, tkImgFmtGIF.name, (char *) NULL);
 492     return TCL_OK;
 493
 494     error:
 495     if (block.pixelPtr) {
 496         ckfree((char *) block.pixelPtr);
 497     }
 498     return TCL_ERROR;
 499
 500 }
 501 \f
 502 /*
 503  *----------------------------------------------------------------------
 504  *
 505  * StringMatchGIF --
 506  *
 507  *  This procedure is invoked by the photo image type to see if
 508  *  an object contains image data in GIF format.
 509  *
 510  * Results:
 511  *  The return value is 1 if the first characters in the data are
 512  *  like GIF data, and 0 otherwise.
 513  *
 514  * Side effects:
 515  *  the size of the image is placed in widthPre and heightPtr.
 516  *
 517  *----------------------------------------------------------------------
 518  */
 519
 520 static int
 521 StringMatchGIF(dataObj, format, widthPtr, heightPtr, interp)
 522     Tcl_Obj *dataObj;           /* the object containing the image data */
 523     Tcl_Obj *format;            /* the image format object, or NULL */
 524     int *widthPtr;              /* where to put the string width */
 525     int *heightPtr;             /* where to put the string height */
 526     Tcl_Interp *interp;         /* not used */
 527 {
 528     unsigned char *data, header[10];
 529     int got, length;
 530     MFile handle;
 531
 532     data = Tcl_GetByteArrayFromObj(dataObj, &length);
 533
 534     /*
 535      * Header is a minimum of 10 bytes.
 536      */
 537     if (length < 10) {
 538         return 0;
 539     }
 540
 541     /*
 542      * Check whether the data is Base64 encoded.
 543      */
 544
 545     if ((strncmp(GIF87a, (char *) data, 6) != 0) &&
 546             (strncmp(GIF89a, (char *) data, 6) != 0)) {
 547         /*
 548          * Try interpreting the data as Base64 encoded
 549          */
 550         mInit((unsigned char *) data, &handle);
 551         got = Mread(header, 10, 1, &handle);
 552         if (got != 10
 553                 || ((strncmp(GIF87a, (char *) header, 6) != 0)
 554                 && (strncmp(GIF89a, (char *) header, 6) != 0))) {
 555             return 0;
 556         }
 557     } else {
 558         memcpy((VOID *) header, (VOID *) data, 10);
 559     }
 560     *widthPtr = LM_to_uint(header[6],header[7]);
 561     *heightPtr = LM_to_uint(header[8],header[9]);
 562     return 1;
 563 }
 564 \f
 565 /*
 566  *----------------------------------------------------------------------
 567  *
 568  * StringReadGif -- --
 569  *
 570  *      This procedure is called by the photo image type to read
 571  *      GIF format data from an object, optionally base64 encoded,
 572  *      and give it to the photo image.
 573  *
 574  * Results:
 575  *      A standard TCL completion code.  If TCL_ERROR is returned
 576  *      then an error message is left in the interp's result.
 577  *
 578  * Side effects:
 579  *      new data is added to the image given by imageHandle.  This
 580  *      procedure calls FileReadGif by redefining the operation of
 581  *      fprintf temporarily.
 582  *
 583  *----------------------------------------------------------------------
 584  */
 585
 586 static int
 587 StringReadGIF(interp, dataObj, format, imageHandle,
 588         destX, destY, width, height, srcX, srcY)
 589     Tcl_Interp *interp;         /* interpreter for reporting errors in */
 590     Tcl_Obj *dataObj;           /* object containing the image */
 591     Tcl_Obj *format;            /* format object, or NULL */
 592     Tk_PhotoHandle imageHandle; /* the image to write this data into */
 593     int destX, destY;           /* The rectangular region of the  */
 594     int width, height;          /*   image to copy */
 595     int srcX, srcY;
 596 {
 597     int result;
 598     MFile handle;
 599     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 600             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
 601     Tcl_Channel dataSrc;
 602     char *data;
 603
 604     /*
 605      * Check whether the data is Base64 encoded
 606      */
 607     data = (char *) Tcl_GetByteArrayFromObj(dataObj, NULL);
 608     if ((strncmp(GIF87a, data, 6) != 0) && (strncmp(GIF89a, data, 6) != 0)) {
 609         mInit((unsigned char *)data, &handle);
 610         tsdPtr->fromData = 1;
 611         dataSrc = (Tcl_Channel) &handle;
 612     } else {
 613         tsdPtr->fromData = 2;
 614         mInit((unsigned char *)data, &handle);
 615         dataSrc = (Tcl_Channel) &handle;
 616     }
 617     result = FileReadGIF(interp, dataSrc, "inline data",
 618             format, imageHandle, destX, destY, width, height, srcX, srcY);
 619     tsdPtr->fromData = 0;
 620     return result;
 621 }
 622
 623 /*
 624  *----------------------------------------------------------------------
 625  *
 626  * ReadGIFHeader --
 627  *
 628  *      This procedure reads the GIF header from the beginning of a
 629  *      GIF file and returns the dimensions of the image.
 630  *
 631  * Results:
 632  *      The return value is 1 if file "f" appears to start with
 633  *      a valid GIF header, 0 otherwise.  If the header is valid,
 634  *      then *widthPtr and *heightPtr are modified to hold the
 635  *      dimensions of the image.
 636  *
 637  * Side effects:
 638  *      The access position in f advances.
 639  *
 640  *----------------------------------------------------------------------
 641  */
 642
 643 static int
 644 ReadGIFHeader(chan, widthPtr, heightPtr)
 645     Tcl_Channel chan;           /* Image file to read the header from */
 646     int *widthPtr, *heightPtr;  /* The dimensions of the image are
 647                                  * returned here. */
 648 {
 649     unsigned char buf[7];
 650
 651     if ((Fread(buf, 1, 6, chan) != 6)
 652             || ((strncmp(GIF87a, (char *) buf, 6) != 0)
 653             && (strncmp(GIF89a, (char *) buf, 6) != 0))) {
 654         return 0;
 655     }
 656
 657     if (Fread(buf, 1, 4, chan) != 4) {
 658         return 0;
 659     }
 660
 661     *widthPtr = LM_to_uint(buf[0],buf[1]);
 662     *heightPtr = LM_to_uint(buf[2],buf[3]);
 663     return 1;
 664 }
 665
 666 /*
 667  *-----------------------------------------------------------------
 668  * The code below is copied from the giftoppm program and modified
 669  * just slightly.
 670  *-----------------------------------------------------------------
 671  */
 672
 673 static int
 674 ReadColorMap(chan, number, buffer)
 675     Tcl_Channel chan;
 676     int number;
 677     unsigned char buffer[MAXCOLORMAPSIZE][4];
 678 {
 679     int i;
 680     unsigned char rgb[3];
 681
 682     for (i = 0; i < number; ++i) {
 683         if (! ReadOK(chan, rgb, sizeof(rgb))) {
 684             return 0;
 685         }
 686
 687         if (buffer) {
 688             buffer[i][CM_RED] = rgb[0] ;
 689             buffer[i][CM_GREEN] = rgb[1] ;
 690             buffer[i][CM_BLUE] = rgb[2] ;
 691             buffer[i][CM_ALPHA] = 255 ;
 692         }
 693     }
 694     return 1;
 695 }
 696
 697
 698
 699 static int
 700 DoExtension(chan, label, transparent)
 701     Tcl_Channel chan;
 702     int label;
 703     int *transparent;
 704 {
 705     static unsigned char buf[256];
 706     int count;
 707
 708     switch (label) {
 709     case 0x01:          /* Plain Text Extension */
 710         break;
 711
 712     case 0xff:          /* Application Extension */
 713         break;
 714
 715     case 0xfe:          /* Comment Extension */
 716         do {
 717             count = GetDataBlock(chan, (unsigned char*) buf);
 718         } while (count > 0);
 719         return count;
 720
 721     case 0xf9:          /* Graphic Control Extension */
 722         count = GetDataBlock(chan, (unsigned char*) buf);
 723         if (count < 0) {
 724             return 1;
 725         }
 726         if ((buf[0] & 0x1) != 0) {
 727             *transparent = buf[3];
 728         }
 729
 730         do {
 731             count = GetDataBlock(chan, (unsigned char*) buf);
 732         } while (count > 0);
 733         return count;
 734     }
 735
 736     do {
 737         count = GetDataBlock(chan, (unsigned char*) buf);
 738     } while (count > 0);
 739     return count;
 740 }
 741
 742 static int ZeroDataBlock = 0;
 743
 744 static int
 745 GetDataBlock(chan, buf)
 746     Tcl_Channel chan;
 747     unsigned char *buf;
 748 {
 749     unsigned char count;
 750
 751     if (! ReadOK(chan, &count,1)) {
 752         return -1;
 753     }
 754
 755     ZeroDataBlock = count == 0;
 756
 757     if ((count != 0) && (! ReadOK(chan, buf, count))) {
 758         return -1;
 759     }
 760
 761     return count;
 762 }
 763
 764
 765 \f
 766 /*
 767  *----------------------------------------------------------------------
 768  *
 769  * ReadImage --
 770  *
 771  *      Process a GIF image from a given source, with a given height,
 772  *      width, transparency, etc.
 773  *
 774  *      This code is based on the code found in the ImageMagick GIF decoder,
 775  *      which is (c) 2000 ImageMagick Studio.
 776  *
 777  *      Some thoughts on our implementation:
 778  *      It sure would be nice if ReadImage didn't take 11 parameters!  I think
 779  *      that if we were smarter, we could avoid doing that.
 780  *
 781  *      Possible further optimizations:  we could pull the GetCode function
 782  *      directly into ReadImage, which would improve our speed.
 783  *
 784  * Results:
 785  *      Processes a GIF image and loads the pixel data into a memory array.
 786  *
 787  * Side effects:
 788  *      None.
 789  *
 790  *----------------------------------------------------------------------
 791  */
 792
 793 static int
 794 ReadImage(interp, imagePtr, chan, len, rows, cmap,
 795         width, height, srcX, srcY, interlace, transparent)
 796     Tcl_Interp *interp;
 797     char *imagePtr;
 798     Tcl_Channel chan;
 799     int len, rows;
 800     unsigned char cmap[MAXCOLORMAPSIZE][4];
 801     int width, height;
 802     int srcX, srcY;
 803     int interlace;
 804     int transparent;
 805 {
 806     unsigned char initialCodeSize;
 807     int v;
 808     int xpos = 0, ypos = 0, pass = 0, i;
 809     register char *pixelPtr;
 810     CONST static int interlaceStep[] = { 8, 8, 4, 2 };
 811     CONST static int interlaceStart[] = { 0, 4, 2, 1 };
 812     unsigned short prefix[(1 << MAX_LWZ_BITS)];
 813     unsigned char  append[(1 << MAX_LWZ_BITS)];
 814     unsigned char  stack[(1 << MAX_LWZ_BITS)*2];
 815     register unsigned char *top;
 816     int codeSize, clearCode, inCode, endCode, oldCode, maxCode;
 817     int code, firstCode;
 818
 819     /*
 820      *  Initialize the decoder
 821      */
 822     if (! ReadOK(chan, &initialCodeSize, 1))  {
 823         Tcl_AppendResult(interp, "error reading GIF image: ",
 824                 Tcl_PosixError(interp), (char *) NULL);
 825         return TCL_ERROR;
 826     }
 827     if (transparent != -1) {
 828         cmap[transparent][CM_RED] = 0;
 829         cmap[transparent][CM_GREEN] = 0;
 830         cmap[transparent][CM_BLUE] = 0;
 831         cmap[transparent][CM_ALPHA] = 0;
 832     }
 833
 834     pixelPtr = imagePtr;
 835
 836     /*
 837      * Initialize the decoder.
 838      *
 839      * Set values for "special" numbers:
 840      * clear code       reset the decoder
 841      * end code         stop decoding
 842      * code size        size of the next code to retrieve
 843      * max code         next available table position
 844      */
 845     clearCode = 1 << (int) initialCodeSize;
 846     endCode = clearCode + 1;
 847     codeSize = (int) initialCodeSize + 1;
 848     maxCode = clearCode + 2;
 849     oldCode = -1;
 850     firstCode = -1;
 851
 852     memset((void *)prefix, 0, (1 << MAX_LWZ_BITS) * sizeof(short));
 853     memset((void *)append, 0, (1 << MAX_LWZ_BITS) * sizeof(char));
 854     for (i = 0; i < clearCode; i++) {
 855         append[i] = i;
 856     }
 857     top = stack;
 858
 859     GetCode(chan, 0, 1);
 860
 861     /*
 862      * Read until we finish the image
 863      */
 864     for (i = 0, ypos = 0; i < rows; i++) {
 865         for (xpos = 0; xpos < len; ) {
 866
 867             if (top == stack) {
 868                 /*
 869                  * Bummer -- our stack is empty.  Now we have to work!
 870                  */
 871                 code = GetCode(chan, codeSize, 0);
 872                 if (code < 0) {
 873                     return TCL_OK;
 874                 }
 875
 876                 if (code > maxCode || code == endCode) {
 877                     /*
 878                      * If we're doing things right, we should never
 879                      * receive a code that is greater than our current
 880                      * maximum code.  If we do, bail, because our decoder
 881                      * does not yet have that code set up.
 882                      *
 883                      * If the code is the magic endCode value, quit.
 884                      */
 885                     return TCL_OK;
 886                 }
 887
 888                 if (code == clearCode) {
 889                     /*
 890                      * Reset the decoder.
 891                      */
 892                     codeSize = initialCodeSize + 1;
 893                     maxCode = clearCode + 2;
 894                     oldCode = -1;
 895                     continue;
 896                 }
 897
 898                 if (oldCode == -1) {
 899                     /*
 900                      * Last pass reset the decoder, so the first code we
 901                      * see must be a singleton.  Seed the stack with it,
 902                      * and set up the old/first code pointers for
 903                      * insertion into the string table.  We can't just
 904                      * roll this into the clearCode test above, because
 905                      * at that point we have not yet read the next code.
 906                      */
 907                     *top++ = append[code];
 908                     oldCode = code;
 909                     firstCode = code;
 910                     continue;
 911                 }
 912
 913                 inCode = code;
 914
 915                 if (code == maxCode) {
 916                     /*
 917                      * maxCode is always one bigger than our highest assigned
 918                      * code.  If the code we see is equal to maxCode, then
 919                      * we are about to add a new string to the table. ???
 920                      */
 921                     *top++ = firstCode;
 922                     code = oldCode;
 923                 }
 924
 925                 while (code > clearCode) {
 926                     /*
 927                      * Populate the stack by tracing the string in the
 928                      * string table from its tail to its head
 929                      */
 930                     *top++ = append[code];
 931                     code = prefix[code];
 932                 }
 933                 firstCode = append[code];
 934
 935                 /*
 936                  * If there's no more room in our string table, quit.
 937                  * Otherwise, add a new string to the table
 938                  */
 939                 if (maxCode >= (1 << MAX_LWZ_BITS)) {
 940                     return TCL_OK;
 941                 }
 942
 943                 /*
 944                  * Push the head of the string onto the stack.
 945                  */
 946                 *top++ = firstCode;
 947
 948                 /*
 949                  * Add a new string to the string table
 950                  */
 951                 prefix[maxCode] = oldCode;
 952                 append[maxCode] = firstCode;
 953                 maxCode++;
 954
 955                 /*
 956                  * maxCode tells us the maximum code value we can accept.
 957                  * If we see that we need more bits to represent it than
 958                  * we are requesting from the unpacker, we need to increase
 959                  * the number we ask for.
 960                  */
 961                 if ((maxCode >= (1 << codeSize))
 962                         && (maxCode < (1<<MAX_LWZ_BITS))) {
 963                     codeSize++;
 964                 }
 965                 oldCode = inCode;
 966             }
 967
 968             /*
 969              * Pop the next color index off the stack.
 970              */
 971             v = *(--top);
 972             if (v < 0) {
 973                 return TCL_OK;
 974             }
 975
 976             /*
 977              * If pixelPtr is null, we're skipping this image (presumably
 978              * there are more in the file and we will be called to read
 979              * one of them later)
 980              */
 981             *pixelPtr++ = cmap[v][CM_RED];
 982             *pixelPtr++ = cmap[v][CM_GREEN];
 983             *pixelPtr++ = cmap[v][CM_BLUE];
 984             if (transparent >= 0) {
 985                 *pixelPtr++ = cmap[v][CM_ALPHA];
 986             }
 987             xpos++;
 988
 989         }
 990
 991         /*
 992          * If interlacing, the next ypos is not just +1
 993          */
 994         if (interlace) {
 995             ypos += interlaceStep[pass];
 996             while (ypos >= height) {
 997                 pass++;
 998                 if (pass > 3) {
 999                     return TCL_OK;
1000                 }
1001                 ypos = interlaceStart[pass];
1002             }
1003         } else {
1004             ypos++;
1005         }
1006         pixelPtr = imagePtr + (ypos) * len * ((transparent>=0)?4:3);
1007     }
1008     return TCL_OK;
1009 }
1010
1011 \f
1012 /*
1013  *----------------------------------------------------------------------
1014  *
1015  * GetCode --
1016  *
1017  *      Extract the next compression code from the file.  In GIF's, the
1018  *      compression codes are between 3 and 12 bits long and are then
1019  *      packed into 8 bit bytes, left to right, for example:
1020  *              bbbaaaaa
1021  *              dcccccbb
1022  *              eeeedddd
1023  *              ...
1024  *      We use a byte buffer read from the file and a sliding window
1025  *      to unpack the bytes.  Thanks to ImageMagick for the sliding window
1026  *      idea.
1027  *      args:  chan         the channel to read from
1028  *             code_size    size of the code to extract
1029  *             flag         boolean indicating whether the extractor
1030  *                          should be reset or not
1031  *
1032  * Results:
1033  *      code                the next compression code
1034  *
1035  * Side effects:
1036  *      May consume more input from chan.
1037  *
1038  *----------------------------------------------------------------------
1039  */
1040
1041 static int
1042 GetCode(chan, code_size, flag)
1043     Tcl_Channel chan;
1044     int code_size;
1045     int flag;
1046 {
1047     static unsigned char buf[280];
1048     static int bytes = 0, done;
1049     static unsigned char *c;
1050
1051     static unsigned int window;
1052     static int bitsInWindow = 0;
1053     int ret;
1054
1055     if (flag) {
1056         /*
1057          * Initialize the decoder.
1058          */
1059         bitsInWindow = 0;
1060         bytes = 0;
1061         window = 0;
1062         done = 0;
1063         c = NULL;
1064         return 0;
1065     }
1066
1067     while (bitsInWindow < code_size) {
1068         /*
1069          * Not enough bits in our window to cover the request.
1070          */
1071         if (done) {
1072             return -1;
1073         }
1074         if (bytes == 0) {
1075             /*
1076              * Not enough bytes in our buffer to add to the window.
1077              */
1078             bytes = GetDataBlock(chan, buf);
1079             c = buf;
1080             if (bytes <= 0) {
1081                 done = 1;
1082                 break;
1083             }
1084         }
1085         /*
1086          * Tack another byte onto the window, see if that's enough.
1087          */
1088         window += (*c) << bitsInWindow;
1089         c++;
1090         bitsInWindow += 8;
1091         bytes--;
1092     }
1093
1094
1095     /*
1096      * The next code will always be the last code_size bits of the window.
1097      */
1098     ret = window & ((1 << code_size) - 1);
1099
1100     /*
1101      * Shift data in the window to put the next code at the end.
1102      */
1103     window >>= code_size;
1104     bitsInWindow -= code_size;
1105     return ret;
1106 }
1107 \f
1108 /*
1109  *----------------------------------------------------------------------
1110  *
1111  * Minit -- --
1112  *
1113  *  This procedure initializes a base64 decoder handle
1114  *
1115  * Results:
1116  *  none
1117  *
1118  * Side effects:
1119  *  the base64 handle is initialized
1120  *
1121  *----------------------------------------------------------------------
1122  */
1123
1124 static void
1125 mInit(string, handle)
1126    unsigned char *string;       /* string containing initial mmencoded data */
1127    MFile *handle;               /* mmdecode "file" handle */
1128 {
1129    handle->data = string;
1130    handle->state = 0;
1131    handle->c = 0;
1132 }
1133 \f
1134 /*
1135  *----------------------------------------------------------------------
1136  *
1137  * Mread --
1138  *
1139  *      This procedure is invoked by the GIF file reader as a
1140  *      temporary replacement for "fread", to get GIF data out
1141  *      of a string (using Mgetc).
1142  *
1143  * Results:
1144  *      The return value is the number of characters "read"
1145  *
1146  * Side effects:
1147  *      The base64 handle will change state.
1148  *
1149  *----------------------------------------------------------------------
1150  */
1151
1152 static int
1153 Mread(dst, chunkSize, numChunks, handle)
1154    unsigned char *dst;  /* where to put the result */
1155    size_t chunkSize;    /* size of each transfer */
1156    size_t numChunks;    /* number of chunks */
1157    MFile *handle;       /* mmdecode "file" handle */
1158 {
1159    register int i, c;
1160    int count = chunkSize * numChunks;
1161
1162    for(i=0; i<count && (c=Mgetc(handle)) != GIF_DONE; i++) {
1163         *dst++ = c;
1164    }
1165    return i;
1166 }
1167
1168 /*
1169  * get the next decoded character from an mmencode handle
1170  * This causes at least 1 character to be "read" from the encoded string
1171  */
1172 \f
1173 /*
1174  *----------------------------------------------------------------------
1175  *
1176  * Mgetc --
1177  *
1178  *  This procedure decodes and returns the next byte from a base64
1179  *  encoded string.
1180  *
1181  * Results:
1182  *  The next byte (or GIF_DONE) is returned.
1183  *
1184  * Side effects:
1185  *  The base64 handle will change state.
1186  *
1187  *----------------------------------------------------------------------
1188  */
1189
1190 static int
1191 Mgetc(handle)
1192    MFile *handle;               /* Handle containing decoder data and state */
1193 {
1194     int c;
1195     int result = 0;             /* Initialization needed only to prevent
1196                                  * gcc compiler warning. */
1197
1198     if (handle->state == GIF_DONE) {
1199         return GIF_DONE;
1200     }
1201
1202     do {
1203         c = char64(*handle->data);
1204         handle->data++;
1205     } while (c == GIF_SPACE);
1206
1207     if (c>GIF_SPECIAL) {
1208         handle->state = GIF_DONE;
1209         return handle->c;
1210     }
1211
1212     switch (handle->state++) {
1213     case 0:
1214         handle->c = c<<2;
1215         result = Mgetc(handle);
1216         break;
1217     case 1:
1218         result = handle->c | (c>>4);
1219         handle->c = (c&0xF)<<4;
1220         break;
1221     case 2:
1222         result = handle->c | (c>>2);
1223         handle->c = (c&0x3) << 6;
1224         break;
1225     case 3:
1226         result = handle->c | c;
1227         handle->state = 0;
1228         break;
1229     }
1230     return result;
1231 }
1232 \f
1233 /*
1234  *----------------------------------------------------------------------
1235  *
1236  * char64 --
1237  *
1238  *      This procedure converts a base64 ascii character into its binary
1239  *      equivalent.  This code is a slightly modified version of the
1240  *      char64 proc in N. Borenstein's metamail decoder.
1241  *
1242  * Results:
1243  *      The binary value, or an error code.
1244  *
1245  * Side effects:
1246  *      None.
1247  *----------------------------------------------------------------------
1248  */
1249
1250 static int
1251 char64(c)
1252 int c;
1253 {
1254     switch(c) {
1255     case 'A': return 0;  case 'B': return 1;  case 'C': return 2;
1256     case 'D': return 3;  case 'E': return 4;  case 'F': return 5;
1257     case 'G': return 6;  case 'H': return 7;  case 'I': return 8;
1258     case 'J': return 9;  case 'K': return 10; case 'L': return 11;
1259     case 'M': return 12; case 'N': return 13; case 'O': return 14;
1260     case 'P': return 15; case 'Q': return 16; case 'R': return 17;
1261     case 'S': return 18; case 'T': return 19; case 'U': return 20;
1262     case 'V': return 21; case 'W': return 22; case 'X': return 23;
1263     case 'Y': return 24; case 'Z': return 25; case 'a': return 26;
1264     case 'b': return 27; case 'c': return 28; case 'd': return 29;
1265     case 'e': return 30; case 'f': return 31; case 'g': return 32;
1266     case 'h': return 33; case 'i': return 34; case 'j': return 35;
1267     case 'k': return 36; case 'l': return 37; case 'm': return 38;
1268     case 'n': return 39; case 'o': return 40; case 'p': return 41;
1269     case 'q': return 42; case 'r': return 43; case 's': return 44;
1270     case 't': return 45; case 'u': return 46; case 'v': return 47;
1271     case 'w': return 48; case 'x': return 49; case 'y': return 50;
1272     case 'z': return 51; case '0': return 52; case '1': return 53;
1273     case '2': return 54; case '3': return 55; case '4': return 56;
1274     case '5': return 57; case '6': return 58; case '7': return 59;
1275     case '8': return 60; case '9': return 61; case '+': return 62;
1276     case '/': return 63;
1277
1278     case ' ': case '\t': case '\n': case '\r': case '\f':
1279         return GIF_SPACE;
1280     case '=':
1281         return GIF_PAD;
1282     case '\0':
1283         return GIF_DONE;
1284     default:
1285         return GIF_BAD;
1286     }
1287 }
1288 \f
1289 /*
1290  *----------------------------------------------------------------------
1291  *
1292  * Fread --
1293  *
1294  *  This procedure calls either fread or Mread to read data
1295  *  from a file or a base64 encoded string.
1296  *
1297  * Results: - same as fread
1298  *
1299  *----------------------------------------------------------------------
1300  */
1301
1302 static int
1303 Fread(dst, hunk, count, chan)
1304     unsigned char *dst;         /* where to put the result */
1305     size_t hunk,count;          /* how many */
1306     Tcl_Channel chan;
1307 {
1308     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1309             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1310     MFile *handle;
1311
1312     switch (tsdPtr->fromData) {
1313     case 1:
1314         return Mread(dst, hunk, count, (MFile *) chan);
1315     case 2:
1316         handle = (MFile *) chan;
1317         memcpy((VOID *)dst, (VOID *) handle->data, (size_t) (hunk * count));
1318         handle->data += hunk * count;
1319         return (int)(hunk * count);
1320     default:
1321         return Tcl_Read(chan, (char *) dst, (int) (hunk * count));
1322     }
1323 }
1324
1325 \f
1326 /*
1327  * ChanWriteGIF - writes a image in GIF format.
1328  *-------------------------------------------------------------------------
1329  * Author:                      Lolo
1330  *                              Engeneering Projects Area
1331  *                              Department of Mining
1332  *                              University of Oviedo
1333  * e-mail                       zz11425958@zeus.etsimo.uniovi.es
1334  *                              lolo@pcsig22.etsimo.uniovi.es
1335  * Date:                        Fri September 20 1996
1336  *
1337  * Modified for transparency handling (gif89a) and miGIF compression
1338  * by Jan Nijtmans <j.nijtmans@chello.nl>
1339  *
1340  *----------------------------------------------------------------------
1341  * FileWriteGIF-
1342  *
1343  *    This procedure is called by the photo image type to write
1344  *    GIF format data from a photo image into a given file
1345  *
1346  * Results:
1347  *      A standard TCL completion code.  If TCL_ERROR is returned
1348  *      then an error message is left in interp->result.
1349  *
1350  *----------------------------------------------------------------------
1351  */
1352
1353  /*
1354   *  Types, defines and variables needed to write and compress a GIF.
1355   */
1356
1357 typedef int (* ifunptr) _ANSI_ARGS_((void));
1358
1359 #define LSB(a)                  ((unsigned char) (((short)(a)) & 0x00FF))
1360 #define MSB(a)                  ((unsigned char) (((short)(a)) >> 8))
1361
1362 #define GIFBITS 12
1363 #define HSIZE  5003             /* 80% occupancy */
1364
1365 static int ssize;
1366 static int csize;
1367 static int rsize;
1368 static unsigned char *pixelo;
1369 static int pixelSize;
1370 static int pixelPitch;
1371 static int greenOffset;
1372 static int blueOffset;
1373 static int alphaOffset;
1374 static int num;
1375 static unsigned char mapa[MAXCOLORMAPSIZE][3];
1376
1377 /*
1378  *      Definition of new functions to write GIFs
1379  */
1380
1381 static int color _ANSI_ARGS_((int red,int green, int blue,
1382                 unsigned char mapa[MAXCOLORMAPSIZE][3]));
1383 static void compress _ANSI_ARGS_((int init_bits, Tcl_Channel handle,
1384                 ifunptr readValue));
1385 static int nuevo _ANSI_ARGS_((int red, int green ,int blue,
1386                 unsigned char mapa[MAXCOLORMAPSIZE][3]));
1387 static void savemap _ANSI_ARGS_((Tk_PhotoImageBlock *blockPtr,
1388                 unsigned char mapa[MAXCOLORMAPSIZE][3]));
1389 static int ReadValue _ANSI_ARGS_((void));
1390
1391 static int
1392 FileWriteGIF(interp, filename, format, blockPtr)
1393     Tcl_Interp *interp;         /* Interpreter to use for reporting errors. */
1394     CONST char  *filename;
1395     Tcl_Obj     *format;
1396     Tk_PhotoImageBlock *blockPtr;
1397 {
1398     Tcl_Channel chan = NULL;
1399     int result;
1400
1401     chan = Tcl_OpenFileChannel(interp, (char *) filename, "w", 0644);
1402     if (!chan) {
1403         return TCL_ERROR;
1404     }
1405     if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK) {
1406         Tcl_Close(NULL, chan);
1407         return TCL_ERROR;
1408     }
1409
1410     result = CommonWriteGIF(interp, chan, format, blockPtr);
1411     if (Tcl_Close(interp, chan) == TCL_ERROR) {
1412         return TCL_ERROR;
1413     }
1414     return result;
1415 }
1416
1417 #define Mputc(c,handle) Tcl_Write(handle,(char *) &c,1)
1418
1419 static int
1420 CommonWriteGIF(interp, handle, format, blockPtr)
1421     Tcl_Interp *interp;
1422     Tcl_Channel handle;
1423     Tcl_Obj *format;
1424     Tk_PhotoImageBlock *blockPtr;
1425 {
1426     int  resolution;
1427
1428     long  width,height,x;
1429     unsigned char c;
1430     unsigned int top,left;
1431
1432     top = 0;
1433     left = 0;
1434
1435     pixelSize = blockPtr->pixelSize;
1436     greenOffset = blockPtr->offset[1]-blockPtr->offset[0];
1437     blueOffset = blockPtr->offset[2]-blockPtr->offset[0];
1438     alphaOffset = blockPtr->offset[0];
1439     if (alphaOffset < blockPtr->offset[2]) {
1440         alphaOffset = blockPtr->offset[2];
1441     }
1442     if (++alphaOffset < pixelSize) {
1443         alphaOffset -= blockPtr->offset[0];
1444     } else {
1445         alphaOffset = 0;
1446     }
1447
1448     Tcl_Write(handle, (char *) (alphaOffset ? GIF89a : GIF87a), 6);
1449
1450     for (x=0 ; x<MAXCOLORMAPSIZE ; x++) {
1451         mapa[x][CM_RED] = 255;
1452         mapa[x][CM_GREEN] = 255;
1453         mapa[x][CM_BLUE] = 255;
1454     }
1455
1456
1457     width = blockPtr->width;
1458     height = blockPtr->height;
1459     pixelo = blockPtr->pixelPtr + blockPtr->offset[0];
1460     pixelPitch = blockPtr->pitch;
1461     savemap(blockPtr,mapa);
1462     if (num >= MAXCOLORMAPSIZE) {
1463         Tcl_AppendResult(interp, "too many colors", (char *) NULL);
1464         return TCL_ERROR;
1465     }
1466     if (num<2) {
1467         num = 2;
1468     }
1469     c = LSB(width);
1470     Mputc(c,handle);
1471     c = MSB(width);
1472     Mputc(c,handle);
1473     c = LSB(height);
1474     Mputc(c,handle);
1475     c = MSB(height);
1476     Mputc(c,handle);
1477
1478     resolution = 0;
1479     while (num >> resolution) {
1480         resolution++;
1481     }
1482     c = 111 + resolution * 17;
1483     Mputc(c,handle);
1484
1485     num = 1 << resolution;
1486
1487     /*
1488      * background color
1489      */
1490
1491     c = 0;
1492     Mputc(c,handle);
1493
1494     /*
1495      * zero for future expansion.
1496      */
1497
1498     Mputc(c,handle);
1499
1500     for (x=0 ; x<num ; x++) {
1501         c = mapa[x][CM_RED];
1502         Mputc(c,handle);
1503         c = mapa[x][CM_GREEN];
1504         Mputc(c,handle);
1505         c = mapa[x][CM_BLUE];
1506         Mputc(c,handle);
1507     }
1508
1509     /*
1510      * Write out extension for transparent colour index, if necessary.
1511      */
1512
1513     if (alphaOffset) {
1514         c = GIF_EXTENSION;
1515         Mputc(c, handle);
1516         Tcl_Write(handle, "\371\4\1\0\0\0", 7);
1517     }
1518
1519     c = GIF_START;
1520     Mputc(c,handle);
1521     c = LSB(top);
1522     Mputc(c,handle);
1523     c = MSB(top);
1524     Mputc(c,handle);
1525     c = LSB(left);
1526     Mputc(c,handle);
1527     c = MSB(left);
1528     Mputc(c,handle);
1529
1530     c = LSB(width);
1531     Mputc(c,handle);
1532     c = MSB(width);
1533     Mputc(c,handle);
1534
1535     c = LSB(height);
1536     Mputc(c,handle);
1537     c = MSB(height);
1538     Mputc(c,handle);
1539
1540     c = 0;
1541     Mputc(c,handle);
1542     c = resolution;
1543     Mputc(c,handle);
1544
1545     ssize = rsize = blockPtr->width;
1546     csize = blockPtr->height;
1547     compress(resolution+1, handle, ReadValue);
1548
1549     c = 0;
1550     Mputc(c,handle);
1551     c = GIF_TERMINATOR;
1552     Mputc(c,handle);
1553
1554     return TCL_OK;
1555 }
1556
1557 static int
1558 color(red, green, blue, mapa)
1559     int red;
1560     int green;
1561     int blue;
1562     unsigned char mapa[MAXCOLORMAPSIZE][3];
1563 {
1564     int x;
1565     for (x=(alphaOffset != 0) ; x<=MAXCOLORMAPSIZE ; x++) {
1566         if ((mapa[x][CM_RED] == red) && (mapa[x][CM_GREEN] == green) &&
1567                 (mapa[x][CM_BLUE] == blue)) {
1568             return x;
1569         }
1570     }
1571     return -1;
1572 }
1573
1574 \f
1575 static int
1576 nuevo(red, green, blue, mapa)
1577     int red,green,blue;
1578     unsigned char mapa[MAXCOLORMAPSIZE][3];
1579 {
1580     int x = (alphaOffset != 0);
1581     for (; x<=num ; x++) {
1582         if ((mapa[x][CM_RED] == red) && (mapa[x][CM_GREEN] == green) &&
1583                 (mapa[x][CM_BLUE] == blue)) {
1584             return 0;
1585         }
1586     }
1587     return 1;
1588 }
1589
1590 static void
1591 savemap(blockPtr,mapa)
1592     Tk_PhotoImageBlock *blockPtr;
1593     unsigned char mapa[MAXCOLORMAPSIZE][3];
1594 {
1595     unsigned char *colores;
1596     int x,y;
1597     unsigned char red,green,blue;
1598
1599     if (alphaOffset) {
1600         num = 0;
1601         mapa[0][CM_RED] = 0xd9;
1602         mapa[0][CM_GREEN] = 0xd9;
1603         mapa[0][CM_BLUE] = 0xd9;
1604     } else {
1605         num = -1;
1606     }
1607
1608     for(y=0 ; y<blockPtr->height ; y++) {
1609         colores = blockPtr->pixelPtr + blockPtr->offset[0]
1610                 + y * blockPtr->pitch;
1611         for(x=0 ; x<blockPtr->width ; x++) {
1612             if (!alphaOffset || (colores[alphaOffset] != 0)) {
1613                 red = colores[0];
1614                 green = colores[greenOffset];
1615                 blue = colores[blueOffset];
1616                 if (nuevo(red,green,blue,mapa)) {
1617                     num++;
1618                     if (num >= MAXCOLORMAPSIZE) {
1619                         return;
1620                     }
1621                     mapa[num][CM_RED] = red;
1622                     mapa[num][CM_GREEN] = green;
1623                     mapa[num][CM_BLUE] = blue;
1624                 }
1625             }
1626             colores += pixelSize;
1627         }
1628     }
1629     return;
1630 }
1631
1632 static int
1633 ReadValue()
1634 {
1635     unsigned int col;
1636
1637     if (csize == 0) {
1638         return EOF;
1639     }
1640     if (alphaOffset && (pixelo[alphaOffset] == 0)) {
1641         col = 0;
1642     } else {
1643         col = color(pixelo[0], pixelo[greenOffset], pixelo[blueOffset], mapa);
1644     }
1645     pixelo += pixelSize;
1646     if (--ssize <= 0) {
1647         ssize = rsize;
1648         csize--;
1649         pixelo += pixelPitch - (rsize * pixelSize);
1650     }
1651
1652     return col;
1653 }
1654
1655 \f
1656
1657 /*
1658  *-----------------------------------------------------------------------
1659  *
1660  * miGIF Compression - mouse and ivo's GIF-compatible compression
1661  *
1662  *              -run length encoding compression routines-
1663  *
1664  * Copyright (C) 1998 Hutchison Avenue Software Corporation
1665  *               http://www.hasc.com
1666  *               info@hasc.com
1667  *
1668  * Permission to use, copy, modify, and distribute this software and
1669  * its documentation for any purpose and without fee is hereby
1670  * granted, provided that the above copyright notice appear in all
1671  * copies and that both that copyright notice and this permission
1672  * notice appear in supporting documentation.  This software is
1673  * provided "AS IS." The Hutchison Avenue Software Corporation
1674  * disclaims all warranties, either express or implied, including but
1675  * not limited to implied warranties of merchantability and fitness
1676  * for a particular purpose, with respect to this code and
1677  * accompanying documentation.
1678  *
1679  * The miGIF compression routines do not, strictly speaking, generate
1680  * files conforming to the GIF spec, since the image data is not
1681  * LZW-compressed (this is the point: in order to avoid transgression
1682  * of the Unisys patent on the LZW algorithm.)  However, miGIF
1683  * generates data streams that any reasonably sane LZW decompresser
1684  * will decompress to what we want.
1685  *
1686  * miGIF compression uses run length encoding. It compresses
1687  * horizontal runs of pixels of the same color. This type of
1688  * compression gives good results on images with many runs, for
1689  * example images with lines, text and solid shapes on a solid-colored
1690  * background. It gives little or no compression on images with few
1691  * runs, for example digital or scanned photos.
1692  *
1693  *                               der Mouse
1694  *                      mouse@rodents.montreal.qc.ca
1695  *            7D C8 61 52 5D E7 2D 39  4E F1 31 3E E8 B3 27 4B
1696  *
1697  *                             ivo@hasc.com
1698  *
1699  * The Graphics Interchange Format(c) is the Copyright property of
1700  * CompuServe Incorporated.  GIF(sm) is a Service Mark property of
1701  * CompuServe Incorporated.
1702  *
1703  *-----------------------------------------------------------------------
1704  */
1705
1706 static int rl_pixel;
1707 static int rl_basecode;
1708 static int rl_count;
1709 static int rl_table_pixel;
1710 static int rl_table_max;
1711 static int just_cleared;
1712 static int out_bits;
1713 static int out_bits_init;
1714 static int out_count;
1715 static int out_bump;
1716 static int out_bump_init;
1717 static int out_clear;
1718 static int out_clear_init;
1719 static int max_ocodes;
1720 static int code_clear;
1721 static int code_eof;
1722 static unsigned int obuf;
1723 static int obits;
1724 static Tcl_Channel ofile;
1725 static unsigned char oblock[256];
1726 static int oblen;
1727
1728 /*
1729  * Used only when debugging GIF compression code
1730  */
1731 /* #define MIGIF_DEBUGGING_ENVARS */
1732
1733 #ifdef MIGIF_DEBUGGING_ENVARS
1734
1735 static int verbose_set = 0;
1736 static int verbose;
1737 #define MIGIF_VERBOSE (verbose_set?verbose:set_verbose())
1738 #define DEBUGMSG(printf_args) if (MIGIF_VERBOSE) { printf printf_args; }
1739
1740 static int
1741 set_verbose(void)
1742 {
1743     verbose = !!getenv("MIGIF_VERBOSE");
1744     verbose_set = 1;
1745     return verbose;
1746 }
1747
1748 static CONST char *
1749 binformat(v, nbits)
1750     unsigned int v;
1751     int nbits;
1752 {
1753     static char bufs[8][64];
1754     static int bhand = 0;
1755     unsigned int bit;
1756     int bno;
1757     char *bp;
1758
1759     bhand--;
1760     if (bhand < 0) {
1761         bhand = (sizeof(bufs) / sizeof(bufs[0])) - 1;
1762     }
1763     bp = &bufs[bhand][0];
1764     for (bno=nbits-1,bit=((unsigned int)1)<<bno ; bno>=0 ; bno--,bit>>=1) {
1765         *bp++ = (v & bit) ? '1' : '0';
1766         if (((bno&3) == 0) && (bno != 0)) {
1767             *bp++ = '.';
1768         }
1769     }
1770     *bp = '\0';
1771     return &bufs[bhand][0];
1772 }
1773
1774 #else
1775
1776 #define MIGIF_VERBOSE 0
1777 #define DEBUGMSG(printf_args) /* do nothing */
1778
1779 #endif
1780
1781 static void
1782 write_block()
1783 {
1784     int i;
1785     unsigned char c;
1786
1787     if (MIGIF_VERBOSE) {
1788         printf("write_block %d:", oblen);
1789         for (i=0 ; i<oblen ; i++) {
1790             printf(" %02x", oblock[i]);
1791         }
1792         printf("\n");
1793     }
1794     c = oblen;
1795     Tcl_Write(ofile, (char *) &c, 1);
1796     Tcl_Write(ofile, (char *) &oblock[0], oblen);
1797     oblen = 0;
1798 }
1799
1800 static void
1801 block_out(c)
1802     unsigned char c;
1803 {
1804     DEBUGMSG(("block_out %s\n", binformat(c, 8)));
1805     oblock[oblen++] = c;
1806     if (oblen >= 255) {
1807         write_block();
1808     }
1809 }
1810
1811 static void
1812 block_flush()
1813 {
1814     DEBUGMSG(("block_flush\n"));
1815     if (oblen > 0) {
1816         write_block();
1817     }
1818 }
1819
1820 static void
1821 output(val)
1822     int val;
1823 {
1824     DEBUGMSG(("output %s [%s %d %d]\n", binformat(val, out_bits),
1825             binformat(obuf, obits), obits, out_bits));
1826     obuf |= val << obits;
1827     obits += out_bits;
1828     while (obits >= 8) {
1829         block_out(obuf&0xff);
1830         obuf >>= 8;
1831         obits -= 8;
1832     }
1833     DEBUGMSG(("output leaving [%s %d]\n", binformat(obuf, obits), obits));
1834 }
1835
1836 static void
1837 output_flush()
1838 {
1839     DEBUGMSG(("output_flush\n"));
1840     if (obits > 0) {
1841         block_out(obuf);
1842     }
1843     block_flush();
1844 }
1845
1846 static void
1847 did_clear()
1848 {
1849     DEBUGMSG(("did_clear\n"));
1850     out_bits = out_bits_init;
1851     out_bump = out_bump_init;
1852     out_clear = out_clear_init;
1853     out_count = 0;
1854     rl_table_max = 0;
1855     just_cleared = 1;
1856 }
1857
1858 static void
1859 output_plain(c)
1860     int c;
1861 {
1862     DEBUGMSG(("output_plain %s\n", binformat(c, out_bits)));
1863     just_cleared = 0;
1864     output(c);
1865     out_count++;
1866     if (out_count >= out_bump) {
1867         out_bits++;
1868         out_bump += 1 << (out_bits - 1);
1869     }
1870     if (out_count >= out_clear) {
1871         output(code_clear);
1872         did_clear();
1873     }
1874 }
1875
1876 static unsigned int
1877 isqrt(x)
1878     unsigned int x;
1879 {
1880     unsigned int r;
1881     unsigned int v;
1882
1883     if (x < 2) {
1884         return x;
1885     }
1886     for (v=x,r=1 ; v ; v>>=2,r<<=1);
1887     while (1) {
1888         v = ((x / r) + r) / 2;
1889         if (v==r || v==r+1) {
1890             return r;
1891         }
1892         r = v;
1893     }
1894 }
1895
1896 static unsigned int
1897 compute_triangle_count(count, nrepcodes)
1898     unsigned int count;
1899     unsigned int nrepcodes;
1900 {
1901     unsigned int perrep;
1902     unsigned int cost;
1903
1904     cost = 0;
1905     perrep = (nrepcodes * (nrepcodes+1)) / 2;
1906     while (count >= perrep) {
1907         cost += nrepcodes;
1908         count -= perrep;
1909     }
1910     if (count > 0) {
1911         unsigned int n;
1912         n = isqrt(count);
1913         while (n*(n+1) >= 2*count) {
1914             n--;
1915         }
1916         while (n*(n+1) < 2*count) {
1917             n++;
1918         }
1919         cost += n;
1920     }
1921     return cost;
1922 }
1923
1924 static void
1925 max_out_clear()
1926 {
1927     out_clear = max_ocodes;
1928 }
1929
1930 static void
1931 reset_out_clear()
1932 {
1933     out_clear = out_clear_init;
1934     if (out_count >= out_clear) {
1935         output(code_clear);
1936         did_clear();
1937     }
1938 }
1939
1940 static void
1941 rl_flush_fromclear(count)
1942     int count;
1943 {
1944     int n;
1945
1946     DEBUGMSG(("rl_flush_fromclear %d\n", count));
1947     max_out_clear();
1948     rl_table_pixel = rl_pixel;
1949     n = 1;
1950     while (count > 0) {
1951         if (n == 1) {
1952             rl_table_max = 1;
1953             output_plain(rl_pixel);
1954             count--;
1955         } else if (count >= n) {
1956             rl_table_max = n;
1957             output_plain(rl_basecode+n-2);
1958             count -= n;
1959         } else if (count == 1) {
1960             rl_table_max++;
1961             output_plain(rl_pixel);
1962             count = 0;
1963         } else {
1964             rl_table_max++;
1965             output_plain(rl_basecode+count-2);
1966             count = 0;
1967         }
1968         if (out_count == 0) {
1969             n = 1;
1970         } else {
1971             n++;
1972         }
1973     }
1974     reset_out_clear();
1975     DEBUGMSG(("rl_flush_fromclear leaving table_max=%d\n", rl_table_max));
1976 }
1977
1978 static void
1979 rl_flush_clearorrep(count)
1980     int count;
1981 {
1982     int withclr;
1983
1984     DEBUGMSG(("rl_flush_clearorrep %d\n", count));
1985     withclr = 1 + compute_triangle_count(count, max_ocodes);
1986     if (withclr < count) {
1987         output(code_clear);
1988         did_clear();
1989         rl_flush_fromclear(count);
1990     } else {
1991         for (; count>0 ; count--) {
1992             output_plain(rl_pixel);
1993         }
1994     }
1995 }
1996
1997 static void
1998 rl_flush_withtable(count)
1999     int count;
2000 {
2001     int repmax;
2002     int repleft;
2003     int leftover;
2004
2005     DEBUGMSG(("rl_flush_withtable %d\n", count));
2006     repmax = count / rl_table_max;
2007     leftover = count % rl_table_max;
2008     repleft = (leftover ? 1 : 0);
2009     if (out_count+repmax+repleft > max_ocodes) {
2010         repmax = max_ocodes - out_count;
2011         leftover = count - (repmax * rl_table_max);
2012         repleft = 1 + compute_triangle_count(leftover, max_ocodes);
2013     }
2014     DEBUGMSG(("rl_flush_withtable repmax=%d leftover=%d repleft=%d\n",
2015             repmax, leftover, repleft));
2016     if (1+(int)compute_triangle_count(count, max_ocodes) < repmax+repleft) {
2017         output(code_clear);
2018         did_clear();
2019         rl_flush_fromclear(count);
2020         return;
2021     }
2022     max_out_clear();
2023     for (; repmax>0 ; repmax--) {
2024         output_plain(rl_basecode + rl_table_max - 2);
2025     }
2026     if (leftover) {
2027         if (just_cleared) {
2028             rl_flush_fromclear(leftover);
2029         } else if (leftover == 1) {
2030             output_plain(rl_pixel);
2031         } else {
2032             output_plain(rl_basecode + leftover - 2);
2033         }
2034     }
2035     reset_out_clear();
2036 }
2037
2038 static void
2039 rl_flush()
2040 {
2041     DEBUGMSG(("rl_flush [ %d %d\n", rl_count, rl_pixel));
2042     if (rl_count == 1) {
2043         output_plain(rl_pixel);
2044         rl_count = 0;
2045         DEBUGMSG(("rl_flush ]\n"));
2046         return;
2047     }
2048     if (just_cleared) {
2049         rl_flush_fromclear(rl_count);
2050     } else if ((rl_table_max < 2) || (rl_table_pixel != rl_pixel)) {
2051         rl_flush_clearorrep(rl_count);
2052     } else {
2053         rl_flush_withtable(rl_count);
2054     }
2055     DEBUGMSG(("rl_flush ]\n"));
2056     rl_count = 0;
2057 }
2058
2059
2060 static void
2061 compress(init_bits, handle, readValue)
2062     int init_bits;
2063     Tcl_Channel handle;
2064     ifunptr readValue;
2065 {
2066     int c;
2067
2068     ofile = handle;
2069     obuf = 0;
2070     obits = 0;
2071     oblen = 0;
2072     code_clear = 1 << (init_bits - 1);
2073     code_eof = code_clear + 1;
2074     rl_basecode = code_eof + 1;
2075     out_bump_init = (1 << (init_bits - 1)) - 1;
2076     /*
2077      * For images with a lot of runs, making out_clear_init larger
2078      * will give better compression.
2079      */
2080     out_clear_init = (init_bits <= 3) ? 9 : (out_bump_init-1);
2081 #ifdef MIGIF_DEBUGGING_ENVARS
2082     {
2083         const char *ocienv;
2084         ocienv = getenv("MIGIF_OUT_CLEAR_INIT");
2085         if (ocienv) {
2086             out_clear_init = atoi(ocienv);
2087             DEBUGMSG(("[overriding out_clear_init to %d]\n", out_clear_init));
2088         }
2089     }
2090 #endif
2091     out_bits_init = init_bits;
2092     max_ocodes = (1 << GIFBITS) - ((1 << (out_bits_init - 1)) + 3);
2093     did_clear();
2094     output(code_clear);
2095     rl_count = 0;
2096     while (1) {
2097         c = readValue();
2098         if ((rl_count > 0) && (c != rl_pixel)) {
2099             rl_flush();
2100         }
2101         if (c == EOF) {
2102             break;
2103         }
2104         if (rl_pixel == c) {
2105             rl_count++;
2106         } else {
2107             rl_pixel = c;
2108             rl_count = 1;
2109         }
2110     }
2111     output(code_eof);
2112     output_flush();
2113 }
2114
2115 /*
2116  *-----------------------------------------------------------------------
2117  *
2118  * End of miGIF section  - See copyright notice at start of section.
2119  *
2120  *-----------------------------------------------------------------------
2121  */