File Coverage

blib/lib/Math/FitRect.pm
Criterion Covered Total %
statement 38 47 80.8
branch 8 16 50.0
condition n/a
subroutine 8 8 100.0
pod 2 2 100.0
total 56 73 76.7


line stmt bran cond sub pod time code
1             package Math::FitRect;
2              
3             $Math::FitRect::VERSION = '0.05';
4              
5             =head1 NAME
6              
7             Math::FitRect - Resize one rect in to another while preserving aspect ratio.
8              
9             =head1 SYNOPSIS
10              
11             use Math::FitRect;
12            
13             # This will return: {w=>40, h=>20, x=>0, y=>10}
14             my $rect = fit_rect( [80,40] => 40 );
15            
16             # This will return: {w=>80, h=>40, x=>-19, y=>0}
17             my $rect = crop_rect( [80,40] => 40 );
18              
19             =head1 DESCRIPTION
20              
21             This module is very simple in its content but can save much time, much like
22             other simplistic modules like L. This module is useful for
23             calculating what size you should resize images as for such things as
24             thumbnails.
25              
26             =cut
27              
28 1     1   210436 use strict;
  1         3  
  1         28  
29 1     1   6 use warnings;
  1         2  
  1         27  
30              
31 1     1   5 use Carp qw( croak );
  1         2  
  1         43  
32              
33 1     1   5 use Exporter qw( import );
  1         2  
  1         446  
34             our @EXPORT_OK = qw(
35             fit_rect
36             crop_rect
37             );
38              
39             =head1 RECTANGLES
40              
41             Rectangles may be specified in several different forms to fit your needs.
42              
43             =over
44              
45             =item A simple scalar integer containg the pixel width/height of a square.
46              
47             =item An array ref containing the width and height of a rectangle: [$width,$height]
48              
49             =item A hash ref containg a w (width) and h (height) key: {w=>$width,h=>$height}
50              
51             =back
52              
53             =head1 FUNCTIONS
54              
55             =head2 fit_rect
56              
57             # This will return: {w=>40, h=>20, x=>0, y=>10}
58             my $rect = fit_rect( [80,40] => 40 );
59              
60             Takes two rectangles and fits the first one inside the second one. The rectangle
61             that will be returned will be a hash ref with a 'w' and 'h' parameter as well
62             as 'x' and 'y' parameters which will specify any offset.
63              
64             =cut
65              
66             sub fit_rect {
67 4     4 1 5856 return _calc_rect('fit',@_);
68             }
69              
70             =head2 crop_rect
71              
72             # This will return: {w=>80, h=>40, x=>-19, y=>0}
73             my $rect = crop_rect( [80,40] => 40 );
74              
75             Like the fit_rect function, crop_rect takes two rectangles as a parameter and it
76             makes $rect1 completely fill $rect2. This can mean that the top and bottom or
77             the left and right get chopped off (cropped). This method returns a hash ref just
78             like fit_rect.
79              
80             =cut
81              
82             sub crop_rect {
83 4     4 1 2956 return _calc_rect('crop',@_);
84             }
85              
86             sub _calc_rect {
87 8     8   340 my($type,$from,$to) = @_;
88 8         20 $from = _normalize($from);
89 8         18 $to = _normalize($to);
90 8         15 my($w,$h,$x,$y);
91 8 100       20 if($type eq 'crop'){ ($to->{r},$from->{r}) = ($from->{r},$to->{r}); }
  4         12  
92              
93 8 100       24 if($from->{r} < $to->{r}){
94 2         5 $w = $from->{w} * ($to->{h}/$from->{h});
95 2         5 $h = $to->{h};
96 2         12 $x = ($to->{w}-$w)/2;
97 2         5 $y = 0;
98             }else{
99 6         12 $h = $from->{h} * ($to->{w}/$from->{w});
100 6         8 $w = $to->{w};
101 6         12 $y = ($to->{h}-$h)/2;
102 6         9 $x = 0;
103             }
104              
105 8         77 return {w=>int($w+0.5),h=>int($h+0.5),x=>int($x+0.5),y=>int($y+0.5)};
106             }
107              
108             sub _normalize {
109 16     16   23 my $rect = shift;
110 16         25 my($w,$h,$r);
111 16 100       49 if(!ref($rect)){ # square
    50          
    50          
    0          
112 8         11 $w = $h = $rect;
113             }elsif(ref($rect) eq 'HASH'){ # rect hash ref
114 0         0 $w = $rect->{w};
115 0         0 $h = $rect->{h};
116             }elsif(@$rect==2){ # width, height
117 8         14 $w = $rect->[0];
118 8         9 $h = $rect->[1];
119             }elsif(@$rect==4){ # x1, y1, x2, y2
120 0 0       0 if($rect->[0]<$rect->[2]){ $w=($rect->[2]-$rect->[0])+1; }
  0         0  
121 0         0 else{ $w=($rect->[0]-$rect->[2])+1; }
122 0 0       0 if($rect->[1]<$rect->[3]){ $h=($rect->[3]-$rect->[1])+1; }
  0         0  
123 0         0 else{ $h=($rect->[1]-$rect->[3])+1; }
124             }else{
125 0         0 croak('Invalid rectangle parameter');
126             }
127 16         27 $r = $w/$h;
128 16         44 return {w=>$w,h=>$h,r=>$r};
129             }
130              
131             1;
132             __END__