e3fc1e4378ec8444a89f295d3f64a18df20a2066
[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                 int y, pass;
961                 int passes = 0;
962                 png_bytep row_pointers[height];
963
964                 /* Wow, allocate all the memory.  Truly, exciting. */
965                 unwind.eimage = xmalloc_atomic(width * height * 3);
966                 /* libpng expects that the image buffer passed in contains a
967                    picture to draw on top of if the png has any transparencies.
968                    This could be a good place to pass that in... */
969                 for (y = 0; y < height; y++) {
970                         row_pointers[y] = NULL;
971                 }
972                 
973                 for (y = 0; y < height; y++) {
974                         row_pointers[y] = unwind.eimage + (width * 3 * y);
975                 }
976                  
977                 {
978                         /* if the png specifies a background chunk, go ahead and
979                          * use it, else use what we can get
980                          * from the default face. */
981                         png_color_16 my_background, *image_background;
982                         Lisp_Object bkgd = Qnil;
983
984                         my_background.red = 0x7fff;
985                         my_background.green = 0x7fff;
986                         my_background.blue = 0x7fff;
987                         bkgd = FACE_BACKGROUND(Vdefault_face, domain);
988                         if (!COLOR_INSTANCEP(bkgd)) {
989                                 warn_when_safe(Qpng, Qinfo,
990                                                "Couldn't get background color!");
991                         } else {
992                                 Lisp_Color_Instance *c;
993                                 Lisp_Object rgblist;
994
995                                 c = XCOLOR_INSTANCE(bkgd);
996                                 rgblist = MAYBE_LISP_DEVMETH(XDEVICE(c->device),
997                                                              color_instance_rgb_components,
998                                                              (c));
999                                 my_background.red =
1000                                     (unsigned short)XINT(XCAR(rgblist));
1001                                 my_background.green =
1002                                     (unsigned short)XINT(XCAR(XCDR(rgblist)));
1003                                 my_background.blue =
1004                                     (unsigned short)
1005                                     XINT(XCAR(XCDR(XCDR(rgblist))));
1006                         }
1007
1008                         if (png_get_bKGD(png_ptr, info_ptr, &image_background))
1009                                 png_set_background(png_ptr, image_background,
1010                                                    PNG_BACKGROUND_GAMMA_FILE, 1,
1011                                                    1.0);
1012                         else
1013                                 png_set_background(png_ptr, &my_background,
1014                                                    PNG_BACKGROUND_GAMMA_SCREEN,
1015                                                    0, 1.0);
1016                 }
1017
1018                 /* Now that we're using EImage, ask for 8bit RGB triples for any type
1019                    of image */
1020
1021                 /* tell libpng to strip 16 bit depth files down to 8 bits */
1022                 if (bit_depth == 16)
1023                         png_set_strip_16(png_ptr);
1024                 /* if the image is < 8 bits, pad it out */
1025                 if (bit_depth < 8) {
1026                         if (color_type == PNG_COLOR_TYPE_GRAY)
1027                                 png_set_expand_gray_1_2_4_to_8(png_ptr);
1028                         else
1029                                 png_set_packing(png_ptr);
1030                 }
1031                 /* convert palette images to full RGB */
1032                 if (color_type == PNG_COLOR_TYPE_PALETTE)
1033                         png_set_palette_to_rgb(png_ptr);
1034                 /* send grayscale images to RGB too */
1035                 if (color_type == PNG_COLOR_TYPE_GRAY ||
1036                     color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
1037                         png_set_gray_to_rgb(png_ptr);
1038                 /*
1039                  * Expand paletted or RGB images with transparency to
1040                  * full alpha channels so the data will be available
1041                  * as RGBA quartets.  We don't actually take advantage
1042                  * of this yet, but it's not going to hurt, and you
1043                  * never know... one of these days... --SY.
1044                  */
1045                 if (png_get_valid(png_ptr, info_ptr, PNG_INFO_tRNS))
1046                         png_set_tRNS_to_alpha(png_ptr);
1047                 /* Turn on interlace handling */
1048                 if (interlace_type == PNG_INTERLACE_ADAM7)
1049                         passes = png_set_interlace_handling(png_ptr);
1050
1051                 /* Update the data */
1052                 png_read_update_info(png_ptr, info_ptr);
1053
1054                 /* read in the image row by row if interlaced, */
1055                 if (interlace_type == PNG_INTERLACE_ADAM7) {
1056                         for (pass = 0; pass < passes; pass++) {
1057                                 for (y = 0; y < height; y++) {
1058                                         png_read_rows(png_ptr,
1059                                                       &row_pointers[y],
1060                                                       NULL, 1);
1061                                 }
1062                         }
1063                 } else { /* the whole thing in 1 hit for non-interlaced */
1064                         png_read_image(png_ptr, row_pointers);
1065                 }
1066                 png_read_end(png_ptr, info_ptr);
1067         }
1068
1069         /* now instantiate */
1070         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1071                       init_image_instance_from_eimage,
1072                       (ii, width, height, 1, unwind.eimage, dest_mask,
1073                        instantiator, domain));
1074
1075         /* This will clean up everything else. */
1076         unbind_to(speccount, Qnil);
1077 }
1078
1079 #endif                          /* HAVE_PNG */
1080 \f
1081 #ifdef HAVE_TIFF
1082 #include "tiffio.h"
1083
1084 /**********************************************************************
1085  *                             TIFF                                   *
1086  **********************************************************************/
1087 static void tiff_validate(Lisp_Object instantiator)
1088 {
1089         file_or_data_must_be_present(instantiator);
1090 }
1091
1092 static Lisp_Object
1093 tiff_normalize(Lisp_Object inst, Lisp_Object console_type,
1094                Lisp_Object dest_mask)
1095 {
1096         return simple_image_type_normalize(inst, console_type, Qtiff);
1097 }
1098
1099 static int tiff_possible_dest_types(void)
1100 {
1101         return IMAGE_COLOR_PIXMAP_MASK;
1102 }
1103
1104 struct tiff_unwind_data {
1105         unsigned char *eimage;
1106         /* Object that holds the decoded data from a TIFF file */
1107         TIFF *tiff;
1108 };
1109
1110 static Lisp_Object tiff_instantiate_unwind(Lisp_Object unwind_obj)
1111 {
1112         struct tiff_unwind_data *data =
1113             (struct tiff_unwind_data *)get_opaque_ptr(unwind_obj);
1114
1115         free_opaque_ptr(unwind_obj);
1116         if (data->tiff) {
1117                 TIFFClose(data->tiff);
1118         }
1119         if (data->eimage)
1120                 xfree(data->eimage);
1121
1122         return Qnil;
1123 }
1124
1125 typedef struct tiff_memory_storage {
1126         Extbyte *bytes;         /* The data       */
1127         Extcount len;           /* How big is it? */
1128         int index;              /* Where are we?  */
1129 } tiff_memory_storage;
1130
1131 static size_t tiff_memory_read(thandle_t data, tdata_t buf, tsize_t size)
1132 {
1133         tiff_memory_storage *mem = (tiff_memory_storage *) data;
1134
1135         if (size > (mem->len - mem->index))
1136                 return (size_t) - 1;
1137         memcpy(buf, mem->bytes + mem->index, size);
1138         mem->index = mem->index + size;
1139         return size;
1140 }
1141
1142 static size_t tiff_memory_write(thandle_t data, tdata_t buf, tsize_t size)
1143 {
1144         abort();
1145         return 0;               /* Shut up warnings. */
1146 }
1147
1148 static toff_t tiff_memory_seek(thandle_t data, toff_t off, int whence)
1149 {
1150         tiff_memory_storage *mem = (tiff_memory_storage *) data;
1151         int newidx;
1152         switch (whence) {
1153         case SEEK_SET:
1154                 newidx = off;
1155                 break;
1156         case SEEK_END:
1157                 newidx = mem->len + off;
1158                 break;
1159         case SEEK_CUR:
1160                 newidx = mem->index + off;
1161                 break;
1162         default:
1163                 fprintf(stderr, "Eh? invalid seek mode in tiff_memory_seek\n");
1164                 return (toff_t) - 1;
1165         }
1166
1167         if ((newidx > mem->len) || (newidx < 0))
1168                 return (toff_t) - 1;
1169
1170         mem->index = newidx;
1171         return newidx;
1172 }
1173
1174 static int tiff_memory_close(thandle_t data)
1175 {
1176         return 0;
1177 }
1178
1179 static int tiff_map_noop(thandle_t data, tdata_t * pbase, toff_t * psize)
1180 {
1181         return 0;
1182 }
1183
1184 static void tiff_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
1185 {
1186         return;
1187 }
1188
1189 static toff_t tiff_memory_size(thandle_t data)
1190 {
1191         tiff_memory_storage *mem = (tiff_memory_storage *) data;
1192         return mem->len;
1193 }
1194
1195 struct tiff_error_struct {
1196         char err_str[256];
1197         jmp_buf setjmp_buffer;  /* for return to caller */
1198 };
1199
1200 /* jh 98/03/12 - ###This struct for passing data to the error functions
1201    is an ugly hack caused by the fact that libtiff (as of v3.4) doesn't
1202    have any place to store error func data.  This should be rectified
1203    before SXEmacs gets threads! */
1204 static struct tiff_error_struct tiff_err_data;
1205
1206 static void tiff_error_func(const char *module, const char *fmt, ...)
1207 {
1208         int n;
1209         va_list vargs;
1210
1211         va_start(vargs, fmt);
1212
1213         n = vsnprintf(tiff_err_data.err_str, sizeof(tiff_err_data.err_str), fmt, vargs);
1214         assert(n>=0 && n <  sizeof(tiff_err_data.err_str));
1215
1216         va_end(vargs);
1217         /* return to setjmp point */
1218         longjmp(tiff_err_data.setjmp_buffer, 1);
1219 }
1220
1221 static void tiff_warning_func(const char *module, const char *fmt, ...)
1222 {
1223         va_list vargs;
1224         char warn_str[256];
1225         int n;
1226
1227         va_start(vargs, fmt);
1228
1229         n = vsnprintf(warn_str, sizeof(warn_str), fmt, vargs);
1230         assert(n>=0 && n < sizeof(warn_str));
1231         va_end(vargs);
1232         warn_when_safe(Qtiff, Qinfo, "%s - %s", module, warn_str);
1233 }
1234
1235 static void
1236 tiff_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
1237                  Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1238                  int dest_mask, Lisp_Object domain)
1239 {
1240         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
1241         tiff_memory_storage mem_struct;
1242         /* It is OK for the unwind data to be local to this function,
1243            because the unwind-protect is always executed when this
1244            stack frame is still valid. */
1245         struct tiff_unwind_data unwind;
1246         int speccount = specpdl_depth();
1247         uint32 width, height;
1248
1249         xzero(unwind);
1250         record_unwind_protect(tiff_instantiate_unwind,
1251                               make_opaque_ptr(&unwind));
1252
1253         /* set up error facilities */
1254         if (setjmp(tiff_err_data.setjmp_buffer)) {
1255                 /* An error was signaled. No clean up is needed, as unwind handles that
1256                    for us.  Just pass the error along. */
1257                 signal_image_error_2("TIFF decoding error",
1258                                      build_string(tiff_err_data.err_str),
1259                                      instantiator);
1260         }
1261         TIFFSetErrorHandler((TIFFErrorHandler) tiff_error_func);
1262         TIFFSetWarningHandler((TIFFErrorHandler) tiff_warning_func);
1263         {
1264                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
1265                 Extbyte *bytes;
1266                 Extcount len;
1267
1268                 uint32 *raster;
1269                 unsigned char *ep;
1270
1271                 assert(!NILP(data));
1272
1273 #ifdef HAVE_FFI
1274                 if (EFFIOP(data)) {
1275                         bytes = XEFFIO(data)->fostorage;
1276                         len = XEFFIO(data)->storage_size;
1277                 } else
1278 #endif  /* HAVE_FFI */
1279                 /* #### This is a definite problem under Mule due to the amount of
1280                    stack data it might allocate.  Think about Lstreams... */
1281                 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1282                                    ALLOCA, (bytes, len), Qbinary);
1283                 mem_struct.bytes = bytes;
1284                 mem_struct.len = len;
1285                 mem_struct.index = 0;
1286
1287                 unwind.tiff =
1288                     TIFFClientOpen("memfile", "r", (thandle_t) & mem_struct,
1289                                    (TIFFReadWriteProc) tiff_memory_read,
1290                                    (TIFFReadWriteProc) tiff_memory_write,
1291                                    tiff_memory_seek, tiff_memory_close,
1292                                    tiff_memory_size, tiff_map_noop,
1293                                    tiff_unmap_noop);
1294                 if (!unwind.tiff)
1295                         signal_image_error
1296                             ("Insufficient memory to instantiate TIFF image",
1297                              instantiator);
1298
1299                 TIFFGetField(unwind.tiff, TIFFTAG_IMAGEWIDTH, &width);
1300                 TIFFGetField(unwind.tiff, TIFFTAG_IMAGELENGTH, &height);
1301                 unwind.eimage = xmalloc_atomic(width * height * 3);
1302
1303                 /* #### This is little more than proof-of-concept/function testing.
1304                    It needs to be reimplemented via scanline reads for both memory
1305                    compactness. */
1306                 raster =
1307                     (uint32 *) _TIFFmalloc(width * height * sizeof(uint32));
1308                 if (raster != NULL) {
1309                         int i, j;
1310                         uint32 *rp;
1311                         ep = unwind.eimage;
1312                         rp = raster;
1313                         if (TIFFReadRGBAImage
1314                             (unwind.tiff, width, height, raster, 0)) {
1315                                 for (i = height - 1; i >= 0; i--) {
1316                                         /* This is to get around weirdness in the libtiff library where properly
1317                                            made TIFFs will come out upside down.  libtiff bug or jhod-brainlock? */
1318                                         rp = raster + (i * width);
1319                                         for (j = 0; (uint32) j < width; j++) {
1320                                                 *ep++ =
1321                                                     (unsigned char)
1322                                                     TIFFGetR(*rp);
1323                                                 *ep++ =
1324                                                     (unsigned char)
1325                                                     TIFFGetG(*rp);
1326                                                 *ep++ =
1327                                                     (unsigned char)
1328                                                     TIFFGetB(*rp);
1329                                                 rp++;
1330                                         }
1331                                 }
1332                         }
1333                         _TIFFfree(raster);
1334                 } else
1335                         signal_image_error
1336                             ("Unable to allocate memory for TIFFReadRGBA",
1337                              instantiator);
1338
1339         }
1340
1341         /* now instantiate */
1342         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1343                       init_image_instance_from_eimage,
1344                       (ii, width, height, 1, unwind.eimage, dest_mask,
1345                        instantiator, domain));
1346
1347         unbind_to(speccount, Qnil);
1348 }
1349
1350 #endif                          /* HAVE_TIFF */
1351
1352 #if 1
1353 /**********************************************************************
1354  *                             RawRGB(A)                              *
1355  **********************************************************************/
1356 static void rawrgb_validate(Lisp_Object instantiator)
1357 {
1358         data_must_be_present(instantiator);
1359         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_width)))
1360                 signal_simple_error("Must supply :pixel-width",
1361                         instantiator);
1362         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_height)))
1363                 signal_simple_error("Must supply :pixel-height",
1364                         instantiator);
1365 }
1366 static void rawrgba_validate(Lisp_Object instantiator)
1367 {
1368         file_or_data_must_be_present(instantiator);
1369         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_width)))
1370                 signal_simple_error("Must supply :pixel-width",
1371                         instantiator);
1372         if (NILP(find_keyword_in_vector(instantiator, Q_pixel_height)))
1373                 signal_simple_error("Must supply :pixel-height",
1374                         instantiator);
1375 }
1376
1377 static Lisp_Object
1378 rawrgb_normalize(Lisp_Object inst, Lisp_Object console_type,
1379                  Lisp_Object dest_mask)
1380 {
1381         return simple_image_type_normalize(inst, console_type, Qrawrgb);
1382 }
1383 static Lisp_Object
1384 rawrgba_normalize(Lisp_Object inst, Lisp_Object console_type,
1385                   Lisp_Object dest_mask)
1386 {
1387         return simple_image_type_normalize(inst, console_type, Qrawrgba);
1388 }
1389
1390 static int rawrgb_possible_dest_types(void)
1391 {
1392         return IMAGE_COLOR_PIXMAP_MASK;
1393 }
1394 static int rawrgba_possible_dest_types(void)
1395 {
1396         return IMAGE_COLOR_PIXMAP_MASK;
1397 }
1398
1399 struct rawrgb_unwind_data {
1400         unsigned char *eimage;
1401 };
1402 struct rawrgba_unwind_data {
1403         unsigned char *eimage;
1404 };
1405
1406 static Lisp_Object rawrgb_instantiate_unwind(Lisp_Object unwind_obj)
1407 {
1408         struct rawrgb_unwind_data *data =
1409           (struct rawrgb_unwind_data *)get_opaque_ptr(unwind_obj);
1410
1411         free_opaque_ptr(unwind_obj);
1412         if (data->eimage)
1413                 xfree(data->eimage);
1414
1415         return Qnil;
1416 }
1417 static Lisp_Object rawrgba_instantiate_unwind(Lisp_Object unwind_obj)
1418 {
1419         struct rawrgba_unwind_data *data =
1420           (struct rawrgba_unwind_data *)get_opaque_ptr(unwind_obj);
1421
1422         free_opaque_ptr(unwind_obj);
1423         if (data->eimage)
1424                 xfree(data->eimage);
1425
1426         return Qnil;
1427 }
1428
1429 typedef struct rawrgb_memory_storage {
1430         Extbyte *bytes;         /* The data       */
1431         Extcount len;           /* How big is it? */
1432         int index;              /* Where are we?  */
1433 } rawrgb_memory_storage;
1434 typedef struct rawrgba_memory_storage {
1435         Extbyte *bytes;         /* The data       */
1436         Extcount len;           /* How big is it? */
1437         int index;              /* Where are we?  */
1438 } rawrgba_memory_storage;
1439
1440 #if 0
1441 static size_t rawrgb_memory_read(thandle_t data, tdata_t buf, tsize_t size)
1442 {
1443         rawrgb_memory_storage *mem = (rawrgb_memory_storage *)data;
1444
1445         if (size > (mem->len - mem->index))
1446                 return (size_t) - 1;
1447         memcpy(buf, mem->bytes + mem->index, size);
1448         mem->index = mem->index + size;
1449         return size;
1450 }
1451 static size_t rawrgba_memory_read(thandle_t data, tdata_t buf, tsize_t size)
1452 {
1453         rawrgba_memory_storage *mem = (rawrgba_memory_storage *)data;
1454
1455         if (size > (mem->len - mem->index))
1456                 return (size_t) - 1;
1457         memcpy(buf, mem->bytes + mem->index, size);
1458         mem->index = mem->index + size;
1459         return size;
1460 }
1461
1462 static size_t rawrgb_memory_write(thandle_t data, tdata_t buf, tsize_t size)
1463 {
1464         abort();
1465         return 0;               /* Shut up warnings. */
1466 }
1467 static size_t rawrgba_memory_write(thandle_t data, tdata_t buf, tsize_t size)
1468 {
1469         abort();
1470         return 0;               /* Shut up warnings. */
1471 }
1472
1473 static toff_t rawrgb_memory_seek(thandle_t data, toff_t off, int whence)
1474 {
1475         rawrgb_memory_storage *mem = (rawrgb_memory_storage *)data;
1476         int newidx;
1477         switch (whence) {
1478         case SEEK_SET:
1479                 newidx = off;
1480                 break;
1481         case SEEK_END:
1482                 newidx = mem->len + off;
1483                 break;
1484         case SEEK_CUR:
1485                 newidx = mem->index + off;
1486                 break;
1487         default:
1488                 fprintf(stderr,
1489                         "Eh? invalid seek mode in rawrgb_memory_seek\n");
1490                 return (toff_t) - 1;
1491         }
1492
1493         if ((newidx > mem->len) || (newidx < 0))
1494                 return (toff_t) - 1;
1495
1496         mem->index = newidx;
1497         return newidx;
1498 }
1499 static toff_t rawrgba_memory_seek(thandle_t data, toff_t off, int whence)
1500 {
1501         rawrgba_memory_storage *mem = (rawrgba_memory_storage *)data;
1502         int newidx;
1503         switch (whence) {
1504         case SEEK_SET:
1505                 newidx = off;
1506                 break;
1507         case SEEK_END:
1508                 newidx = mem->len + off;
1509                 break;
1510         case SEEK_CUR:
1511                 newidx = mem->index + off;
1512                 break;
1513         default:
1514                 fprintf(stderr,
1515                         "Eh? invalid seek mode in rawrgba_memory_seek\n");
1516                 return (toff_t) - 1;
1517         }
1518
1519         if ((newidx > mem->len) || (newidx < 0))
1520                 return (toff_t) - 1;
1521
1522         mem->index = newidx;
1523         return newidx;
1524 }
1525
1526 static int rawrgb_memory_close(thandle_t data)
1527 {
1528         return 0;
1529 }
1530 static int rawrgba_memory_close(thandle_t data)
1531 {
1532         return 0;
1533 }
1534
1535 static int rawrgb_map_noop(thandle_t data, tdata_t * pbase, toff_t * psize)
1536 {
1537         return 0;
1538 }
1539 static int rawrgba_map_noop(thandle_t data, tdata_t * pbase, toff_t * psize)
1540 {
1541         return 0;
1542 }
1543
1544 static void rawrgb_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
1545 {
1546         return;
1547 }
1548 static void rawrgba_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
1549 {
1550         return;
1551 }
1552
1553 static toff_t rawrgb_memory_size(thandle_t data)
1554 {
1555         rawrgb_memory_storage *mem = (rawrgb_memory_storage *) data;
1556         return mem->len;
1557 }
1558 static toff_t rawrgba_memory_size(thandle_t data)
1559 {
1560         rawrgba_memory_storage *mem = (rawrgba_memory_storage *) data;
1561         return mem->len;
1562 }
1563 #endif  /* 0 */
1564
1565 static void
1566 rawrgb_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
1567                    Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1568                    int dest_mask, Lisp_Object domain)
1569 {
1570         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
1571         rawrgb_memory_storage mem_struct;
1572         /* It is OK for the unwind data to be local to this function,
1573            because the unwind-protect is always executed when this
1574            stack frame is still valid. */
1575         struct rawrgb_unwind_data unwind;
1576         int speccount = specpdl_depth();
1577         unsigned long width, height;
1578
1579         xzero(unwind);
1580         record_unwind_protect(rawrgb_instantiate_unwind,
1581                               make_opaque_ptr(&unwind));
1582
1583         {
1584                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
1585                 Lisp_Object rows = find_keyword_in_vector(instantiator,
1586                                                           Q_pixel_height);
1587                 Lisp_Object cols = find_keyword_in_vector(instantiator,
1588                                                           Q_pixel_width);
1589                 Extbyte *bytes;
1590                 Extcount len;
1591
1592                 unsigned char *ep;
1593                 unsigned char *dp;
1594
1595                 assert(!NILP(data));
1596
1597 #ifdef HAVE_FFI
1598                 if (EFFIOP(data)) {
1599                         bytes = XEFFIO(data)->fostorage;
1600                         len = XEFFIO(data)->storage_size;
1601                 } else
1602 #endif  /* HAVE_FFI */
1603                 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1604                                    ALLOCA, (bytes, len), Qbinary);
1605                 mem_struct.bytes = bytes;
1606                 mem_struct.len = len;
1607                 mem_struct.index = 0;
1608
1609                 width = XINT(cols);
1610                 height = XINT(rows);
1611
1612                 unwind.eimage = xmalloc_atomic(len);
1613                 ep = unwind.eimage;
1614                 dp = (unsigned char*)bytes;
1615                 for ( ; dp < (unsigned char*)bytes+len; ep++, dp++)
1616                         *ep = *dp;
1617         }
1618
1619         /* now instantiate */
1620         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1621                       init_image_instance_from_eimage,
1622                       (ii, width, height, 1, unwind.eimage, dest_mask,
1623                        instantiator, domain));
1624
1625         unbind_to(speccount, Qnil);
1626 }
1627 static void
1628 rawrgba_instantiate(Lisp_Object image_instance, Lisp_Object instantiator,
1629                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1630                     int dest_mask, Lisp_Object domain)
1631 {
1632         Lisp_Image_Instance *ii = XIMAGE_INSTANCE(image_instance);
1633         rawrgba_memory_storage mem_struct;
1634         /* It is OK for the unwind data to be local to this function,
1635            because the unwind-protect is always executed when this
1636            stack frame is still valid. */
1637         struct rawrgba_unwind_data unwind;
1638         int speccount = specpdl_depth();
1639         unsigned long width, height;
1640
1641         xzero(unwind);
1642         record_unwind_protect(rawrgba_instantiate_unwind,
1643                               make_opaque_ptr(&unwind));
1644
1645         {
1646                 Lisp_Object data = find_keyword_in_vector(instantiator, Q_data);
1647                 Lisp_Object rows = find_keyword_in_vector(instantiator,
1648                                                           Q_pixel_height);
1649                 Lisp_Object cols = find_keyword_in_vector(instantiator,
1650                                                           Q_pixel_width);
1651                 Extbyte *bytes;
1652                 Extcount len;
1653
1654                 unsigned char *ep;
1655                 unsigned char *dp;
1656
1657                 assert(!NILP(data));
1658
1659 #ifdef HAVE_FFI
1660                 if (EFFIOP(data)) {
1661                         bytes = XEFFIO(data)->fostorage;
1662                         len = XEFFIO(data)->storage_size;
1663                 } else
1664 #endif  /* HAVE_FFI */
1665                 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1666                                    ALLOCA, (bytes, len), Qbinary);
1667                 mem_struct.bytes = bytes;
1668                 mem_struct.len = len;
1669                 mem_struct.index = 0;
1670
1671                 width = XINT(cols);
1672                 height = XINT(rows);
1673
1674                 unwind.eimage = xmalloc_atomic(len);
1675                 for (ep = unwind.eimage, dp = (unsigned char*)bytes;
1676                      dp < (unsigned char*)bytes+len; ep++, dp++) {
1677                         *ep = *dp;
1678                 }
1679         }
1680
1681         /* now instantiate */
1682         MAYBE_DEVMETH(DOMAIN_XDEVICE(ii->domain),
1683                       init_image_instance_from_eimage,
1684                       (ii, width, height, 1, unwind.eimage, dest_mask,
1685                        instantiator, domain));
1686
1687         unbind_to(speccount, Qnil);
1688 }
1689 #endif  /* 1 */
1690 \f
1691 /************************************************************************/
1692 /*                            initialization                            */
1693 /************************************************************************/
1694
1695 void syms_of_glyphs_eimage(void)
1696 {
1697 }
1698
1699 static void check_valid_ffio_or_string(Lisp_Object data)
1700 {
1701 #ifdef HAVE_FFI
1702         if (!EFFIOP(data) && !STRINGP(data))
1703                 dead_wrong_type_argument(Qstringp, data);
1704 #else
1705         CHECK_STRING(data);
1706 #endif  /* HAVE_FFI */
1707 }
1708
1709 void image_instantiator_format_create_glyphs_eimage(void)
1710 {
1711         /* image-instantiator types */
1712 #ifdef HAVE_JPEG
1713         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(jpeg, "jpeg");
1714
1715         IIFORMAT_HAS_METHOD(jpeg, validate);
1716         IIFORMAT_HAS_METHOD(jpeg, normalize);
1717         IIFORMAT_HAS_METHOD(jpeg, possible_dest_types);
1718         IIFORMAT_HAS_METHOD(jpeg, instantiate);
1719
1720         IIFORMAT_VALID_KEYWORD(jpeg, Q_data, check_valid_ffio_or_string);
1721         IIFORMAT_VALID_KEYWORD(jpeg, Q_file, check_valid_string);
1722 #endif
1723
1724 #ifdef HAVE_GIF
1725         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(gif, "gif");
1726
1727         IIFORMAT_HAS_METHOD(gif, validate);
1728         IIFORMAT_HAS_METHOD(gif, normalize);
1729         IIFORMAT_HAS_METHOD(gif, possible_dest_types);
1730         IIFORMAT_HAS_METHOD(gif, instantiate);
1731
1732         IIFORMAT_VALID_KEYWORD(gif, Q_data, check_valid_ffio_or_string);
1733         IIFORMAT_VALID_KEYWORD(gif, Q_file, check_valid_string);
1734 #endif
1735
1736 #if defined WITH_PNG && defined HAVE_PNG
1737         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(png, "png");
1738
1739         IIFORMAT_HAS_METHOD(png, validate);
1740         IIFORMAT_HAS_METHOD(png, normalize);
1741         IIFORMAT_HAS_METHOD(png, possible_dest_types);
1742         IIFORMAT_HAS_METHOD(png, instantiate);
1743
1744         IIFORMAT_VALID_KEYWORD(png, Q_data, check_valid_ffio_or_string);
1745         IIFORMAT_VALID_KEYWORD(png, Q_file, check_valid_string);
1746 #endif  /* PNG */
1747
1748 #ifdef HAVE_TIFF
1749         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(tiff, "tiff");
1750
1751         IIFORMAT_HAS_METHOD(tiff, validate);
1752         IIFORMAT_HAS_METHOD(tiff, normalize);
1753         IIFORMAT_HAS_METHOD(tiff, possible_dest_types);
1754         IIFORMAT_HAS_METHOD(tiff, instantiate);
1755
1756         IIFORMAT_VALID_KEYWORD(tiff, Q_data, check_valid_ffio_or_string);
1757         IIFORMAT_VALID_KEYWORD(tiff, Q_file, check_valid_string);
1758 #endif
1759
1760 #if 1
1761         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(rawrgb, "rawrgb");
1762         INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(rawrgba, "rawrgba");
1763
1764         IIFORMAT_HAS_METHOD(rawrgb, validate);
1765         IIFORMAT_HAS_METHOD(rawrgb, normalize);
1766         IIFORMAT_HAS_METHOD(rawrgb, possible_dest_types);
1767         IIFORMAT_HAS_METHOD(rawrgb, instantiate);
1768
1769         IIFORMAT_HAS_METHOD(rawrgba, validate);
1770         IIFORMAT_HAS_METHOD(rawrgba, normalize);
1771         IIFORMAT_HAS_METHOD(rawrgba, possible_dest_types);
1772         IIFORMAT_HAS_METHOD(rawrgba, instantiate);
1773
1774         IIFORMAT_VALID_KEYWORD(rawrgb, Q_data, check_valid_ffio_or_string);
1775         IIFORMAT_VALID_KEYWORD(rawrgb, Q_pixel_width, check_valid_int);
1776         IIFORMAT_VALID_KEYWORD(rawrgb, Q_pixel_height, check_valid_int);
1777
1778         IIFORMAT_VALID_KEYWORD(rawrgba, Q_data, check_valid_ffio_or_string);
1779         IIFORMAT_VALID_KEYWORD(rawrgba, Q_pixel_width, check_valid_int);
1780         IIFORMAT_VALID_KEYWORD(rawrgba, Q_pixel_height, check_valid_int);
1781 #endif
1782 }
1783
1784 void vars_of_glyphs_eimage(void)
1785 {
1786 #ifdef HAVE_JPEG
1787         Fprovide(Qjpeg);
1788 #endif
1789
1790 #ifdef HAVE_GIF
1791         Fprovide(Qgif);
1792 #endif
1793
1794 #if defined WITH_PNG && defined HAVE_PNG
1795         Fprovide(Qpng);
1796 #endif  /* PNG */
1797
1798 #ifdef HAVE_TIFF
1799         Fprovide(Qtiff);
1800 #endif
1801
1802 #if 1
1803         Fprovide(Qrawrgb);
1804         Fprovide(Qrawrgba);
1805 #endif
1806 }