treat the ico mask as an alpha channel, since this is less confusing
[imager.git] / 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