Permalink
Browse files

move the GIF file handling code into a sub-module

  • Loading branch information...
1 parent e17b702 commit ec6d89084477350e1b224644166f4bd337f67055 Tony Cook committed Aug 23, 2010
View
@@ -8,6 +8,10 @@ Imager 0.78 - unreleased
Thanks to Justin Davis.
https://rt.cpan.org/Ticket/Display.html?id=60491
+ - moved the GIF file handling code into a sub-module in preparation
+ for separate distribution.
+ https://rt.cpan.org/Ticket/Display.html?id=49616 (partial)
+
Bug fixes:
- Imager::Probe was calling ExtUtils::Liblist to initialize
View
@@ -0,0 +1,130 @@
+package Imager::File::GIF;
+use strict;
+use Imager;
+use vars qw($VERSION @ISA);
+
+BEGIN {
+ $VERSION = "0.77";
+
+ eval {
+ require XSLoader;
+ XSLoader::load('Imager::File::GIF', $VERSION);
+ 1;
+ } or do {
+print STDERR "Falling back to DynaLoader ($@)\n";
+ require DynaLoader;
+ push @ISA, 'DynaLoader';
+ bootstrap Imager::File::GIF $VERSION;
+ };
+}
+
+Imager->register_reader
+ (
+ type=>'gif',
+ single =>
+ sub {
+ my ($im, $io, %hsh) = @_;
+
+ if ($hsh{gif_consolidate}) {
+ if ($hsh{colors}) {
+ my $colors;
+ ($im->{IMG}, $colors) =i_readgif_wiol( $io );
+ if ($colors) {
+ ${ $hsh{colors} } = [ map { NC(@$_) } @$colors ];
+ }
+ }
+ else {
+ $im->{IMG} =i_readgif_wiol( $io );
+ }
+ }
+ else {
+ my $page = $hsh{page};
+ defined $page or $page = 0;
+ $im->{IMG} = i_readgif_single_wiol($io, $page);
+
+ unless ($im->{IMG}) {
+ $im->_set_error(Imager->_error_as_msg);
+ return;
+ }
+ if ($hsh{colors}) {
+ ${ $hsh{colors} } = [ $im->getcolors ];
+ }
+ return $im;
+ }
+ },
+ multiple =>
+ sub {
+ my ($io, %hsh) = @_;
+
+ my @imgs = i_readgif_multi_wiol($io);
+ unless (@imgs) {
+ Imager->_set_error(Imager->_error_as_msg);
+ return;
+ }
+
+ return map bless({ IMG => $_, ERRSTR => undef }, "Imager"), @imgs;
+ },
+ );
+
+Imager->register_writer
+ (
+ type=>'gif',
+ single =>
+ sub {
+ my ($im, $io, %hsh) = @_;
+
+ $im->_set_opts(\%hsh, "i_", $im);
+ $im->_set_opts(\%hsh, "gif_", $im);
+
+ unless (i_writegif_wiol($io, \%hsh, $im->{IMG})) {
+ $im->_set_error(Imager->_error_as_msg);
+ return;
+ }
+ return $im;
+ },
+ multiple =>
+ sub {
+ my ($class, $io, $opts, @ims) = @_;
+
+ Imager->_set_opts($opts, "gif_", @ims);
+
+ my @work = map $_->{IMG}, @ims;
+ unless (i_writegif_wiol($io, $opts, @work)) {
+ Imager->_set_error(Imager->_error_as_msg);
+ return;
+ }
+
+ return 1;
+ },
+ );
+
+__END__
+
+=head1 NAME
+
+Imager::File::GIF - read and write GIF files
+
+=head1 SYNOPSIS
+
+ use Imager;
+
+ my $img = Imager->new;
+ $img->read(file=>"foo.gif")
+ or die $img->errstr;
+
+ $img->write(file => "foo.gif")
+ or die $img->errstr;
+
+=head1 DESCRIPTION
+
+Imager's GIF support is documented in L<Imager::Files>.
+
+=head1 AUTHOR
+
+Tony Cook <tony@imager.perl.org>
+
+=head1 SEE ALSO
+
+Imager, Imager::Files.
+
+=cut
View
@@ -0,0 +1,149 @@
+#define PERL_NO_GET_CONTEXT
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "imext.h"
+#include "imperl.h"
+#include "imgif.h"
+#include "imextpl.h"
+
+DEFINE_IMAGER_CALLBACKS;
+DEFINE_IMAGER_PERL_CALLBACKS;
+
+MODULE = Imager::File::GIF PACKAGE = Imager::File::GIF
+
+long
+i_giflib_version()
+
+undef_int
+i_writegif_wiol(ig, opts,...)
+ Imager::IO ig
+ PREINIT:
+ i_quantize quant;
+ i_img **imgs = NULL;
+ int img_count;
+ int i;
+ HV *hv;
+ CODE:
+ if (items < 3)
+ croak("Usage: i_writegif_wiol(IO,hashref, images...)");
+ if (!SvROK(ST(1)) || ! SvTYPE(SvRV(ST(1))))
+ croak("i_writegif_callback: Second argument must be a hash ref");
+ hv = (HV *)SvRV(ST(1));
+ memset(&quant, 0, sizeof(quant));
+ quant.version = 1;
+ quant.mc_size = 256;
+ quant.transp = tr_threshold;
+ quant.tr_threshold = 127;
+ ip_handle_quant_opts(aTHX_ &quant, hv);
+ img_count = items - 2;
+ RETVAL = 1;
+ if (img_count < 1) {
+ RETVAL = 0;
+ }
+ else {
+ imgs = mymalloc(sizeof(i_img *) * img_count);
+ for (i = 0; i < img_count; ++i) {
+ SV *sv = ST(2+i);
+ imgs[i] = NULL;
+ if (SvROK(sv) && sv_derived_from(sv, "Imager::ImgRaw")) {
+ imgs[i] = INT2PTR(i_img *, SvIV((SV*)SvRV(sv)));
+ }
+ else {
+ RETVAL = 0;
+ break;
+ }
+ }
+ if (RETVAL) {
+ RETVAL = i_writegif_wiol(ig, &quant, imgs, img_count);
+ }
+ myfree(imgs);
+ if (RETVAL) {
+ ip_copy_colors_back(aTHX_ hv, &quant);
+ }
+ }
+ ST(0) = sv_newmortal();
+ if (RETVAL == 0) ST(0)=&PL_sv_undef;
+ else sv_setiv(ST(0), (IV)RETVAL);
+ ip_cleanup_quant_opts(aTHX_ &quant);
+
+
+void
+i_readgif_wiol(ig)
+ Imager::IO ig
+ PREINIT:
+ int* colour_table;
+ int colours, q, w;
+ i_img* rimg;
+ SV* temp[3];
+ AV* ct;
+ SV* r;
+ PPCODE:
+ colour_table = NULL;
+ colours = 0;
+
+ if(GIMME_V == G_ARRAY) {
+ rimg = i_readgif_wiol(ig,&colour_table,&colours);
+ } else {
+ /* don't waste time with colours if they aren't wanted */
+ rimg = i_readgif_wiol(ig,NULL,NULL);
+ }
+
+ if (colour_table == NULL) {
+ EXTEND(SP,1);
+ r=sv_newmortal();
+ sv_setref_pv(r, "Imager::ImgRaw", (void*)rimg);
+ PUSHs(r);
+ } else {
+ /* the following creates an [[r,g,b], [r, g, b], [r, g, b]...] */
+ /* I don't know if I have the reference counts right or not :( */
+ /* Neither do I :-) */
+ /* No Idea here either */
+
+ ct=newAV();
+ av_extend(ct, colours);
+ for(q=0; q<colours; q++) {
+ for(w=0; w<3; w++)
+ temp[w]=sv_2mortal(newSViv(colour_table[q*3 + w]));
+ av_store(ct, q, (SV*)newRV_noinc((SV*)av_make(3, temp)));
+ }
+ myfree(colour_table);
+
+ EXTEND(SP,2);
+ r = sv_newmortal();
+ sv_setref_pv(r, "Imager::ImgRaw", (void*)rimg);
+ PUSHs(r);
+ PUSHs(newRV_noinc((SV*)ct));
+ }
+
+Imager::ImgRaw
+i_readgif_single_wiol(ig, page=0)
+ Imager::IO ig
+ int page
+
+void
+i_readgif_multi_wiol(ig)
+ Imager::IO ig
+ PREINIT:
+ i_img **imgs;
+ int count;
+ int i;
+ PPCODE:
+ imgs = i_readgif_multi_wiol(ig, &count);
+ if (imgs) {
+ EXTEND(SP, count);
+ for (i = 0; i < count; ++i) {
+ SV *sv = sv_newmortal();
+ sv_setref_pv(sv, "Imager::ImgRaw", (void *)imgs[i]);
+ PUSHs(sv);
+ }
+ myfree(imgs);
+ }
+
+
+BOOT:
+ PERL_INITIALIZE_IMAGER_CALLBACKS;
+ PERL_INITIALIZE_IMAGER_PERL_CALLBACKS;
Oops, something went wrong.

0 comments on commit ec6d890

Please sign in to comment.