| line | stmt | bran | cond | sub | pod | time | code | 
| 1 | 7 |  |  | 7 |  | 63435 | use strict; | 
|  | 7 |  |  |  |  | 11 |  | 
|  | 7 |  |  |  |  | 269 |  | 
| 2 | 7 |  |  | 7 |  | 31 | use warnings; | 
|  | 7 |  |  |  |  | 11 |  | 
|  | 7 |  |  |  |  | 302 |  | 
| 3 |  |  |  |  |  |  | package Math::Shape::Vector; | 
| 4 |  |  |  |  |  |  | $Math::Shape::Vector::VERSION = '0.13'; | 
| 5 | 7 |  |  | 7 |  | 122 | use 5.008; | 
|  | 7 |  |  |  |  | 20 |  | 
|  | 7 |  |  |  |  | 222 |  | 
| 6 | 7 |  |  | 7 |  | 27 | use Carp; | 
|  | 7 |  |  |  |  | 17 |  | 
|  | 7 |  |  |  |  | 457 |  | 
| 7 | 7 |  |  | 7 |  | 2388 | use Math::Shape::Utils; | 
|  | 7 |  |  |  |  | 15 |  | 
|  | 7 |  |  |  |  | 544 |  | 
| 8 | 7 |  |  | 7 |  | 42 | use Math::Trig; | 
|  | 7 |  |  |  |  | 10 |  | 
|  | 7 |  |  |  |  | 9023 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | # ABSTRACT: A 2d vector library in cartesian space | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | sub new { | 
| 14 | 1749 | 100 |  | 1749 | 1 | 2526 | croak 'incorrect number of arguments' unless @_ == 3; | 
| 15 | 1747 |  |  |  |  | 5261 | return bless { x => $_[1], | 
| 16 |  |  |  |  |  |  | y => $_[2] }, $_[0]; | 
| 17 |  |  |  |  |  |  | } | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | sub add_vector { | 
| 21 | 226 | 100 |  | 226 | 1 | 609 | croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector'); | 
| 22 | 224 |  |  |  |  | 198 | my ($self, $v2) = @_; | 
| 23 |  |  |  |  |  |  |  | 
| 24 | 224 |  |  |  |  | 469 | Math::Shape::Vector->new( | 
| 25 |  |  |  |  |  |  | $self->{x} + $v2->{x}, | 
| 26 |  |  |  |  |  |  | $self->{y} + $v2->{y}, | 
| 27 |  |  |  |  |  |  | ); | 
| 28 |  |  |  |  |  |  | } | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | sub subtract_vector { | 
| 32 | 327 | 100 |  | 327 | 1 | 860 | croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector'); | 
| 33 | 324 |  |  |  |  | 287 | my ($self, $v2) = @_; | 
| 34 |  |  |  |  |  |  |  | 
| 35 | 324 |  |  |  |  | 785 | Math::Shape::Vector->new( | 
| 36 |  |  |  |  |  |  | $self->{x} - $v2->{x}, | 
| 37 |  |  |  |  |  |  | $self->{y} - $v2->{y}, | 
| 38 |  |  |  |  |  |  | ); | 
| 39 |  |  |  |  |  |  | } | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | sub negate { | 
| 43 | 27 |  |  | 27 | 1 | 29 | my $self = shift; | 
| 44 |  |  |  |  |  |  |  | 
| 45 | 27 |  |  |  |  | 61 | Math::Shape::Vector->new( | 
| 46 |  |  |  |  |  |  | - $self->{x}, | 
| 47 |  |  |  |  |  |  | - $self->{y}, | 
| 48 |  |  |  |  |  |  | ); | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | sub is_equal { | 
| 53 | 12 | 100 |  | 12 | 1 | 80 | croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector'); | 
| 54 | 11 |  |  |  |  | 13 | my ($self, $v2) = @_; | 
| 55 | 11 | 100 | 100 |  |  | 97 | $self->{x} == $v2->{x} && $self->{y} == $v2->{y} | 
| 56 |  |  |  |  |  |  | ? 1 : 0; | 
| 57 |  |  |  |  |  |  | } | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | sub multiply { | 
| 61 | 42 | 100 |  | 42 | 1 | 123 | croak 'incorrect number of args' unless @_ == 2; | 
| 62 | 41 |  |  |  |  | 42 | my ($self, $multiplier) = @_; | 
| 63 |  |  |  |  |  |  |  | 
| 64 | 41 |  |  |  |  | 118 | Math::Shape::Vector->new( | 
| 65 |  |  |  |  |  |  | $self->{x} * $multiplier, | 
| 66 |  |  |  |  |  |  | $self->{y} * $multiplier, | 
| 67 |  |  |  |  |  |  | ); | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | sub divide { | 
| 72 | 93 | 100 |  | 93 | 1 | 179 | croak 'incorrect number of args' unless @_ == 2; | 
| 73 | 92 |  |  |  |  | 85 | my ($self, $divisor) = @_; | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | # avoid division by zero | 
| 76 | 92 | 100 |  |  |  | 283 | Math::Shape::Vector->new( | 
|  |  | 100 |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | ($divisor ? $self->{x} / $divisor : 0), | 
| 78 |  |  |  |  |  |  | ($divisor ? $self->{y} / $divisor : 0), | 
| 79 |  |  |  |  |  |  | ); | 
| 80 |  |  |  |  |  |  | } | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | sub rotate { | 
| 84 | 189 | 50 |  | 189 | 1 | 280 | croak 'incorrect number of args' unless @_ == 2; | 
| 85 | 189 |  |  |  |  | 167 | my ($self, $radians) = @_; | 
| 86 |  |  |  |  |  |  |  | 
| 87 | 189 |  |  |  |  | 880 | Math::Shape::Vector->new( | 
| 88 |  |  |  |  |  |  | $self->{x} * cos($radians) - $self->{y} * sin($radians), | 
| 89 |  |  |  |  |  |  | $self->{x} * sin($radians) + $self->{y} * cos($radians), | 
| 90 |  |  |  |  |  |  | ); | 
| 91 |  |  |  |  |  |  | } | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | sub rotate_90 | 
| 95 |  |  |  |  |  |  | { | 
| 96 | 70 |  |  | 70 | 1 | 75 | my $self = shift; | 
| 97 |  |  |  |  |  |  |  | 
| 98 | 70 |  |  |  |  | 146 | Math::Shape::Vector->new( | 
| 99 |  |  |  |  |  |  | - $self->{y}, | 
| 100 |  |  |  |  |  |  | $self->{x}, | 
| 101 |  |  |  |  |  |  | ); | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | sub dot_product { | 
| 106 | 367 | 50 |  | 367 | 1 | 750 | croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector'); | 
| 107 | 367 |  |  |  |  | 289 | my ($self, $v2) = @_; | 
| 108 | 367 |  |  |  |  | 1041 | $self->{x} * $v2->{x} + $self->{y} * $v2->{y}; | 
| 109 |  |  |  |  |  |  | } | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  |  | 
| 112 |  |  |  |  |  |  | sub length { | 
| 113 | 159 |  |  | 159 | 1 | 143 | my $self = shift; | 
| 114 |  |  |  |  |  |  | # avoid division by zero for null vectors | 
| 115 | 159 |  |  |  |  | 312 | my $sum_of_squares = $self->{x} ** 2 + $self->{y} ** 2; | 
| 116 |  |  |  |  |  |  |  | 
| 117 | 159 | 100 |  |  |  | 370 | return 0 unless $sum_of_squares; | 
| 118 | 134 |  |  |  |  | 436 | sqrt $sum_of_squares; | 
| 119 |  |  |  |  |  |  | } | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | sub convert_to_unit_vector { | 
| 123 | 91 |  |  | 91 | 1 | 82 | my $self = shift; | 
| 124 |  |  |  |  |  |  |  | 
| 125 | 91 |  |  |  |  | 126 | my $length = $self->length; | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | # if the vector length is zero (or lower?) return self | 
| 128 | 91 | 50 |  |  |  | 162 | return $self if $length < 0; | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | # else return unit vector | 
| 131 | 91 |  |  |  |  | 142 | $self->divide($length); | 
| 132 |  |  |  |  |  |  | } | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | sub project { | 
| 136 | 19 | 50 |  | 19 | 1 | 59 | croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector'); | 
| 137 | 19 |  |  |  |  | 22 | my ($self, $v2) = @_; | 
| 138 |  |  |  |  |  |  |  | 
| 139 | 19 |  |  |  |  | 33 | my $d = $v2->dot_product($v2); | 
| 140 |  |  |  |  |  |  |  | 
| 141 | 19 | 100 |  |  |  | 37 | if ($d > 0) { | 
| 142 | 16 |  |  |  |  | 21 | $v2->multiply( $self->dot_product($v2) / $d ); | 
| 143 |  |  |  |  |  |  | } | 
| 144 |  |  |  |  |  |  | else { | 
| 145 | 3 |  |  |  |  | 18 | $v2; | 
| 146 |  |  |  |  |  |  | } | 
| 147 |  |  |  |  |  |  | } | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  |  | 
| 150 |  |  |  |  |  |  | sub is_parallel | 
| 151 |  |  |  |  |  |  | { | 
| 152 | 25 | 50 |  | 25 | 1 | 70 | croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector'); | 
| 153 | 25 |  |  |  |  | 25 | my ($self, $v2) = @_; | 
| 154 | 25 |  |  |  |  | 40 | my $vector_na = $self->rotate_90; | 
| 155 | 25 |  |  |  |  | 38 | equal_floats(0, $vector_na->dot_product($v2)); | 
| 156 |  |  |  |  |  |  | } | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | sub enclosed_angle | 
| 160 |  |  |  |  |  |  | { | 
| 161 | 4 | 50 |  | 4 | 1 | 1157 | croak 'must pass a vector object' unless $_[1]->isa('Math::Shape::Vector'); | 
| 162 | 4 |  |  |  |  | 8 | my ($self, $v2) = @_; | 
| 163 |  |  |  |  |  |  |  | 
| 164 | 4 |  |  |  |  | 6 | my $ua = $self->convert_to_unit_vector; | 
| 165 | 4 |  |  |  |  | 7 | my $ub = $v2->convert_to_unit_vector; | 
| 166 |  |  |  |  |  |  |  | 
| 167 | 4 |  |  |  |  | 9 | acos( $ua->dot_product($ub) ); | 
| 168 |  |  |  |  |  |  | } | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | sub collides | 
| 173 |  |  |  |  |  |  | { | 
| 174 | 27 |  |  | 27 | 1 | 53 | my ($self, $other_obj) = @_; | 
| 175 |  |  |  |  |  |  |  | 
| 176 | 27 | 100 |  |  |  | 240 | if ($other_obj->isa('Math::Shape::Vector')) | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | { | 
| 178 | 9 | 100 | 100 |  |  | 81 | $self->{x} == $other_obj->{x} && $self->{y} == $other_obj->{y} ? 1 : 0; | 
| 179 |  |  |  |  |  |  | } | 
| 180 |  |  |  |  |  |  | elsif ($other_obj->isa('Math::Shape::LineSegment')) | 
| 181 |  |  |  |  |  |  | { | 
| 182 |  |  |  |  |  |  | # test collision of nearest point on LineSegment with vector | 
| 183 | 6 |  |  |  |  | 29 | my $d  = $other_obj->{end}->subtract_vector($other_obj->{start}); | 
| 184 | 6 |  |  |  |  | 14 | my $lp = $self->subtract_vector($other_obj->{start}); | 
| 185 | 6 |  |  |  |  | 16 | my $pr  = $lp->project($d); | 
| 186 |  |  |  |  |  |  |  | 
| 187 | 6 | 100 | 66 |  |  | 23 | $lp->is_equal($pr) | 
| 188 |  |  |  |  |  |  | && $pr->length <= $d->length | 
| 189 |  |  |  |  |  |  | && 0 <= $pr->dot_product($d) | 
| 190 |  |  |  |  |  |  | ? 1 : 0; | 
| 191 |  |  |  |  |  |  | } | 
| 192 |  |  |  |  |  |  | elsif ($other_obj->isa('Math::Shape::Line')) | 
| 193 |  |  |  |  |  |  | { | 
| 194 |  |  |  |  |  |  | # test if vector collides with base | 
| 195 | 4 | 100 |  |  |  | 23 | return 1 if $self->collides($other_obj->{base}); | 
| 196 |  |  |  |  |  |  |  | 
| 197 |  |  |  |  |  |  | # test if vector lies on the direction | 
| 198 | 2 |  |  |  |  | 5 | my $lp = $self->subtract_vector($other_obj->{base}); | 
| 199 | 2 |  |  |  |  | 5 | $lp->is_parallel($other_obj->{direction}); | 
| 200 |  |  |  |  |  |  | } | 
| 201 |  |  |  |  |  |  | elsif ($other_obj->isa('Math::Shape::OrientedRectangle')) | 
| 202 |  |  |  |  |  |  | { | 
| 203 | 4 |  |  |  |  | 15 | $other_obj->collides($self); | 
| 204 |  |  |  |  |  |  | } | 
| 205 |  |  |  |  |  |  | elsif ($other_obj->isa('Math::Shape::Circle')) | 
| 206 |  |  |  |  |  |  | { | 
| 207 | 2 |  |  |  |  | 6 | $other_obj->collides($self); | 
| 208 |  |  |  |  |  |  | } | 
| 209 |  |  |  |  |  |  | elsif ($other_obj->isa('Math::Shape::Rectangle')) | 
| 210 |  |  |  |  |  |  | { | 
| 211 | 2 |  |  |  |  | 7 | $other_obj->collides($self); | 
| 212 |  |  |  |  |  |  | } | 
| 213 |  |  |  |  |  |  | else | 
| 214 |  |  |  |  |  |  | { | 
| 215 | 0 |  |  |  |  | 0 | croak 'collides must be called with a Math::Shape::Vector library object'; | 
| 216 |  |  |  |  |  |  | } | 
| 217 |  |  |  |  |  |  | } | 
| 218 |  |  |  |  |  |  |  | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | sub distance | 
| 221 |  |  |  |  |  |  | { | 
| 222 | 4 |  |  | 4 | 1 | 10 | my ($self, $other_obj) = @_; | 
| 223 |  |  |  |  |  |  |  | 
| 224 | 4 | 100 |  |  |  | 20 | if ($other_obj->isa('Math::Shape::Vector')) | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | { | 
| 226 | 3 |  |  |  |  | 4 | $self->subtract_vector($other_obj)->length; | 
| 227 |  |  |  |  |  |  | } | 
| 228 |  |  |  |  |  |  | elsif ($other_obj->isa('Math::Shape::Circle')) | 
| 229 |  |  |  |  |  |  | { | 
| 230 | 1 |  |  |  |  | 6 | $self->subtract_vector($other_obj->{center})->length | 
| 231 |  |  |  |  |  |  | - $other_obj->{radius}; | 
| 232 |  |  |  |  |  |  | } | 
| 233 |  |  |  |  |  |  | elsif ($other_obj->isa('Math::Shape::OrientedRectangle')) | 
| 234 |  |  |  |  |  |  | { | 
| 235 | 0 |  |  |  |  |  | my $circle_hull = $other_obj->circle_hull; | 
| 236 | 0 |  |  |  |  |  | $self->subtract_vector($circle_hull->{center})->length | 
| 237 |  |  |  |  |  |  | - $circle_hull->{radius}; | 
| 238 |  |  |  |  |  |  | } | 
| 239 |  |  |  |  |  |  | else | 
| 240 |  |  |  |  |  |  | { | 
| 241 | 0 |  |  |  |  |  | croak 'distance() must be called with a Math::Shape::Vector library object'; | 
| 242 |  |  |  |  |  |  | } | 
| 243 |  |  |  |  |  |  | } | 
| 244 |  |  |  |  |  |  |  | 
| 245 |  |  |  |  |  |  |  | 
| 246 |  |  |  |  |  |  | 1; | 
| 247 |  |  |  |  |  |  |  | 
| 248 |  |  |  |  |  |  | __END__ |