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