Commit | Line | Data |
---|---|---|
ec6d8908 TC |
1 | #define PERL_NO_GET_CONTEXT |
2 | #ifdef __cplusplus | |
3 | extern "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 | ||
13 | DEFINE_IMAGER_CALLBACKS; | |
14 | DEFINE_IMAGER_PERL_CALLBACKS; | |
15 | ||
16 | MODULE = Imager::File::GIF PACKAGE = Imager::File::GIF | |
17 | ||
4922fb3a | 18 | double |
ec6d8908 TC |
19 | i_giflib_version() |
20 | ||
21 | undef_int | |
22 | i_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 | ||
73 | void | |
74 | i_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 | ||
121 | Imager::ImgRaw | |
122 | i_readgif_single_wiol(ig, page=0) | |
123 | Imager::IO ig | |
124 | int page | |
125 | ||
126 | void | |
127 | i_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 | ||
146 | BOOT: | |
147 | PERL_INITIALIZE_IMAGER_CALLBACKS; | |
148 | PERL_INITIALIZE_IMAGER_PERL_CALLBACKS; | |
536b7775 | 149 | i_init_gif(); |