ICO/ICO.pm

   1 package Imager::File::ICO;
   2 use strict;
   3 use Imager;
   4 use vars qw($VERSION @ISA);
   5
   6 BEGIN {
   7   $VERSION = "0.01";
   8
   9   eval {
  10     require XSLoader;
  11     XSLoader::load('Imager::File::ICO', $VERSION);
  12     1;
  13   } or do {
  14     require DynaLoader;
  15     push @ISA, 'DynaLoader';
  16     bootstrap Imager::File::ICO $VERSION;
  17   };
  18 }
  19
  20 Imager->register_reader
  21   (
  22    type=>'ico',
  23    single =>
  24    sub {
  25      my ($im, $io, %hsh) = @_;
  26      my $masked =
  27        exists $hsh{ico_masked} ? $hsh{ico_masked} : 1;
  28      $im->{IMG} = i_readico_single($io, $hsh{page} || 0, $masked);
  29
  30      unless ($im->{IMG}) {
  31        $im->_set_error(Imager->_error_as_msg);
  32        return;
  33      }
  34      return $im;
  35    },
  36    multiple =>
  37    sub {
  38      my ($io, %hsh) = @_;
  39
  40      my $masked =
  41        exists $hsh{ico_masked} ? $hsh{ico_masked} : 1;
  42      my @imgs = i_readico_multi($io, $masked);
  43      unless (@imgs) {
  44        Imager->_set_error(Imager->_error_as_msg);
  45        return;
  46      }
  47      return map {
  48        bless { IMG => $_, DEBUG => $Imager::DEBUG, ERRSTR => undef }, 'Imager'
  49      } @imgs;
  50    },
  51   );
  52
  53 # the readers can read CUR files too
  54 Imager->register_reader
  55   (
  56    type=>'cur',
  57    single =>
  58    sub {
  59      my ($im, $io, %hsh) = @_;
  60      my $masked =
  61        exists $hsh{ico_masked} ? $hsh{ico_masked} : 1;
  62      $im->{IMG} = i_readico_single($io, $hsh{page} || 0, $masked);
  63
  64      unless ($im->{IMG}) {
  65        $im->_set_error(Imager->_error_as_msg);
  66        return;
  67      }
  68      return $im;
  69    },
  70    multiple =>
  71    sub {
  72      my ($io, %hsh) = @_;
  73
  74      my $masked =
  75        exists $hsh{ico_masked} ? $hsh{ico_masked} : 1;
  76      my @imgs = i_readico_multi($io, $masked);
  77      unless (@imgs) {
  78        Imager->_set_error(Imager->_error_as_msg);
  79        return;
  80      }
  81      return map {
  82        bless { IMG => $_, DEBUG => $Imager::DEBUG, ERRSTR => undef }, 'Imager'
  83      } @imgs;
  84    },
  85   );
  86
  87 Imager->register_writer
  88   (
  89    type=>'ico',
  90    single =>
  91    sub {
  92      my ($im, $io, %hsh) = @_;
  93
  94      unless (i_writeico_wiol($io, $im->{IMG})) {
  95        $im->_set_error(Imager->_error_as_msg);
  96        return;
  97      }
  98      return $im;
  99    },
 100    multiple =>
 101    sub {
 102      my ($class, $io, $opts, @images) = @_;
 103
 104      if (!i_writeico_multi_wiol($io, map $_->{IMG}, @images)) {
 105        Imager->_set_error(Imager->_error_as_msg);
 106        return;
 107      }
 108
 109      return 1;
 110    },
 111   );
 112
 113 Imager->register_writer
 114   (
 115    type=>'cur',
 116    single =>
 117    sub {
 118      my ($im, $io, %hsh) = @_;
 119
 120      unless (i_writecur_wiol($io, $im->{IMG})) {
 121        $im->_set_error(Imager->_error_as_msg);
 122        return;
 123      }
 124      return $im;
 125    },
 126    multiple =>
 127    sub {
 128      my ($class, $io, $opts, @images) = @_;
 129
 130      if (!i_writecur_multi_wiol($io, map $_->{IMG}, @images)) {
 131        Imager->_set_error(Imager->_error_as_msg);
 132        return;
 133      }
 134
 135      return 1;
 136    },
 137   );
 138
 139 1;
 140
 141 __END__
 142
 143 =head1 NAME
 144
 145 Imager::File::ICO - read MS Icon files
 146
 147 =head1 SYNOPSIS
 148
 149   use Imager;
 150
 151   my $img = Imager->new;
 152   $img->read(file=>"foo.ico")
 153     or die $img->errstr;
 154
 155   my @imgs = Imager->read_multi(file => "foo.ico")
 156     or die Imager->errstr;
 157
 158   $img->write(file => "foo.ico")
 159     or die $img->errstr;
 160
 161   Imager->write_multi({ file => "foo.ico" }, @imgs)
 162     or die Imager->errstr;
 163
 164 =head1 DESCRIPTION
 165
 166 Imager's MS Icon support is documented in L<Imager::Files>.
 167
 168 =head1 AUTHOR
 169
 170 Tony Cook <tony@imager.perl.org>
 171
 172 =head1 SEE ALSO
 173
 174 Imager, Imager::Files.
 175
 176 =cut