bump $Imager::Font::FT2::VERSION
[imager.git] / GIF / GIF.xs
CommitLineData
ec6d8908
TC
1#define PERL_NO_GET_CONTEXT
2#ifdef __cplusplus
3extern "C" {
4#endif
5#include "EXTERN.h"
6#include "perl.h"
7#include "XSUB.h"
8#include "imext.h"
9#include "imperl.h"
10#include "imgif.h"
11#include "imextpl.h"
12
13DEFINE_IMAGER_CALLBACKS;
14DEFINE_IMAGER_PERL_CALLBACKS;
15
16MODULE = Imager::File::GIF PACKAGE = Imager::File::GIF
17
4922fb3a 18double
ec6d8908
TC
19i_giflib_version()
20
21undef_int
22i_writegif_wiol(ig, opts,...)
23 Imager::IO ig
24 PREINIT:
25 i_quantize quant;
26 i_img **imgs = NULL;
27 int img_count;
28 int i;
29 HV *hv;
30 CODE:
31 if (items < 3)
32 croak("Usage: i_writegif_wiol(IO,hashref, images...)");
33 if (!SvROK(ST(1)) || ! SvTYPE(SvRV(ST(1))))
34 croak("i_writegif_callback: Second argument must be a hash ref");
35 hv = (HV *)SvRV(ST(1));
36 memset(&quant, 0, sizeof(quant));
37 quant.version = 1;
38 quant.mc_size = 256;
39 quant.transp = tr_threshold;
40 quant.tr_threshold = 127;
41 ip_handle_quant_opts(aTHX_ &quant, hv);
42 img_count = items - 2;
43 RETVAL = 1;
44 if (img_count < 1) {
45 RETVAL = 0;
46 }
47 else {
48 imgs = mymalloc(sizeof(i_img *) * img_count);
49 for (i = 0; i < img_count; ++i) {
50 SV *sv = ST(2+i);
51 imgs[i] = NULL;
52 if (SvROK(sv) && sv_derived_from(sv, "Imager::ImgRaw")) {
53 imgs[i] = INT2PTR(i_img *, SvIV((SV*)SvRV(sv)));
54 }
55 else {
56 RETVAL = 0;
57 break;
58 }
59 }
60 if (RETVAL) {
61 RETVAL = i_writegif_wiol(ig, &quant, imgs, img_count);
62 }
63 myfree(imgs);
64 if (RETVAL) {
65 ip_copy_colors_back(aTHX_ hv, &quant);
66 }
67 }
ec6d8908 68 ip_cleanup_quant_opts(aTHX_ &quant);
a139e7e9
TC
69 OUTPUT:
70 RETVAL
ec6d8908
TC
71
72
73void
74i_readgif_wiol(ig)
75 Imager::IO ig
76 PREINIT:
77 int* colour_table;
78 int colours, q, w;
79 i_img* rimg;
80 SV* temp[3];
81 AV* ct;
82 SV* r;
83 PPCODE:
84 colour_table = NULL;
85 colours = 0;
86
87 if(GIMME_V == G_ARRAY) {
88 rimg = i_readgif_wiol(ig,&colour_table,&colours);
89 } else {
90 /* don't waste time with colours if they aren't wanted */
91 rimg = i_readgif_wiol(ig,NULL,NULL);
92 }
93
94 if (colour_table == NULL) {
95 EXTEND(SP,1);
96 r=sv_newmortal();
97 sv_setref_pv(r, "Imager::ImgRaw", (void*)rimg);
98 PUSHs(r);
99 } else {
100 /* the following creates an [[r,g,b], [r, g, b], [r, g, b]...] */
101 /* I don't know if I have the reference counts right or not :( */
102 /* Neither do I :-) */
103 /* No Idea here either */
104
105 ct=newAV();
106 av_extend(ct, colours);
107 for(q=0; q<colours; q++) {
108 for(w=0; w<3; w++)
109 temp[w]=sv_2mortal(newSViv(colour_table[q*3 + w]));
110 av_store(ct, q, (SV*)newRV_noinc((SV*)av_make(3, temp)));
111 }
112 myfree(colour_table);
113
114 EXTEND(SP,2);
115 r = sv_newmortal();
116 sv_setref_pv(r, "Imager::ImgRaw", (void*)rimg);
117 PUSHs(r);
118 PUSHs(newRV_noinc((SV*)ct));
119 }
120
121Imager::ImgRaw
122i_readgif_single_wiol(ig, page=0)
123 Imager::IO ig
124 int page
125
126void
127i_readgif_multi_wiol(ig)
128 Imager::IO ig
129 PREINIT:
130 i_img **imgs;
131 int count;
132 int i;
133 PPCODE:
134 imgs = i_readgif_multi_wiol(ig, &count);
135 if (imgs) {
136 EXTEND(SP, count);
137 for (i = 0; i < count; ++i) {
138 SV *sv = sv_newmortal();
139 sv_setref_pv(sv, "Imager::ImgRaw", (void *)imgs[i]);
140 PUSHs(sv);
141 }
142 myfree(imgs);
143 }
144
145
146BOOT:
147 PERL_INITIALIZE_IMAGER_CALLBACKS;
148 PERL_INITIALIZE_IMAGER_PERL_CALLBACKS;
536b7775 149 i_init_gif();