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__ |