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