More warning suppressions
[sxemacs] / src / ui / glyphs-eimage.c
1 /* EImage-specific Lisp objects.
2    Copyright (C) 1993, 1994, 1998 Free Software Foundation, Inc.
3    Copyright (C) 1995 Board of Trustees, University of Illinois.
4    Copyright (C) 1995 Tinker Systems
5    Copyright (C) 1995, 1996 Ben Wing
6    Copyright (C) 1995 Sun Microsystems
7
8 This file is part of SXEmacs
9
10 SXEmacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
14
15 SXEmacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 GNU General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
22
23
24 /* Synched up with: Not in FSF. */
25
26 /* Original author: Jamie Zawinski for 19.8
27    font-truename stuff added by Jamie Zawinski for 19.10
28    subwindow support added by Chuck Thompson
29    additional XPM support added by Chuck Thompson
30    initial X-Face support added by Stig
31    rewritten/restructured by Ben Wing for 19.12/19.13
32    GIF/JPEG support added by Ben Wing for 19.14
33    PNG support added by Bill Perry for 19.14
34    Improved GIF/JPEG support added by Bill Perry for 19.14
35    Cleanup/simplification of error handling by Ben Wing for 19.14
36    Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
37    GIF support changed to external Gifreader lib by Jareth Hein for 21.0
38    Many changes for color work and optimizations by Jareth Hein for 21.0
39    Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0
40    TIFF code by Jareth Hein for 21.0
41    Generalization for ms-windows by Andy Piper for 21.0
42    TODO:
43    Convert images.el to C and stick it in here?
44  */
45
46 #include <config.h>
47 #include "lisp.h"
48 #include "lstream.h"
49 #include "console.h"
50 #include "device.h"
51 #include "faces.h"
52 #include "glyphs.h"
53 #include "objects.h"
54
55 #include "buffer.h"
56 #include "frame.h"
57 #include "opaque.h"
58 #include "window.h"
59
60 #include "sysfile.h"
61
62 #if defined WITH_PNG && defined HAVE_PNG
63 # ifdef __cplusplus
64 extern "C" {
65 # endif
66 # include <png.h>
67 # ifdef __cplusplus
68 }
69 # endif
70 #else  /* !PNG */
71 # include <setjmp.h>
72 #endif  /* PNG */
73 #ifdef FILE_CODING
74 #include "mule/file-coding.h"
75 #endif
76
77 #ifdef HAVE_FFI
78 #include "effi.h"
79 #endif  /* HAVE_FFI */
80
81 #ifdef HAVE_TIFF
82 DEFINE_IMAGE_INSTANTIATOR_FORMAT(tiff);
83 Lisp_Object Qtiff;
84 #endif
85
86 #ifdef HAVE_JPEG
87 DEFINE_IMAGE_INSTANTIATOR_FORMAT(jpeg);
88 Lisp_Object Qjpeg;
89 #endif
90
91 #ifdef HAVE_GIF
92 DEFINE_IMAGE_INSTANTIATOR_FORMAT(gif);
93 Lisp_Object Qgif;
94 #endif
95
96 #if defined WITH_PNG && defined HAVE_PNG
97 DEFINE_IMAGE_INSTANTIATOR_FORMAT(png);
98 Lisp_Object Qpng;
99 #endif  /* PNG */
100
101 #if 1
102 DEFINE_IMAGE_INSTANTIATOR_FORMAT(rawrgb);
103 Lisp_Object Qrawrgb;
104
105 DEFINE_IMAGE_INSTANTIATOR_FORMAT(rawrgba);
106 Lisp_Object Qrawrgba;
107 #endif
108 \f
109 #ifdef HAVE_JPEG
110
111 /**********************************************************************
112  *                             JPEG                                   *
113  **********************************************************************/
114
115 #ifdef __cplusplus
116 extern "C" {
117 #endif
118 #include <jpeglib.h>
119 #include <jerror.h>
120 #ifdef __cplusplus
121 }
122 #endif
123 /*#define USE_TEMP_FILES_FOR_JPEG_IMAGES 1*/
124     static void jpeg_validate(Lisp_Object instantiator)
125 {
126         file_or_data_must_be_present(instantiator);
127 }
128
129 static Lisp_Object
130 jpeg_normalize(Lisp_Object inst, Lisp_Object console_type,
131                Lisp_Object dest_mask)
132 {
133         return simple_image_type_normalize(inst, console_type, Qjpeg);
134 }
135
136 static int jpeg_possible_dest_types(void)
137 {
138         return IMAGE_COLOR_PIXMAP_MASK;
139 }
140
141 /* To survive the otherwise baffling complexity of making sure
142    everything gets cleaned up in the presence of an error, we
143    use an unwind_protect(). */
144
145 struct jpeg_unwind_data {
146         /* Stream that we need to close */
147         FILE *instream;
148         /* Object that holds state info for JPEG decoding */
149         struct jpeg_decompress_struct *cinfo_ptr;
150         /* EImage data */
151         unsigned char *eimage;
152 };
153
154 static Lisp_Object jpeg_instantiate_unwind(Lisp_Object unwind_obj)
155 {
156         struct jpeg_unwind_data *data =
157             (struct jpeg_unwind_data *)get_opaque_ptr(unwind_obj);
158
159         free_opaque_ptr(unwind_obj);
160         if (data->cinfo_ptr)
161                 jpeg_destroy_decompress(data->cinfo_ptr);
162
163         if (data->instream)
164                 fclose(data->instream);
165
166         if (data->eimage)
167                 xfree(data->eimage);
168
169         return Qnil;
170 }
171
172 /*
173  * ERROR HANDLING:
174  *
175  * The JPEG library's standard error handler (jerror.c) is divided into
176  * several "methods" which you can override individually.  This lets you
177  * adjust the behavior without duplicating a lot of code, which you might
178  * have to update with each future release.
179  *
180  * Our example here shows how to override the "error_exit" method so that
181  * control is returned to the library's caller when a fatal error occurs,
182  * rather than calling exit() as the standard error_exit method does.
183  *
184  * We use C's setjmp/longjmp facility to return control.  This means that the
185  * routine which calls the JPEG library must first execute a setjmp() call to
186  * establish the return point.  We want the replacement error_exit to do a
187  * longjmp().  But we need to make the setjmp buffer accessible to the
188  * error_exit routine.  To do this, we make a private extension of the
189  * standard JPEG error handler object.  (If we were using C++, we'd say we
190  * were making a subclass of the regular error handler.)
191  *
192  * Here's the extended error handler struct:
193  */
194
195 struct my_jpeg_error_mgr {
196         struct jpeg_error_mgr pub;      /* "public" fields */
197         jmp_buf setjmp_buffer;  /* for return to caller */
198 };
199
200 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
201 METHODDEF(void)
202 #else
203 METHODDEF void
204 #endif
205 our_init_source(j_decompress_ptr cinfo)
206 {
207 }
208
209 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
210 METHODDEF(boolean)
211 #else
212 METHODDEF boolean
213 #endif
214 our_fill_input_buffer(j_decompress_ptr cinfo)
215 {
216         /* Insert a fake EOI marker */
217         struct jpeg_source_mgr *src = cinfo->src;
218         static JOCTET buffer[2];
219
220         buffer[0] = (JOCTET) 0xFF;
221         buffer[1] = (JOCTET) JPEG_EOI;
222
223         src->next_input_byte = buffer;
224         src->bytes_in_buffer = 2;
225         return TRUE;
226 }
227
228 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
229 METHODDEF(void)
230 #else
231 METHODDEF void
232 #endif
233 our_skip_input_data(j_decompress_ptr cinfo, long num_bytes)
234 {
235         struct jpeg_source_mgr *src = NULL;
236
237         src = (struct jpeg_source_mgr *)cinfo->src;
238
239         if (!src) {
240                 return;
241         } else if (num_bytes > (long)src->bytes_in_buffer) {
242                 ERREXIT(cinfo, JERR_INPUT_EOF);
243          /*NOTREACHED*/}
244
245         src->bytes_in_buffer -= num_bytes;
246         src->next_input_byte += num_bytes;
247 }
248
249 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
250 METHODDEF(void)
251 #else
252 METHODDEF void
253 #endif
254 our_term_source(j_decompress_ptr cinfo)
255 {
256 }
257
258 typedef struct {
259         struct jpeg_source_mgr pub;
260 } our_jpeg_source_mgr;
261
262 static void
263 jpeg_memory_src(j_decompress_ptr cinfo, const JOCTET *data, size_t len)
264 {
265         struct jpeg_source_mgr *src;
266
267         if (cinfo->src == NULL) {       /* first time for this JPEG object? */
268                 cinfo->src = (struct jpeg_source_mgr *)
269                     (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo,
270                                                 JPOOL_PERMANENT,
271                                                 sizeof(our_jpeg_source_mgr));
272                 src = (struct jpeg_source_mgr *)cinfo->src;
273                 src->next_input_byte = data;
274         }
275         src = (struct jpeg_source_mgr *)cinfo->src;
276         src->init_source = our_init_source;
277         src->fill_input_buffer = our_fill_input_buffer;
278         src->skip_input_data = our_skip_input_data;
279         /* use default method */
280         src->resync_to_restart = jpeg_resync_to_restart;
281         src->term_source = our_term_source;
282         src->bytes_in_buffer = len;
283         src->next_input_byte = data;
284         return;
285 }
286
287 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
288 METHODDEF(void)
289 #else
290 METHODDEF void
291 #endif
292 my_jpeg_error_exit(j_common_ptr cinfo)
293 {
294         /* cinfo->err really points to a my_error_mgr struct, so coerce pointer */
295         struct my_jpeg_error_mgr *myerr =
296             (struct my_jpeg_error_mgr *)cinfo->err;
297
298         /* Return control to the setjmp point */
299         longjmp(myerr->setjmp_buffer, 1);
300 }
301
302 #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
303 METHODDEF(void)
304 #else
305 METHODDEF void
306 #endif
307 my_jpeg_output_message(j_common_ptr cinfo)
308 {
309         char buffer[JMSG_LENGTH_MAX];
310
311         /* Create the message */
312         (*cinfo->err->format_message) (cinfo, buffer);
313         warn_when_safe(Qjpeg, Qinfo, "%s", buffer);
314 }
315
316 /* The code in this routine is based on example.c from the JPEG library
317    source code and from gif_instantiate() */
318 static void
319 jpeg_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
320                  Lisp_Object pointer_fg, Lisp_Object pointer_bg,
321                  int dest_mask, Lisp_Object domain)
322 {
323         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
324         /* It is OK for the unwind data to be local to this function,
325            because the unwind-protect is always executed when this
326            stack frame is still valid. */
327         struct jpeg_unwind_data unwind;
328         int speccount = specpdl_depth();
329
330         /* This struct contains the JPEG decompression parameters and pointers to
331          * working space (which is allocated as needed by the JPEG library).
332          */
333         struct jpeg_decompress_struct cinfo;
334         /* We use our private extension JPEG error handler.
335          * Note that this struct must live as long as the main JPEG parameter
336          * struct, to avoid dangling-pointer problems.
337          */
338         struct my_jpeg_error_mgr jerr;
339
340         /* Step -1: First record our unwind-protect, which will clean up after
341            any exit, normal or not */
342
343         xzero(unwind);
344         record_unwind_protect(jpeg_instantiate_unwind,
345                               make_opaque_ptr(&unwind));
346
347         /* Step 1: allocate and initialize JPEG decompression object */
348
349         /* We set up the normal JPEG error routines, then override error_exit. */
350         cinfo.err = jpeg_std_error(&jerr.pub);
351         jerr.pub.error_exit = my_jpeg_error_exit;
352         jerr.pub.output_message = my_jpeg_output_message;
353
354         /* Establish the setjmp return context for my_error_exit to use. */
355         if (setjmp(jerr.setjmp_buffer)) {
356                 /* If we get here, the JPEG code has signaled an error.
357                  * We need to clean up the JPEG object, close the input file, and return.
358                  */
359
360                 {
361                         Lisp_Object errstring;
362                         char buffer[JMSG_LENGTH_MAX];
363
364                         /* Create the message */
365                         (*cinfo.err->format_message) ((j_common_ptr) & cinfo,
366                                                       buffer);
367                         errstring = build_string(buffer);
368
369                         signal_image_error_2("JPEG decoding error",
370                                              errstring, instantiator);
371                 }
372         }
373
374         /* Now we can initialize the JPEG decompression object. */
375         jpeg_create_decompress(&cinfo);
376         unwind.cinfo_ptr = &cinfo;
377
378         /* Step 2: specify data source (eg, a file) */
379
380         {
381                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
382                 const Extbyte *bytes;
383                 Extcount len;
384
385 #ifdef HAVE_FFI
386                 if (EFFIOP(data)) {
387                         bytes = XEFFIO(data)->fostorage;
388                         len = XEFFIO(data)->storage_size;
389                 } else
390 #endif  /* HAVE_FFI */
391                 /* #### This is a definite problem under Mule due to the amount of
392                    stack data it might allocate.  Need to be able to convert and
393                    write out to a file. */
394                 TO_EXTERNAL_FORMAT(LISP_STRING, data, ALLOCA, (bytes, len),
395                                    Qbinary);
396                 jpeg_memory_src(&cinfo, (const JOCTET*)bytes, len);
397         }
398
399         /* Step 3: read file parameters with jpeg_read_header() */
400
401         jpeg_read_header(&cinfo, TRUE);
402         /* We can ignore the return value from jpeg_read_header since
403          *   (a) suspension is not possible with the stdio data source, and
404          *   (b) we passed TRUE to reject a tables-only JPEG file as an error.
405          * See libjpeg.doc for more info.
406          */
407
408         {
409                 int jpeg_gray = 0;      /* if we're dealing with a grayscale */
410                 /* Step 4: set parameters for decompression.   */
411
412                 /* Now that we're using EImages, send all data as 24bit color.
413                    The backend routine will take care of any necessary reductions.
414                    We do have to handle the grayscale case ourselves, however. */
415                 if (cinfo.jpeg_color_space == JCS_GRAYSCALE) {
416                         cinfo.out_color_space = JCS_GRAYSCALE;
417                         jpeg_gray = 1;
418                 } else {
419                         /* we're relying on the jpeg driver to do any other conversions,
420                            or signal an error if the conversion isn't supported. */
421                         cinfo.out_color_space = JCS_RGB;
422                 }
423
424                 /* Step 5: Start decompressor */
425                 jpeg_start_decompress(&cinfo);
426
427                 /* Step 6: Read in the data and put into EImage format (8bit RGB
428                  * triples) */
429                 unwind.eimage = xmalloc_atomic(cinfo.output_width *
430                                                cinfo.output_height * 3);
431                 if (!unwind.eimage) {
432                         signal_image_error
433                             ("Unable to allocate enough memory for image",
434                              instantiator);
435                 }
436
437                 {
438                         JSAMPARRAY row_buffer;  /* Output row buffer */
439                         JSAMPLE *jp;
440                         int row_stride; /* physical row width in output buffer */
441                         unsigned char *op = unwind.eimage;
442
443                         /* We may need to do some setup of our own at this point
444                          * before reading the data.  After
445                          * jpeg_start_decompress() we have the correct scaled
446                          * output image dimensions available
447                          * We need to make an output work buffer of the right
448                          * size. */
449                         /* JSAMPLEs per row in output buffer. */
450                         row_stride = cinfo.output_width *
451                                 cinfo.output_components;
452                         /* Make a one-row-high sample array that will go away
453                          * when done with image */
454                         row_buffer = ((*cinfo.mem->alloc_sarray)
455                                       ((j_common_ptr) & cinfo, JPOOL_IMAGE,
456                                        row_stride, 1));
457
458                         /* Here we use the library's state variable
459                          * cinfo.output_scanline as the loop counter, so that
460                          * we don't have to keep track ourselves. */
461                         while (cinfo.output_scanline < cinfo.output_height) {
462                                 unsigned int i;
463
464                                 /* jpeg_read_scanlines expects an array of
465                                  * pointers to scanlines.
466                                  * Here the array is only one element long,
467                                  * but you could ask for more than one
468                                  * scanline at a time if that's more
469                                  * convenient. */
470                                 (void)jpeg_read_scanlines(&cinfo, row_buffer,
471                                                           1);
472                                 jp = row_buffer[0];
473                                 for (i = 0; i < cinfo.output_width; i++) {
474                                         int clr;
475                                         if (jpeg_gray) {
476                                                 unsigned char val;
477 #if (BITS_IN_JSAMPLE == 8)
478                                                 val = (unsigned char)*jp++;
479 #else                           /* other option is 12 */
480                                                 val =
481                                                     (unsigned char)(*jp++ >> 4);
482 #endif
483                                                 /* copy the same value
484                                                  * into RGB */
485                                                 for (clr = 0; clr < 3; clr++) {
486                                                         *op++ = val;
487                                                 }
488                                         } else {
489                                                 for (clr = 0; clr < 3; clr++) {
490 #if (BITS_IN_JSAMPLE == 8)
491                                                         *op++ = (unsigned char)
492                                                                 *jp++;
493 #else  /* other option is 12 */
494                                                         *op++ = (unsigned char)
495                                                                 (*jp++ >> 4);
496 #endif
497                                                 }
498                                         }
499                                 }
500                         }
501                 }
502         }
503
504         /* Step 6.5: Create the pixmap and set up the image instance */
505         /* now instantiate */
506         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
507                       init_image_instance_from_eimage,
508                       (ii, cinfo.output_width, cinfo.output_height, 1,
509                        unwind.eimage, dest_mask, instantiator, domain));
510
511         /* Step 7: Finish decompression */
512
513         jpeg_finish_decompress(&cinfo);
514         /* We can ignore the return value since suspension is not possible
515          * with the stdio data source.
516          */
517
518         /* And we're done! */
519         /* This will clean up everything else. */
520         unbind_to(speccount, Qnil);
521 }
522
523 #endif                          /* HAVE_JPEG */
524 \f
525 #ifdef HAVE_GIF
526 /**********************************************************************
527  *                               GIF                                  *
528  **********************************************************************/
529
530 #include "gifrlib.h"
531
532 static void gif_validate(Lisp_Object instantiator)
533 {
534         file_or_data_must_be_present(instantiator);
535 }
536
537 static Lisp_Object
538 gif_normalize(Lisp_Object inst, Lisp_Object console_type, Lisp_Object dest_mask)
539 {
540         return simple_image_type_normalize(inst, console_type, Qgif);
541 }
542
543 static int gif_possible_dest_types(void)
544 {
545         return IMAGE_COLOR_PIXMAP_MASK;
546 }
547
548 /* To survive the otherwise baffling complexity of making sure
549    everything gets cleaned up in the presence of an error, we
550    use an unwind_protect(). */
551
552 struct gif_unwind_data {
553         unsigned char *eimage;
554         /* Object that holds the decoded data from a GIF file */
555         GifFileType *giffile;
556 };
557
558 static Lisp_Object gif_instantiate_unwind(Lisp_Object unwind_obj)
559 {
560         struct gif_unwind_data *data =
561             (struct gif_unwind_data *)get_opaque_ptr(unwind_obj);
562
563         free_opaque_ptr(unwind_obj);
564         if (data->giffile) {
565                 DGifCloseFile(data->giffile);
566                 GifFree(data->giffile);
567         }
568         if (data->eimage)
569                 xfree(data->eimage);
570
571         return Qnil;
572 }
573
574 typedef struct gif_memory_storage {
575         Extbyte *bytes;         /* The data       */
576         Extcount len;           /* How big is it? */
577         int index;              /* Where are we?  */
578 } gif_memory_storage;
579
580 static size_t gif_read_from_memory(GifByteType * buf, size_t size, VoidPtr data)
581 {
582         gif_memory_storage *mem = (gif_memory_storage *) data;
583
584         if ((ssize_t) size > (mem->len - mem->index))
585                 return (size_t) - 1;
586         memcpy(buf, mem->bytes + mem->index, size);
587         mem->index = mem->index + size;
588         return size;
589 }
590
591 static int gif_memory_close(VoidPtr data)
592 {
593         return 0;
594 }
595
596 struct gif_error_struct {
597         const char *err_str;    /* return the error string */
598         jmp_buf setjmp_buffer;  /* for return to caller */
599 };
600
601 static void gif_error_func(const char *err_str, VoidPtr error_ptr)
602 {
603         struct gif_error_struct *error_data =
604             (struct gif_error_struct *)error_ptr;
605
606         /* return to setjmp point */
607         error_data->err_str = err_str;
608         longjmp(error_data->setjmp_buffer, 1);
609 }
610
611 static void
612 gif_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
613                 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
614                 int dest_mask, Lisp_Object domain)
615 {
616         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
617         /* It is OK for the unwind data to be local to this function,
618            because the unwind-protect is always executed when this
619            stack frame is still valid. */
620         struct gif_unwind_data unwind;
621         int speccount = specpdl_depth();
622         gif_memory_storage mem_struct;
623         struct gif_error_struct gif_err;
624         Extbyte *bytes;
625         Extcount len;
626         int height = 0;
627         int width = 0;
628
629         xzero(unwind);
630         record_unwind_protect(gif_instantiate_unwind, make_opaque_ptr(&unwind));
631
632         /* 1. Now decode the data. */
633
634         {
635                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
636
637                 assert(!NILP(data));
638
639                 if (!(unwind.giffile = GifSetup()))
640                         signal_image_error
641                             ("Insufficient memory to instantiate GIF image",
642                              instantiator);
643
644                 /* set up error facilities */
645                 if (setjmp(gif_err.setjmp_buffer)) {
646                         /* An error was signaled. No clean up is needed, as unwind handles that
647                            for us.  Just pass the error along. */
648                         Lisp_Object errstring;
649                         errstring = build_string(gif_err.err_str);
650                         signal_image_error_2("GIF decoding error", errstring,
651                                              instantiator);
652                 }
653                 GifSetErrorFunc(unwind.giffile, (Gif_error_func) gif_error_func,
654                                 (VoidPtr) & gif_err);
655
656 #ifdef HAVE_FFI
657                 if (EFFIOP(data)) {
658                         bytes = XEFFIO(data)->fostorage;
659                         len = XEFFIO(data)->storage_size;
660                 } else
661 #endif  /* HAVE_FFI */
662                 TO_EXTERNAL_FORMAT(LISP_STRING, data, ALLOCA, (bytes, len),
663                                    Qbinary);
664                 mem_struct.bytes = bytes;
665                 mem_struct.len = len;
666                 mem_struct.index = 0;
667                 GifSetReadFunc(unwind.giffile, gif_read_from_memory,
668                                (VoidPtr) & mem_struct);
669                 GifSetCloseFunc(unwind.giffile, gif_memory_close,
670                                 (VoidPtr) & mem_struct);
671                 DGifInitRead(unwind.giffile);
672
673                 /* Then slurp the image into memory, decoding along the way.
674                    The result is the image in a simple one-byte-per-pixel
675                    format (#### the GIF routines only support 8-bit GIFs,
676                    it appears). */
677                 DGifSlurp(unwind.giffile);
678         }
679
680         /* 3. Now create the EImage(s) */
681         {
682                 ColorMapObject *cmo = unwind.giffile->SColorMap;
683                 int i, j, row, pass, interlace, slice;
684                 unsigned char *eip;
685                 /* interlaced gifs have rows in this order:
686                    0, 8, 16, ..., 4, 12, 20, ..., 2, 6, 10, ..., 1, 3, 5, ...  */
687                 static int InterlacedOffset[] = { 0, 4, 2, 1 };
688                 static int InterlacedJumps[] = { 8, 8, 4, 2 };
689
690                 height = unwind.giffile->SHeight;
691                 width = unwind.giffile->SWidth;
692                 unwind.eimage = xmalloc_atomic(width * height * 3 *
693                                                unwind.giffile->ImageCount);
694                 if (!unwind.eimage) {
695                         signal_image_error
696                             ("Unable to allocate enough memory for image",
697                              instantiator);
698                 }
699
700                 /* write the data in EImage format (8bit RGB triples) */
701                 for (slice = 0; slice < unwind.giffile->ImageCount; slice++) {
702                         /* We check here that the current image covers the full
703                          * "screen" size. */
704                         if (unwind.giffile->SavedImages[slice].ImageDesc.
705                             Height != height
706                             || unwind.giffile->SavedImages[slice].ImageDesc.
707                             Width != width
708                             || unwind.giffile->SavedImages[slice].ImageDesc.
709                             Left != 0
710                             || unwind.giffile->SavedImages[slice].ImageDesc.
711                             Top != 0)
712                                 signal_image_error
713                                     ("Image in GIF file is not full size",
714                                      instantiator);
715
716                         interlace =
717                             unwind.giffile->SavedImages[slice].ImageDesc.
718                             Interlace;
719                         pass = 0;
720                         row = interlace ? InterlacedOffset[pass] : 0;
721                         eip = unwind.eimage + (width * height * 3 * slice);
722                         for (i = 0; i < height; i++) {
723                                 if (interlace)
724                                         if (row >= height) {
725                                                 row = InterlacedOffset[++pass];
726                                                 while (row >= height)
727                                                         row =
728                                                             InterlacedOffset
729                                                             [++pass];
730                                         }
731                                 eip =
732                                     unwind.eimage +
733                                     (width * height * 3 * slice) +
734                                     (row * width * 3);
735                                 for (j = 0; j < width; j++) {
736                                         unsigned char pixel =
737                                             unwind.giffile->SavedImages[slice].
738                                             RasterBits[(i * width) + j];
739                                         *eip++ = cmo->Colors[pixel].Red;
740                                         *eip++ = cmo->Colors[pixel].Green;
741                                         *eip++ = cmo->Colors[pixel].Blue;
742                                 }
743                                 row += interlace ? InterlacedJumps[pass] : 1;
744                         }
745                 }
746
747                 /* now instantiate */
748                 MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
749                               init_image_instance_from_eimage,
750                               (ii, width, height, unwind.giffile->ImageCount,
751                                unwind.eimage, dest_mask, instantiator, domain));
752         }
753
754         /* We read the gif successfully. If we have more than one slice then
755            animate the gif. */
756         if (unwind.giffile->ImageCount > 1) {
757                 /* See if there is a timeout value. In theory there could be one
758                    for every image - but that makes the implementation way to
759                    complicated for now so we just take the first. */
760                 unsigned short timeout = 0;
761                 Lisp_Object tid;
762
763                 if (unwind.giffile->SavedImages[0].Function ==
764                     GRAPHICS_EXT_FUNC_CODE
765                     && unwind.giffile->SavedImages[0].ExtensionBlockCount) {
766                         timeout = (unsigned short)
767                             ((unwind.giffile->SavedImages[0].ExtensionBlocks[0].
768                               Bytes[2] << 8) +
769                              unwind.giffile->SavedImages[0].ExtensionBlocks[0].
770                              Bytes[1]) * 10;
771                 }
772
773                 /* Too short a timeout will crucify us performance-wise. */
774                 tid =
775                     add_glyph_animated_timeout(timeout > 10 ? timeout : 10,
776                                                image_instance);
777
778                 if (!NILP(tid))
779                         IMAGE_INSTANCE_PIXMAP_TIMEOUT(ii) = XINT(tid);
780         }
781
782         unbind_to(speccount, Qnil);
783 }
784
785 #endif                          /* HAVE_GIF */
786 \f
787 #if defined WITH_PNG && defined HAVE_PNG
788
789 /**********************************************************************
790  *                             PNG                                    *
791  **********************************************************************/
792 static void png_validate(Lisp_Object instantiator)
793 {
794         file_or_data_must_be_present(instantiator);
795 }
796
797 static Lisp_Object
798 png_normalize(Lisp_Object inst, Lisp_Object console_type, Lisp_Object dest_mask)
799 {
800         return simple_image_type_normalize(inst, console_type, Qpng);
801 }
802
803 static int png_possible_dest_types(void)
804 {
805         return IMAGE_COLOR_PIXMAP_MASK;
806 }
807
808 struct png_memory_storage {
809         const Extbyte *bytes;   /* The data       */
810         Extcount len;           /* How big is it? */
811         int index;              /* Where are we?  */
812 };
813
814 static void
815 png_read_from_memory(png_structp png_ptr, png_bytep data, png_size_t length)
816 {
817         struct png_memory_storage *tbr =
818             (struct png_memory_storage *)png_get_io_ptr(png_ptr);
819
820         if ((ssize_t) length > (tbr->len - tbr->index))
821                 png_error(png_ptr, (png_const_charp) "Read Error");
822         memcpy(data, tbr->bytes + tbr->index, length);
823         tbr->index = tbr->index + length;
824 }
825
826 struct png_error_struct {
827         const char *err_str;
828         jmp_buf setjmp_buffer;  /* for return to caller */
829 };
830
831 /* jh 98/03/12 - #### AARRRGH! libpng includes jmp_buf inside its own
832    structure, and there are cases where the size can be different from
833    between inside the library, and inside the code!  To do an end run
834    around this, use our own error functions, and don't rely on things
835    passed in the png_ptr to them.  This is an ugly hack and must
836    go away when the lisp engine is threaded! */
837 static struct png_error_struct png_err_stct;
838
839 static void png_error_func(png_structp png_ptr, png_const_charp msg)
840 {
841         png_err_stct.err_str = msg;
842         longjmp(png_err_stct.setjmp_buffer, 1);
843 }
844
845 static void png_warning_func(png_structp png_ptr, png_const_charp msg)
846 {
847         warn_when_safe(Qpng, Qinfo, "%s", msg);
848 }
849
850 struct png_unwind_data {
851         FILE *instream;
852         unsigned char *eimage;
853         png_structp png_ptr;
854         png_infop info_ptr;
855 };
856
857 static Lisp_Object png_instantiate_unwind(Lisp_Object unwind_obj)
858 {
859         struct png_unwind_data *data =
860             (struct png_unwind_data *)get_opaque_ptr(unwind_obj);
861
862         free_opaque_ptr(unwind_obj);
863         if (data->png_ptr)
864                 png_destroy_read_struct(&(data->png_ptr), &(data->info_ptr),
865                                         (png_infopp) NULL);
866         if (data->instream)
867                 fclose(data->instream);
868
869         if (data->eimage)
870                 xfree(data->eimage);
871
872         return Qnil;
873 }
874
875 static void
876 png_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
877                 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
878                 int dest_mask, Lisp_Object domain)
879 {
880         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
881         struct png_unwind_data unwind;
882         int speccount = specpdl_depth();
883         struct png_memory_storage tbr;  /* Data to be read */
884
885         /* PNG variables */
886         png_structp png_ptr;
887         png_infop info_ptr;
888         png_uint_32 height, width;
889         int bit_depth, color_type, interlace_type;
890
891         /* Initialize all PNG structures */
892         png_ptr =
893             png_create_read_struct(PNG_LIBPNG_VER_STRING, (png_voidp *)&png_err_stct,
894                                    png_error_func, png_warning_func);
895         if (!png_ptr)
896                 signal_image_error("Error obtaining memory for png_read",
897                                    instantiator);
898         info_ptr = png_create_info_struct(png_ptr);
899         if (!info_ptr) {
900                 png_destroy_read_struct(&png_ptr, (png_infopp) NULL,
901                                         (png_infopp) NULL);
902                 signal_image_error("Error obtaining memory for png_read",
903                                    instantiator);
904         }
905
906         xzero(unwind);
907         unwind.png_ptr = png_ptr;
908         unwind.info_ptr = info_ptr;
909
910         record_unwind_protect(png_instantiate_unwind, make_opaque_ptr(&unwind));
911
912         /* This code is a mixture of stuff from Ben's GIF/JPEG stuff from
913            this file, example.c from the libpng 0.81 distribution, and the
914            pngtopnm sources. -WMP-
915          */
916         /* It has been further modified to handle the API changes for 0.96,
917            and is no longer usable for previous versions. jh
918          */
919         /* It has been further modified to handle libpng 1.5.x --SY */
920
921         /* Set the jmp_buf return context for png_error ... if this returns !0, then
922            we ran into a problem somewhere, and need to clean up after ourselves. */
923         if (setjmp(png_err_stct.setjmp_buffer)) {
924                 /* Something blew up: just display the error (cleanup
925                  * happens in the unwind) */
926                 signal_image_error_2("Error decoding PNG",
927                                      build_string(png_err_stct.err_str),
928                                      instantiator);
929         }
930
931         /* Initialize the IO layer and read in header information */
932         {
933                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
934                 const Extbyte *bytes;
935                 Extcount len;
936
937                 assert(!NILP(data));
938
939 #ifdef HAVE_FFI
940                 if (EFFIOP(data)) {
941                         bytes = XEFFIO(data)->fostorage;
942                         len = XEFFIO(data)->storage_size;
943                 } else
944 #endif  /* HAVE_FFI */
945                 /* #### This is a definite problem under Mule due to the amount of
946                    stack data it might allocate.  Need to think about using Lstreams */
947                 TO_EXTERNAL_FORMAT(LISP_STRING, data, ALLOCA, (bytes, len),
948                                    Qbinary);
949                 tbr.bytes = bytes;
950                 tbr.len = len;
951                 tbr.index = 0;
952                 png_set_read_fn(png_ptr, (void *)&tbr, png_read_from_memory);
953         }
954
955         png_read_info(png_ptr, info_ptr);
956         png_get_IHDR(png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
957                      &interlace_type, NULL, NULL);
958
959         {
960                 png_uint_32 y;
961                 int pass;
962                 int passes = 0;
963                 png_bytep row_pointers[height];
964
965                 /* Wow, allocate all the memory.  Truly, exciting. */
966                 unwind.eimage = xmalloc_atomic(width * height * 3);
967                 /* libpng expects that the image buffer passed in contains a
968                    picture to draw on top of if the png has any transparencies.
969                    This could be a good place to pass that in... */
970                 for (y = 0; y < height; y++) {
971                         row_pointers[y] = NULL;
972                 }
973                 
974                 for (y = 0; y < height; y++) {
975                         row_pointers[y] = unwind.eimage + (width * 3 * y);
976                 }
977                  
978                 {
979                         /* if the png specifies a background chunk, go ahead and
980                          * use it, else use what we can get
981                          * from the default face. */
982                         png_color_16 my_background, *image_background;
983                         Lisp_Object bkgd = Qnil;
984
985                         my_background.red = 0x7fff;
986                         my_background.green = 0x7fff;
987                         my_background.blue = 0x7fff;
988                         bkgd = FACE_BACKGROUND(Vdefault_face, domain);
989                         if (!COLOR_INSTANCEP(bkgd)) {
990                                 warn_when_safe(Qpng, Qinfo,
991                                                "Couldn't get background color!");
992                         } else {
993                                 Lisp_Color_Instance *c;
994                                 Lisp_Object rgblist;
995
996                                 c = XCOLOR_INSTANCE(bkgd);
997                                 rgblist = MAYBE_LISP_DEVMETH(XDEVICE(c->device),
998                                                              color_instance_rgb_components,
999                                                              (c));
1000                                 my_background.red =
1001                                     (unsigned short)XINT(XCAR(rgblist));
1002                                 my_background.green =
1003                                     (unsigned short)XINT(XCAR(XCDR(rgblist)));
1004                                 my_background.blue =
1005                                     (unsigned short)
1006                                     XINT(XCAR(XCDR(XCDR(rgblist))));
1007                         }
1008
1009                         if (png_get_bKGD(png_ptr, info_ptr, &image_background))
1010                                 png_set_background(png_ptr, image_background,
1011                                                    PNG_BACKGROUND_GAMMA_FILE, 1,
1012                                                    1.0);
1013                         else
1014                                 png_set_background(png_ptr, &my_background,
1015                                                    PNG_BACKGROUND_GAMMA_SCREEN,
1016                                                    0, 1.0);
1017                 }
1018
1019                 /* Now that we're using EImage, ask for 8bit RGB triples for any type
1020                    of image */
1021
1022                 /* tell libpng to strip 16 bit depth files down to 8 bits */
1023                 if (bit_depth == 16)
1024                         png_set_strip_16(png_ptr);
1025                 /* if the image is < 8 bits, pad it out */
1026                 if (bit_depth < 8) {
1027                         if (color_type == PNG_COLOR_TYPE_GRAY)
1028                                 png_set_expand_gray_1_2_4_to_8(png_ptr);
1029                         else
1030                                 png_set_packing(png_ptr);
1031                 }
1032                 /* convert palette images to full RGB */
1033                 if (color_type == PNG_COLOR_TYPE_PALETTE)
1034                         png_set_palette_to_rgb(png_ptr);
1035                 /* send grayscale images to RGB too */
1036                 if (color_type == PNG_COLOR_TYPE_GRAY ||
1037                     color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
1038                         png_set_gray_to_rgb(png_ptr);
1039                 /*
1040                  * Expand paletted or RGB images with transparency to
1041                  * full alpha channels so the data will be available
1042                  * as RGBA quartets.  We don't actually take advantage
1043                  * of this yet, but it's not going to hurt, and you
1044                  * never know... one of these days... --SY.
1045                  */
1046                 if (png_get_valid(png_ptr, info_ptr, PNG_INFO_tRNS))
1047                         png_set_tRNS_to_alpha(png_ptr);
1048                 /* Turn on interlace handling */
1049                 if (interlace_type == PNG_INTERLACE_ADAM7)
1050                         passes = png_set_interlace_handling(png_ptr);
1051
1052                 /* Update the data */
1053                 png_read_update_info(png_ptr, info_ptr);
1054
1055                 /* read in the image row by row if interlaced, */
1056                 if (interlace_type == PNG_INTERLACE_ADAM7) {
1057                         for (pass = 0; pass < passes; pass++) {
1058                                 for (y = 0; y < height; y++) {
1059                                         png_read_rows(png_ptr,
1060                                                       &row_pointers[y],
1061                                                       NULL, 1);
1062                                 }
1063                         }
1064                 } else { /* the whole thing in 1 hit for non-interlaced */
1065                         png_read_image(png_ptr, row_pointers);
1066                 }
1067                 png_read_end(png_ptr, info_ptr);
1068         }
1069
1070         /* now instantiate */
1071         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1072                       init_image_instance_from_eimage,
1073                       (ii, width, height, 1, unwind.eimage, dest_mask,
1074                        instantiator, domain));
1075
1076         /* This will clean up everything else. */
1077         unbind_to(speccount, Qnil);
1078 }
1079
1080 #endif                          /* HAVE_PNG */
1081 \f
1082 #ifdef HAVE_TIFF
1083 #include "tiffio.h"
1084
1085 /**********************************************************************
1086  *                             TIFF                                   *
1087  **********************************************************************/
1088 static void tiff_validate(Lisp_Object instantiator)
1089 {
1090         file_or_data_must_be_present(instantiator);
1091 }
1092
1093 static Lisp_Object
1094 tiff_normalize(Lisp_Object inst, Lisp_Object console_type,
1095                Lisp_Object dest_mask)
1096 {
1097         return simple_image_type_normalize(inst, console_type, Qtiff);
1098 }
1099
1100 static int tiff_possible_dest_types(void)
1101 {
1102         return IMAGE_COLOR_PIXMAP_MASK;
1103 }
1104
1105 struct tiff_unwind_data {
1106         unsigned char *eimage;
1107         /* Object that holds the decoded data from a TIFF file */
1108         TIFF *tiff;
1109 };
1110
1111 static Lisp_Object tiff_instantiate_unwind(Lisp_Object unwind_obj)
1112 {
1113         struct tiff_unwind_data *data =
1114             (struct tiff_unwind_data *)get_opaque_ptr(unwind_obj);
1115
1116         free_opaque_ptr(unwind_obj);
1117         if (data->tiff) {
1118                 TIFFClose(data->tiff);
1119         }
1120         if (data->eimage)
1121                 xfree(data->eimage);
1122
1123         return Qnil;
1124 }
1125
1126 typedef struct tiff_memory_storage {
1127         Extbyte *bytes;         /* The data       */
1128         Extcount len;           /* How big is it? */
1129         int index;              /* Where are we?  */
1130 } tiff_memory_storage;
1131
1132 static size_t tiff_memory_read(thandle_t data, tdata_t buf, tsize_t size)
1133 {
1134         tiff_memory_storage *mem = (tiff_memory_storage *) data;
1135
1136         if (size > (mem->len - mem->index))
1137                 return (size_t) - 1;
1138         memcpy(buf, mem->bytes + mem->index, size);
1139         mem->index = mem->index + size;
1140         return size;
1141 }
1142
1143 static size_t tiff_memory_write(thandle_t data, tdata_t buf, tsize_t size)
1144 {
1145         abort();
1146         return 0;               /* Shut up warnings. */
1147 }
1148
1149 static toff_t tiff_memory_seek(thandle_t data, toff_t off, int whence)
1150 {
1151         tiff_memory_storage *mem = (tiff_memory_storage *) data;
1152         int newidx;
1153         switch (whence) {
1154         case SEEK_SET:
1155                 newidx = off;
1156                 break;
1157         case SEEK_END:
1158                 newidx = mem->len + off;
1159                 break;
1160         case SEEK_CUR:
1161                 newidx = mem->index + off;
1162                 break;
1163         default:
1164                 fprintf(stderr, "Eh? invalid seek mode in tiff_memory_seek\n");
1165                 return (toff_t) - 1;
1166         }
1167
1168         if ((newidx > mem->len) || (newidx < 0))
1169                 return (toff_t) - 1;
1170
1171         mem->index = newidx;
1172         return newidx;
1173 }
1174
1175 static int tiff_memory_close(thandle_t data)
1176 {
1177         return 0;
1178 }
1179
1180 static int tiff_map_noop(thandle_t data, tdata_t * pbase, toff_t * psize)
1181 {
1182         return 0;
1183 }
1184
1185 static void tiff_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
1186 {
1187         return;
1188 }
1189
1190 static toff_t tiff_memory_size(thandle_t data)
1191 {
1192         tiff_memory_storage *mem = (tiff_memory_storage *) data;
1193         return mem->len;
1194 }
1195
1196 struct tiff_error_struct {
1197         char err_str[256];
1198         jmp_buf setjmp_buffer;  /* for return to caller */
1199 };
1200
1201 /* jh 98/03/12 - ###This struct for passing data to the error functions
1202    is an ugly hack caused by the fact that libtiff (as of v3.4) doesn't
1203    have any place to store error func data.  This should be rectified
1204    before SXEmacs gets threads! */
1205 static struct tiff_error_struct tiff_err_data;
1206
1207 static void tiff_error_func(const char *module, const char *fmt, ...)
1208 {
1209         int n;
1210         va_list vargs;
1211
1212         va_start(vargs, fmt);
1213
1214         n = vsnprintf(tiff_err_data.err_str, sizeof(tiff_err_data.err_str), fmt, vargs);
1215         assert(n>=0 && (size_t)n <  sizeof(tiff_err_data.err_str));
1216
1217         va_end(vargs);
1218         /* return to setjmp point */
1219         longjmp(tiff_err_data.setjmp_buffer, 1);
1220 }
1221
1222 static void tiff_warning_func(const char *module, const char *fmt, ...)
1223 {
1224         va_list vargs;
1225         char warn_str[256];
1226         int n;
1227
1228         va_start(vargs, fmt);
1229
1230         n = vsnprintf(warn_str, sizeof(warn_str), fmt, vargs);
1231         assert(n>=0 && (size_t)n < sizeof(warn_str));
1232         va_end(vargs);
1233         warn_when_safe(Qtiff, Qinfo, "%s - %s", module, warn_str);
1234 }
1235
1236 static void
1237 tiff_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
1238                  Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1239                  int dest_mask, Lisp_Object domain)
1240 {
1241         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
1242         tiff_memory_storage mem_struct;
1243         /* It is OK for the unwind data to be local to this function,
1244            because the unwind-protect is always executed when this
1245            stack frame is still valid. */
1246         struct tiff_unwind_data unwind;
1247         int speccount = specpdl_depth();
1248         uint32 width, height;
1249
1250         xzero(unwind);
1251         record_unwind_protect(tiff_instantiate_unwind,
1252                               make_opaque_ptr(&unwind));
1253
1254         /* set up error facilities */
1255         if (setjmp(tiff_err_data.setjmp_buffer)) {
1256                 /* An error was signaled. No clean up is needed, as unwind handles that
1257                    for us.  Just pass the error along. */
1258                 signal_image_error_2("TIFF decoding error",
1259                                      build_string(tiff_err_data.err_str),
1260                                      instantiator);
1261         }
1262         TIFFSetErrorHandler((TIFFErrorHandler) tiff_error_func);
1263         TIFFSetWarningHandler((TIFFErrorHandler) tiff_warning_func);
1264         {
1265                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
1266                 Extbyte *bytes;
1267                 Extcount len;
1268
1269                 uint32 *raster;
1270                 unsigned char *ep;
1271
1272                 assert(!NILP(data));
1273
1274 #ifdef HAVE_FFI
1275                 if (EFFIOP(data)) {
1276                         bytes = XEFFIO(data)->fostorage;
1277                         len = XEFFIO(data)->storage_size;
1278                 } else
1279 #endif  /* HAVE_FFI */
1280                 /* #### This is a definite problem under Mule due to the amount of
1281                    stack data it might allocate.  Think about Lstreams... */
1282                 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1283                                    ALLOCA, (bytes, len), Qbinary);
1284                 mem_struct.bytes = bytes;
1285                 mem_struct.len = len;
1286                 mem_struct.index = 0;
1287
1288                 unwind.tiff =
1289                     TIFFClientOpen("memfile", "r", (thandle_t) & mem_struct,
1290                                    (TIFFReadWriteProc) tiff_memory_read,
1291                                    (TIFFReadWriteProc) tiff_memory_write,
1292                                    tiff_memory_seek, tiff_memory_close,
1293                                    tiff_memory_size, tiff_map_noop,
1294                                    tiff_unmap_noop);
1295                 if (!unwind.tiff)
1296                         signal_image_error
1297                             ("Insufficient memory to instantiate TIFF image",
1298                              instantiator);
1299
1300                 TIFFGetField(unwind.tiff, TIFFTAG_IMAGEWIDTH, &width);
1301                 TIFFGetField(unwind.tiff, TIFFTAG_IMAGELENGTH, &height);
1302                 unwind.eimage = xmalloc_atomic(width * height * 3);
1303
1304                 /* #### This is little more than proof-of-concept/function testing.
1305                    It needs to be reimplemented via scanline reads for both memory
1306                    compactness. */
1307                 raster =
1308                     (uint32 *) _TIFFmalloc(width * height * sizeof(uint32));
1309                 if (raster != NULL) {
1310                         int i, j;
1311                         uint32 *rp;
1312                         ep = unwind.eimage;
1313                         rp = raster;
1314                         if (TIFFReadRGBAImage
1315                             (unwind.tiff, width, height, raster, 0)) {
1316                                 for (i = height - 1; i >= 0; i--) {
1317                                         /* This is to get around weirdness in the libtiff library where properly
1318                                            made TIFFs will come out upside down.  libtiff bug or jhod-brainlock? */
1319                                         rp = raster + (i * width);
1320                                         for (j = 0; (uint32) j < width; j++) {
1321                                                 *ep++ =
1322                                                     (unsigned char)
1323                                                     TIFFGetR(*rp);
1324                                                 *ep++ =
1325                                                     (unsigned char)
1326                                                     TIFFGetG(*rp);
1327                                                 *ep++ =
1328                                                     (unsigned char)
1329                                                     TIFFGetB(*rp);
1330                                                 rp++;
1331                                         }
1332                                 }
1333                         }
1334                         _TIFFfree(raster);
1335                 } else
1336                         signal_image_error
1337                             ("Unable to allocate memory for TIFFReadRGBA",
1338                              instantiator);
1339
1340         }
1341
1342         /* now instantiate */
1343         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1344                       init_image_instance_from_eimage,
1345                       (ii, width, height, 1, unwind.eimage, dest_mask,
1346                        instantiator, domain));
1347
1348         unbind_to(speccount, Qnil);
1349 }
1350
1351 #endif                          /* HAVE_TIFF */
1352
1353 #if 1
1354 /**********************************************************************
1355  *                             RawRGB(A)                              *
1356  **********************************************************************/
1357 static void rawrgb_validate(Lisp_Object instantiator)
1358 {
1359         data_must_be_present(instantiator);
1360         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_width)))
1361                 signal_simple_error("Must supply :pixel-width",
1362                         instantiator);
1363         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_height)))
1364                 signal_simple_error("Must supply :pixel-height",
1365                         instantiator);
1366 }
1367 static void rawrgba_validate(Lisp_Object instantiator)
1368 {
1369         file_or_data_must_be_present(instantiator);
1370         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_width)))
1371                 signal_simple_error("Must supply :pixel-width",
1372                         instantiator);
1373         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_height)))
1374                 signal_simple_error("Must supply :pixel-height",
1375                         instantiator);
1376 }
1377
1378 static Lisp_Object
1379 rawrgb_normalize(Lisp_Object inst, Lisp_Object console_type,
1380                  Lisp_Object dest_mask)
1381 {
1382         return simple_image_type_normalize(inst, console_type, Qrawrgb);
1383 }
1384 static Lisp_Object
1385 rawrgba_normalize(Lisp_Object inst, Lisp_Object console_type,
1386                   Lisp_Object dest_mask)
1387 {
1388         return simple_image_type_normalize(inst, console_type, Qrawrgba);
1389 }
1390
1391 static int rawrgb_possible_dest_types(void)
1392 {
1393         return IMAGE_COLOR_PIXMAP_MASK;
1394 }
1395 static int rawrgba_possible_dest_types(void)
1396 {
1397         return IMAGE_COLOR_PIXMAP_MASK;
1398 }
1399
1400 struct rawrgb_unwind_data {
1401         unsigned char *eimage;
1402 };
1403 struct rawrgba_unwind_data {
1404         unsigned char *eimage;
1405 };
1406
1407 static Lisp_Object rawrgb_instantiate_unwind(Lisp_Object unwind_obj)
1408 {
1409         struct rawrgb_unwind_data *data =
1410           (struct rawrgb_unwind_data *)get_opaque_ptr(unwind_obj);
1411
1412         free_opaque_ptr(unwind_obj);
1413         if (data->eimage)
1414                 xfree(data->eimage);
1415
1416         return Qnil;
1417 }
1418 static Lisp_Object rawrgba_instantiate_unwind(Lisp_Object unwind_obj)
1419 {
1420         struct rawrgba_unwind_data *data =
1421           (struct rawrgba_unwind_data *)get_opaque_ptr(unwind_obj);
1422
1423         free_opaque_ptr(unwind_obj);
1424         if (data->eimage)
1425                 xfree(data->eimage);
1426
1427         return Qnil;
1428 }
1429
1430 typedef struct rawrgb_memory_storage {
1431         Extbyte *bytes;         /* The data       */
1432         Extcount len;           /* How big is it? */
1433         int index;              /* Where are we?  */
1434 } rawrgb_memory_storage;
1435 typedef struct rawrgba_memory_storage {
1436         Extbyte *bytes;         /* The data       */
1437         Extcount len;           /* How big is it? */
1438         int index;              /* Where are we?  */
1439 } rawrgba_memory_storage;
1440
1441 #if 0
1442 static size_t rawrgb_memory_read(thandle_t data, tdata_t buf, tsize_t size)
1443 {
1444         rawrgb_memory_storage *mem = (rawrgb_memory_storage *)data;
1445
1446         if (size > (mem->len - mem->index))
1447                 return (size_t) - 1;
1448         memcpy(buf, mem->bytes + mem->index, size);
1449         mem->index = mem->index + size;
1450         return size;
1451 }
1452 static size_t rawrgba_memory_read(thandle_t data, tdata_t buf, tsize_t size)
1453 {
1454         rawrgba_memory_storage *mem = (rawrgba_memory_storage *)data;
1455
1456         if (size > (mem->len - mem->index))
1457                 return (size_t) - 1;
1458         memcpy(buf, mem->bytes + mem->index, size);
1459         mem->index = mem->index + size;
1460         return size;
1461 }
1462
1463 static size_t rawrgb_memory_write(thandle_t data, tdata_t buf, tsize_t size)
1464 {
1465         abort();
1466         return 0;               /* Shut up warnings. */
1467 }
1468 static size_t rawrgba_memory_write(thandle_t data, tdata_t buf, tsize_t size)
1469 {
1470         abort();
1471         return 0;               /* Shut up warnings. */
1472 }
1473
1474 static toff_t rawrgb_memory_seek(thandle_t data, toff_t off, int whence)
1475 {
1476         rawrgb_memory_storage *mem = (rawrgb_memory_storage *)data;
1477         int newidx;
1478         switch (whence) {
1479         case SEEK_SET:
1480                 newidx = off;
1481                 break;
1482         case SEEK_END:
1483                 newidx = mem->len + off;
1484                 break;
1485         case SEEK_CUR:
1486                 newidx = mem->index + off;
1487                 break;
1488         default:
1489                 fprintf(stderr,
1490                         "Eh? invalid seek mode in rawrgb_memory_seek\n");
1491                 return (toff_t) - 1;
1492         }
1493
1494         if ((newidx > mem->len) || (newidx < 0))
1495                 return (toff_t) - 1;
1496
1497         mem->index = newidx;
1498         return newidx;
1499 }
1500 static toff_t rawrgba_memory_seek(thandle_t data, toff_t off, int whence)
1501 {
1502         rawrgba_memory_storage *mem = (rawrgba_memory_storage *)data;
1503         int newidx;
1504         switch (whence) {
1505         case SEEK_SET:
1506                 newidx = off;
1507                 break;
1508         case SEEK_END:
1509                 newidx = mem->len + off;
1510                 break;
1511         case SEEK_CUR:
1512                 newidx = mem->index + off;
1513                 break;
1514         default:
1515                 fprintf(stderr,
1516                         "Eh? invalid seek mode in rawrgba_memory_seek\n");
1517                 return (toff_t) - 1;
1518         }
1519
1520         if ((newidx > mem->len) || (newidx < 0))
1521                 return (toff_t) - 1;
1522
1523         mem->index = newidx;
1524         return newidx;
1525 }
1526
1527 static int rawrgb_memory_close(thandle_t data)
1528 {
1529         return 0;
1530 }
1531 static int rawrgba_memory_close(thandle_t data)
1532 {
1533         return 0;
1534 }
1535
1536 static int rawrgb_map_noop(thandle_t data, tdata_t * pbase, toff_t * psize)
1537 {
1538         return 0;
1539 }
1540 static int rawrgba_map_noop(thandle_t data, tdata_t * pbase, toff_t * psize)
1541 {
1542         return 0;
1543 }
1544
1545 static void rawrgb_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
1546 {
1547         return;
1548 }
1549 static void rawrgba_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
1550 {
1551         return;
1552 }
1553
1554 static toff_t rawrgb_memory_size(thandle_t data)
1555 {
1556         rawrgb_memory_storage *mem = (rawrgb_memory_storage *) data;
1557         return mem->len;
1558 }
1559 static toff_t rawrgba_memory_size(thandle_t data)
1560 {
1561         rawrgba_memory_storage *mem = (rawrgba_memory_storage *) data;
1562         return mem->len;
1563 }
1564 #endif  /* 0 */
1565
1566 static void
1567 rawrgb_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
1568                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1569                    int dest_mask, Lisp_Object domain)
1570 {
1571         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
1572         rawrgb_memory_storage mem_struct;
1573         /* It is OK for the unwind data to be local to this function,
1574            because the unwind-protect is always executed when this
1575            stack frame is still valid. */
1576         struct rawrgb_unwind_data unwind;
1577         int speccount = specpdl_depth();
1578         unsigned long width, height;
1579
1580         xzero(unwind);
1581         record_unwind_protect(rawrgb_instantiate_unwind,
1582                               make_opaque_ptr(&unwind));
1583
1584         {
1585                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
1586                 Lisp_Object rows = find_keyword_in_vector(instantiator,
1587                                                           Q_pixel_height);
1588                 Lisp_Object cols = find_keyword_in_vector(instantiator,
1589                                                           Q_pixel_width);
1590                 Extbyte *bytes;
1591                 Extcount len;
1592
1593                 unsigned char *ep;
1594                 unsigned char *dp;
1595
1596                 assert(!NILP(data));
1597
1598 #ifdef HAVE_FFI
1599                 if (EFFIOP(data)) {
1600                         bytes = XEFFIO(data)->fostorage;
1601                         len = XEFFIO(data)->storage_size;
1602                 } else
1603 #endif  /* HAVE_FFI */
1604                 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1605                                    ALLOCA, (bytes, len), Qbinary);
1606                 mem_struct.bytes = bytes;
1607                 mem_struct.len = len;
1608                 mem_struct.index = 0;
1609
1610                 width = XINT(cols);
1611                 height = XINT(rows);
1612
1613                 unwind.eimage = xmalloc_atomic(len);
1614                 ep = unwind.eimage;
1615                 dp = (unsigned char*)bytes;
1616                 for ( ; dp < (unsigned char*)bytes+len; ep++, dp++)
1617                         *ep = *dp;
1618         }
1619
1620         /* now instantiate */
1621         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1622                       init_image_instance_from_eimage,
1623                       (ii, width, height, 1, unwind.eimage, dest_mask,
1624                        instantiator, domain));
1625
1626         unbind_to(speccount, Qnil);
1627 }
1628 static void
1629 rawrgba_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
1630                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1631                     int dest_mask, Lisp_Object domain)
1632 {
1633         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
1634         rawrgba_memory_storage mem_struct;
1635         /* It is OK for the unwind data to be local to this function,
1636            because the unwind-protect is always executed when this
1637            stack frame is still valid. */
1638         struct rawrgba_unwind_data unwind;
1639         int speccount = specpdl_depth();
1640         unsigned long width, height;
1641
1642         xzero(unwind);
1643         record_unwind_protect(rawrgba_instantiate_unwind,
1644                               make_opaque_ptr(&unwind));
1645
1646         {
1647                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
1648                 Lisp_Object rows = find_keyword_in_vector(instantiator,
1649                                                           Q_pixel_height);
1650                 Lisp_Object cols = find_keyword_in_vector(instantiator,
1651                                                           Q_pixel_width);
1652                 Extbyte *bytes;
1653                 Extcount len;
1654
1655                 unsigned char *ep;
1656                 unsigned char *dp;
1657
1658                 assert(!NILP(data));
1659
1660 #ifdef HAVE_FFI
1661                 if (EFFIOP(data)) {
1662                         bytes = XEFFIO(data)->fostorage;
1663                         len = XEFFIO(data)->storage_size;
1664                 } else
1665 #endif  /* HAVE_FFI */
1666                 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1667                                    ALLOCA, (bytes, len), Qbinary);
1668                 mem_struct.bytes = bytes;
1669                 mem_struct.len = len;
1670                 mem_struct.index = 0;
1671
1672                 width = XINT(cols);
1673                 height = XINT(rows);
1674
1675                 unwind.eimage = xmalloc_atomic(len);
1676                 for (ep = unwind.eimage, dp = (unsigned char*)bytes;
1677                      dp < (unsigned char*)bytes+len; ep++, dp++) {
1678                         *ep = *dp;
1679                 }
1680         }
1681
1682         /* now instantiate */
1683         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1684                       init_image_instance_from_eimage,
1685                       (ii, width, height, 1, unwind.eimage, dest_mask,
1686                        instantiator, domain));
1687
1688         unbind_to(speccount, Qnil);
1689 }
1690 #endif  /* 1 */
1691 \f
1692 /************************************************************************/
1693 /*                            initialization                            */
1694 /************************************************************************/
1695
1696 void syms_of_glyphs_eimage(void)
1697 {
1698 }
1699
1700 static void check_valid_ffio_or_string(Lisp_Object data)
1701 {
1702 #ifdef HAVE_FFI
1703         if (!EFFIOP(data) && !STRINGP(data))
1704                 dead_wrong_type_argument(Qstringp, data);
1705 #else
1706         CHECK_STRING(data);
1707 #endif  /* HAVE_FFI */
1708 }
1709
1710 void image_instantiator_format_create_glyphs_eimage(void)
1711 {
1712         /* image-instantiator types */
1713 #ifdef HAVE_JPEG
1714         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(jpeg, "jpeg");
1715
1716         IIFORMAT_HAS_METHOD(jpeg, validate);
1717         IIFORMAT_HAS_METHOD(jpeg, normalize);
1718         IIFORMAT_HAS_METHOD(jpeg, possible_dest_types);
1719         IIFORMAT_HAS_METHOD(jpeg, instantiate);
1720
1721         IIFORMAT_VALID_KEYWORD(jpeg, Q_data, check_valid_ffio_or_string);
1722         IIFORMAT_VALID_KEYWORD(jpeg, Q_file, check_valid_string);
1723 #endif
1724
1725 #ifdef HAVE_GIF
1726         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(gif, "gif");
1727
1728         IIFORMAT_HAS_METHOD(gif, validate);
1729         IIFORMAT_HAS_METHOD(gif, normalize);
1730         IIFORMAT_HAS_METHOD(gif, possible_dest_types);
1731         IIFORMAT_HAS_METHOD(gif, instantiate);
1732
1733         IIFORMAT_VALID_KEYWORD(gif, Q_data, check_valid_ffio_or_string);
1734         IIFORMAT_VALID_KEYWORD(gif, Q_file, check_valid_string);
1735 #endif
1736
1737 #if defined WITH_PNG && defined HAVE_PNG
1738         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(png, "png");
1739
1740         IIFORMAT_HAS_METHOD(png, validate);
1741         IIFORMAT_HAS_METHOD(png, normalize);
1742         IIFORMAT_HAS_METHOD(png, possible_dest_types);
1743         IIFORMAT_HAS_METHOD(png, instantiate);
1744
1745         IIFORMAT_VALID_KEYWORD(png, Q_data, check_valid_ffio_or_string);
1746         IIFORMAT_VALID_KEYWORD(png, Q_file, check_valid_string);
1747 #endif  /* PNG */
1748
1749 #ifdef HAVE_TIFF
1750         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(tiff, "tiff");
1751
1752         IIFORMAT_HAS_METHOD(tiff, validate);
1753         IIFORMAT_HAS_METHOD(tiff, normalize);
1754         IIFORMAT_HAS_METHOD(tiff, possible_dest_types);
1755         IIFORMAT_HAS_METHOD(tiff, instantiate);
1756
1757         IIFORMAT_VALID_KEYWORD(tiff, Q_data, check_valid_ffio_or_string);
1758         IIFORMAT_VALID_KEYWORD(tiff, Q_file, check_valid_string);
1759 #endif
1760
1761 #if 1
1762         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(rawrgb, "rawrgb");
1763         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(rawrgba, "rawrgba");
1764
1765         IIFORMAT_HAS_METHOD(rawrgb, validate);
1766         IIFORMAT_HAS_METHOD(rawrgb, normalize);
1767         IIFORMAT_HAS_METHOD(rawrgb, possible_dest_types);
1768         IIFORMAT_HAS_METHOD(rawrgb, instantiate);
1769
1770         IIFORMAT_HAS_METHOD(rawrgba, validate);
1771         IIFORMAT_HAS_METHOD(rawrgba, normalize);
1772         IIFORMAT_HAS_METHOD(rawrgba, possible_dest_types);
1773         IIFORMAT_HAS_METHOD(rawrgba, instantiate);
1774
1775         IIFORMAT_VALID_KEYWORD(rawrgb, Q_data, check_valid_ffio_or_string);
1776         IIFORMAT_VALID_KEYWORD(rawrgb, Q_pixel_width, check_valid_int);
1777         IIFORMAT_VALID_KEYWORD(rawrgb, Q_pixel_height, check_valid_int);
1778
1779         IIFORMAT_VALID_KEYWORD(rawrgba, Q_data, check_valid_ffio_or_string);
1780         IIFORMAT_VALID_KEYWORD(rawrgba, Q_pixel_width, check_valid_int);
1781         IIFORMAT_VALID_KEYWORD(rawrgba, Q_pixel_height, check_valid_int);
1782 #endif
1783 }
1784
1785 void vars_of_glyphs_eimage(void)
1786 {
1787 #ifdef HAVE_JPEG
1788         Fprovide(Qjpeg);
1789 #endif
1790
1791 #ifdef HAVE_GIF
1792         Fprovide(Qgif);
1793 #endif
1794
1795 #if defined WITH_PNG && defined HAVE_PNG
1796         Fprovide(Qpng);
1797 #endif  /* PNG */
1798
1799 #ifdef HAVE_TIFF
1800         Fprovide(Qtiff);
1801 #endif
1802
1803 #if 1
1804         Fprovide(Qrawrgb);
1805         Fprovide(Qrawrgba);
1806 #endif
1807 }