File Coverage

blib/lib/Imager/Filter/Bakumatsu.pm
Criterion Covered Total %
statement 12 24 50.0
branch 0 4 0.0
condition n/a
subroutine 4 5 80.0
pod 1 1 100.0
total 17 34 50.0


line stmt bran cond sub pod time code
1             package Imager::Filter::Bakumatsu;
2 2     2   57584 use strict;
  2         3  
  2         43  
3 2     2   6 use warnings;
  2         2  
  2         64  
4             our $VERSION = '0.05';
5              
6 2     2   747 use Imager;
  2         30670  
  2         9  
7 2     2   999 use File::ShareDir 'dist_file';
  2         8940  
  2         394  
8              
9             my $texture = dist_file('Imager-Filter-Bakumatsu', 'BakumatsuTexture.png');
10              
11             Imager->register_filter(
12             type => 'bakumatsu',
13             callsub => \&bakumatsu,
14             callseq => [],
15             defaults => {
16             overlay_image => $texture,
17             },
18             );
19              
20             sub bakumatsu {
21 0     0 1   my %opt = @_;
22 0           my $self = delete $opt{imager};
23 0           my $work = $self;
24            
25 0           $work = $work->convert(
26             matrix => [
27             [ 1.7, 0, 0, 0 ],
28             [ 0, 1.7, 0, 0 ],
29             [ 0, 0, 1.7, 0 ],
30             ],
31             );
32            
33 0           $work->filter(
34             type => 'contrast',
35             intensity => 1.2,
36             );
37            
38 0           $work->filter(
39             type => 'autolevels',
40             lsat => 0.3,
41             usat => 0.3,
42             );
43            
44 0           $work = $work->convert(
45             matrix => [
46             [ 1 / 4, 1 / 2, 1 / 8, 0 ],
47             [ 1 / 4, 1 / 2, 1 / 8, 0 ],
48             [ 1 / 4, 1 / 2, 1 / 8, 0 ],
49             ],
50             );
51            
52             $work->rubthrough(
53 0 0         src => do {
54 0           my $overlay = Imager->new;
55             $overlay->read(file => $opt{overlay_image})
56 0 0         or die $overlay->errstr;
57            
58 0           $overlay = $overlay->scale(
59             xpixels => $work->getwidth,
60             ypixels => $work->getheight,
61             type => 'nonprop'
62             );
63             },
64             ) or die $work->errstr;
65            
66 0           $self->{IMG} = delete $work->{IMG};
67             }
68              
69             1;
70             __END__