File Coverage

lib/SVG/Estimate/Path/QuadraticBezier.pm
Criterion Covered Total %
statement 28 28 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 32 32 100.0


line stmt bran cond sub pod time code
1             package SVG::Estimate::Path::QuadraticBezier;
2             $SVG::Estimate::Path::QuadraticBezier::VERSION = '1.0113';
3 10     10   1250 use Moo;
  10         16  
  10         54  
4 10     10   2861 use List::Util qw/min max/;
  10         20  
  10         605  
5 10     10   765 use Clone qw/clone/;
  10         3943  
  10         4572  
6              
7             extends 'SVG::Estimate::Path::Command';
8             with 'SVG::Estimate::Role::EndToPoint';
9              
10             =head1 NAME
11              
12             SVG::Estimate::Path::QuadraticBezier - Handles estimating quadratic bezier curves.
13              
14             =head1 VERSION
15              
16             version 1.0113
17              
18             =head1 SYNOPSIS
19              
20             my $curve = SVG::Estimate::Path::QuadraticBezier->new(
21             transformer => $transform,
22             start_point => [13, 19],
23             point => [45,13],
24             control => [10,3],
25             );
26              
27             my $length = $curve->length;
28              
29             =head1 INHERITANCE
30              
31             This class extends L and consumes L.
32              
33             =head1 METHODS
34              
35             =head2 new()
36              
37             Constructor.
38              
39             =over
40              
41             =item point
42              
43             An array ref containing two floats that represent a point.
44              
45             =item control
46              
47             An array ref containing two floats that represent a point.
48              
49             =back
50              
51             =cut
52              
53             has point => (
54             is => 'ro',
55             required => 1,
56             );
57              
58             has control => (
59             is => 'ro',
60             required => 1,
61             );
62              
63             sub BUILDARGS {
64             my ($class, @args) = @_;
65             ##Upgrade to hashref
66             my $args = @args % 2 ? $args[0] : { @args };
67             if ($args->{transformer}->has_transforms) {
68             $args->{point} = $args->{transformer}->transform($args->{point});
69             $args->{control} = $args->{transformer}->transform($args->{control});
70             }
71             $args->{end_point} = clone $args->{point};
72             $args->{shape_length} = $class->_calculate_length($args);
73             $args->{travel_length} = 0;
74             ##Bouding box points approximated by the control points.
75             $args->{min_x} = min $args->{start_point}->[0], $args->{control}->[0], $args->{point}->[0];
76             $args->{max_x} = max $args->{start_point}->[0], $args->{control}->[0], $args->{point}->[0];
77             $args->{min_y} = min $args->{start_point}->[1], $args->{control}->[1], $args->{point}->[1];
78             $args->{max_y} = max $args->{start_point}->[1], $args->{control}->[1], $args->{point}->[1];
79             return $args;
80             }
81              
82             sub _calculate_length {
83 2     2   4 my $class = shift;
84 2         4 my $args = shift;
85 2         3 my $start = $args->{start_point};
86 2         4 my $control = $args->{control};
87 2         4 my $end = $args->{point};
88              
89             ##http://www.malczak.info/blog/quadratic-bezier-curve-length/
90 2         4 my $a_x = $start->[0] - 2 * $control->[0] + $end->[0];
91 2         6 my $a_y = $start->[1] - 2 * $control->[1] + $end->[1];
92 2         4 my $b_x = 2 * ($end->[0] - $start->[0]);
93 2         4 my $b_y = 2 * ($end->[1] - $start->[1]);
94              
95 2         4 my $A = 4 * ($a_x**2 + $a_y**2);
96 2         4 my $B = 4 * ($a_x*$b_x + $a_y*$b_y);
97 2         3 my $C = $b_x**2 + $b_y**2;
98              
99 2         6 my $SABC = 2 * sqrt($A + $B +$C);
100 2         4 my $SA = sqrt($A);
101 2         2 my $A32 = 2 * $A * $SA;
102 2         4 my $SC = 2*sqrt($C);
103 2         5 my $BA = $B / $SA;
104              
105 2         13 my $length = ( $A32 + $SA*$B*($SABC-$SC) + (4*$C*$A - $B*$B)*log( (2*$SA + $BA + $SABC)/($BA + $SC) ) ) / (4*($A32));
106 2         6 return $length;
107             }
108              
109             1;