File Coverage

lib/Graphics/Fig/Arc.pm
Criterion Covered Total %
statement 461 531 86.8
branch 97 166 58.4
condition 18 36 50.0
subroutine 24 24 100.0
pod 0 14 0.0
total 600 771 77.8


line stmt bran cond sub pod time code
1             #
2             # XFig Drawing Library
3             #
4             # Copyright (c) 2017 D Scott Guthridge
5             #
6             # This program is free software: you can redistribute it and/or modify it under
7             # the terms of the Artistic License as published by the Perl Foundation, either
8             # version 2.0 of the License, or (at your option) any later version.
9             #
10             # This program is distributed in the hope that it will be useful, but WITHOUT
11             # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12             # FOR A PARTICULAR PURPOSE. See the Artistic License for more details.
13             #
14             # You should have received a copy of the Artistic License along with this
15             # program. If not, see .
16             #
17             package Graphics::Fig::Arc;
18             our $VERSION = 'v1.0.8';
19              
20 12     12   71 use strict;
  12         17  
  12         333  
21 12     12   49 use warnings;
  12         15  
  12         307  
22 12     12   547 use utf8;
  12         27  
  12         77  
23 12     12   204 use Carp;
  12         15  
  12         679  
24 12     12   53 use Math::Trig;
  12         23  
  12         1741  
25 12     12   68 use Graphics::Fig::Color;
  12         15  
  12         227  
26 12     12   4453 use Graphics::Fig::Ellipse;
  12         25  
  12         414  
27 12     12   89 use Graphics::Fig::Matrix;
  12         23  
  12         180  
28 12     12   47 use Graphics::Fig::Parameters;
  12         19  
  12         147  
29 12     12   51 use Graphics::Fig::Arc;
  12         17  
  12         47729  
30              
31             #
32             # RE_INT: regular expression matching an integer
33             #
34             my $RE_INT = '(?:(?:[-+]?)(?:[0123456789]+))';
35              
36             #
37             # Graphics::Fig::Arc::convertSubtype
38             # $fig: Fig instance
39             # $prefix: error message prefix
40             # $value: direction parameter
41             # $context: parameter context
42             #
43             sub convertSubtype {
44 3     3 0 6 my $fig = shift;
45 3         5 my $prefix = shift;
46 3         3 my $value = shift;
47 3         3 my $context = shift;
48 3         5 my $result;
49             my $temp;
50              
51 3         5 $value =~ y/[A-Z]/[a-z]/;
52 3 50       7 if ($value eq "open") {
53 0         0 return 1;
54             }
55 3 50 66     23 if ($value eq "pie" || $value eq "pie-wedge" || $value eq "closed") {
      66        
56 3         7 return 2;
57             }
58 0 0       0 if (!($value =~ s/^\s*($RE_INT)//)) {
59 0         0 croak("${prefix}: ${value}: error: expected open or pie");
60             }
61 0 0 0     0 if ($value != 1 && $value != 2) {
62 0         0 croak("${prefix}: ${value}: error: expected 1 or 2");
63             }
64 0         0 return $value;
65             }
66              
67             #
68             # Graphics::Fig::Arc::convertDirection
69             # $fig: Fig instance
70             # $prefix: error message prefix
71             # $value: direction parameter
72             # $context: parameter context
73             #
74             sub convertDirection {
75 5     5 0 12 my $fig = shift;
76 5         6 my $prefix = shift;
77 5         6 my $value = shift;
78 5         7 my $context = shift;
79 5         7 my $result;
80             my $temp;
81              
82 5         9 $value =~ y/[A-Z]/[a-z]/;
83 5 100 66     24 if ($value eq "clockwise" || $value eq "cw") {
84 2         5 return 0;
85             }
86 3 50 33     13 if ($value eq "counterclockwise" || $value eq "ccw") {
87 3         6 return 1;
88             }
89 0 0       0 if (!($value =~ s/^\s*($RE_INT)//)) {
90 0         0 croak("${prefix}: ${value}: error: expected clockwise or " .
91             "counterclockwise");
92             }
93 0 0 0     0 if ($value != 0 && $value != 1) {
94 0         0 croak("${prefix}: ${value}: error: expected 0 or 1");
95             }
96 0         0 return $value;
97             }
98              
99             #
100             # Arc Parameters
101             #
102             my %ArcParameterTemplate = (
103             positional => {
104             "." => [ "r" ],
105             ".." => [ "r", "angle" ],
106             "@" => [ "points" ],
107             },
108             named => [
109             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
110             \%Graphics::Fig::Parameters::PositionParameter, # must be second
111             @Graphics::Fig::Parameters::ArrowParameters,
112             \%Graphics::Fig::Parameters::CapStyleParameter,
113             \%Graphics::Fig::Parameters::CenterParameter,
114             \%Graphics::Fig::Parameters::ColorParameter,
115             \%Graphics::Fig::Parameters::DepthParameter,
116             @Graphics::Fig::Parameters::FillParameters,
117             @Graphics::Fig::Parameters::LineParameters,
118             \%Graphics::Fig::Parameters::PointsParameter,
119             \%Graphics::Fig::Parameters::RotationParameter,
120             {
121             name => "subtype",
122             convert => \&convertSubtype,
123             default => 1
124             },
125             {
126             name => "d",
127             aliases => [ "diameter" ],
128             convert => \&Graphics::Fig::Parameters::convertLength,
129             },
130             {
131             name => "r",
132             aliases => [ "radius" ],
133             convert => \&Graphics::Fig::Parameters::convertLength,
134             },
135             {
136             name => "direction",
137             convert => \&convertDirection,
138             },
139             {
140             name => "controlAngle",
141             convert => \&Graphics::Fig::Parameters::convertAngle,
142             },
143             {
144             name => "angle",
145             aliases => [ "Θ" ],
146             convert => \&Graphics::Fig::Parameters::convertAngle,
147             },
148             ],
149             );
150              
151             #
152             # Arcto Parameters
153             #
154             my %ArctoParameterTemplate = (
155             positional => {
156             ".." => [ "distance", "heading" ],
157             "..." => [ "distance", "heading", "angle" ],
158             "@" => [ "points" ],
159             },
160             named => [
161             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
162             \%Graphics::Fig::Parameters::PositionParameter, # must be second
163             @Graphics::Fig::Parameters::ArrowParameters,
164             \%Graphics::Fig::Parameters::CapStyleParameter,
165             \%Graphics::Fig::Parameters::CenterParameter,
166             \%Graphics::Fig::Parameters::ColorParameter,
167             \%Graphics::Fig::Parameters::DepthParameter,
168             @Graphics::Fig::Parameters::FillParameters,
169             @Graphics::Fig::Parameters::LineParameters,
170             \%Graphics::Fig::Parameters::PointsParameter,
171             {
172             name => "distance",
173             convert => \&Graphics::Fig::Parameters::convertLength,
174             },
175             {
176             name => "heading",
177             convert => \&Graphics::Fig::Parameters::convertAngle,
178             },
179             {
180             name => "subtype",
181             convert => \&convertSubtype,
182             default => 1
183             },
184             {
185             name => "direction",
186             convert => \&convertDirection,
187             },
188             {
189             name => "controlAngle",
190             convert => \&Graphics::Fig::Parameters::convertAngle,
191             },
192             {
193             name => "angle",
194             aliases => [ "Θ", ],
195             convert => \&Graphics::Fig::Parameters::convertAngle,
196             },
197             ],
198             );
199              
200             #
201             # Graphics::Fig::Arg::normalizeAngle: normalize angle to [-2 pi .. 2 pi ]
202             # with sign consistent with direction
203             # $angle: angle
204             # $direction: 1:CCW 0:CW
205             #
206             sub normalizeAngle {
207 24     24 0 26 my $angle = shift;
208 24         30 my $direction = shift;
209              
210 24 100       48 if (abs($angle) > pi) {
211 2         20 $angle = atan2(sin($angle), cos($angle));
212             }
213 24 50 33     77 die "arc: internal error 1" unless ($angle >= - pi && $angle <= pi);
214 24 100 100     95 if ($direction && $angle < 0) {
    100 100        
215 1         2 $angle += 2 * pi;
216             } elsif (!$direction && $angle > 0) {
217 3         6 $angle -= 2 * pi;
218             }
219 24         35 return $angle;
220             }
221              
222             #
223             # Graphics::Fig::Arc::calcAngleParameters: find angles from parameters
224             # $parameters: reference to parameter hash
225             #
226             # The returned angle is in the range [-2 pi .. 2 pi] given the width
227             # of the arc, where positive values indicate a counterclockwise arc and
228             # negative values indicate a clockwise arc. The returned controlAngle
229             # is lower in magnitude and follows the sign of angle.
230             #
231             # Return:
232             # ( angle, controlAngle )
233             #
234             sub calcAngleParameters {
235 20     20 0 27 my $parameters = shift;
236 20         21 my $angle = ${$parameters}{"angle"};
  20         26  
237 20         26 my $controlAngle = ${$parameters}{"controlAngle"};
  20         31  
238 20         27 my $direction = ${$parameters}{"direction"};
  20         25  
239              
240             #
241             # If the direction wasn't given, take it from the sign of angle.
242             # If angle wasn't given, take it from the sign of controlAngle.
243             # If controlAngle wasn't given, default to counterclockwise.
244             #
245 20 100       41 if (!defined($direction)) {
246 15 100       30 if (defined($angle)) {
    100          
247 8         14 $direction = $angle >= 0;
248             } elsif (defined($controlAngle)) {
249 2         5 $direction = $controlAngle >= 0;
250             } else {
251 5         5 $direction = 1;
252             }
253             }
254              
255             #
256             # Normalize angle. If not given, default it to pi/2 or -pi/2
257             # depending on direction.
258             #
259 20 100       31 if (defined($angle)) {
260 9         23 $angle = &normalizeAngle($angle, $direction);
261              
262             } else {
263 11 100       17 if ($direction) {
264 9         9 $angle = pi / 2;
265             } else {
266 2         4 $angle = - pi / 2;
267             }
268             }
269              
270             #
271             # Normalize controlAngle and test that it's within the arc. If not
272             # given, default it to $angle / 2.
273             #
274 20 100       35 if (defined($controlAngle)) {
275 3         8 $controlAngle = &normalizeAngle($controlAngle, $direction);
276 3 50       12 if (abs($controlAngle) >= abs($angle)) {
277 0         0 croak("arc: error: controlAngle is outside of arc");
278             }
279             } else {
280 17         31 $controlAngle = $angle / 2;
281             }
282              
283 20 50       44 die "arc: internal error 2" if $angle * $controlAngle < 0;
284 20 50       42 die "arc: internal error 3" if abs($controlAngle) > abs($angle);
285 20 50       37 die "arc: internal error 4" if $controlAngle * $angle < 0;
286              
287 20         45 return ( $angle, $controlAngle );
288             }
289              
290             #
291             # Graphics::Fig::Arc::calcAnglesFromPoints: find angles from three points
292             # $points: [ [ x1, y1 ], [ x2, y2 ], [ x3, y3 ] ]
293             #
294             # The returned angle is in the range [-2 pi .. 2 pi] given the width
295             # of the arc, where positive values indicate a counterclockwise arc and
296             # negative values indicate a clockwise arc. The returned controlAngle
297             # is lower in magnitude and follows the sign of angle.
298             #
299             # Return:
300             # ( angle, controlAngle )
301             #
302             sub calcAnglesFromPoints {
303 6     6 0 8 my $points = shift;
304              
305             #
306             # Let A = 1. Solve for D, E and F:
307             # D x1 + E y1 + F == -(x1^2 + y1^2)
308             # D x2 + E y2 + F == -(x2^2 + y2^2)
309             # D x3 + E y3 + F == -(x3^2 + y3^2)
310             #
311 6         9 my $x1 = ${$points}[0][0];
  6         9  
312 6         7 my $y1 = ${$points}[0][1];
  6         7  
313 6         7 my $x2 = ${$points}[1][0];
  6         8  
314 6         4 my $y2 = ${$points}[1][1];
  6         8  
315 6         6 my $x3 = ${$points}[2][0];
  6         10  
316 6         6 my $y3 = ${$points}[2][1];
  6         8  
317 6         34 my @M = (
318             [ $x1, $y1, 1, -($x1*$x1 + $y1*$y1) ],
319             [ $x2, $y2, 1, -($x2*$x2 + $y2*$y2) ],
320             [ $x3, $y3, 1, -($x3*$x3 + $y3*$y3) ],
321             );
322 6         40 my $d = Graphics::Fig::Matrix::reduce(\@M);
323 6 50       15 if (abs($d) < Graphics::Fig::Matrix::EPS) {
324 0         0 croak("arc: error: singular matrix");
325             }
326 6         9 my $D = $M[0][3];
327 6         7 my $E = $M[1][3];
328 6         8 my $F = $M[2][3];
329              
330             #
331             # Find the arc direction by finding the sign of the the z component
332             # of the cross product of point2-point1 and point3-point1.
333             #
334 6         13 my $z = $x1 * ($y2 - $y3) + $x2 * ($y3 - $y1) + $x3 * ($y1 - $y2);
335 6         9 my $direction = ($z < 0);
336              
337             #
338             # Find center and radius and compute angles.
339             #
340 6         7 my ($x, $y);
341 6         18 my ($r, $b, $xc, $yc, $dummy_rotation) =
342             Graphics::Fig::Ellipse::generalToCanonical(1, 0, 1, $D, $E, $F);
343 6 50       15 die "arc: internal error 6: $r != $b" unless $r == $b;
344 6         19 my $c = ($x1 - $xc) / $r;
345 6         9 my $s = -($y1 - $yc) / $r;
346 6         11 $x = $c * ($x2 - $xc) - $s * ($y2 - $yc);
347 6         8 $y = $s * ($x2 - $xc) + $c * ($y2 - $yc);
348 6         28 my $controlAngle = &normalizeAngle(atan2(-$y, $x), $direction);
349 6         33 $x = $c * ($x3 - $xc) - $s * ($y3 - $yc);
350 6         11 $y = $s * ($x3 - $xc) + $c * ($y3 - $yc);
351 6         14 my $angle = &normalizeAngle(atan2(-$y, $x), $direction);;
352              
353 6 50       12 die "arc: internal error 7" if abs($controlAngle) > abs($angle);
354 6 50       14 die "arc: internal error 8" if $controlAngle * $angle < 0;
355              
356 6         18 return ( $angle, $controlAngle );
357             }
358              
359             #
360             # Graphics::Fig::Arc::findPoint2: return the center and point2
361             # $self: object
362             #
363             # Return: ([ xc, yc ], [ x2, y2 ])
364             #
365             sub findPoint2 {
366 26     26 0 36 my $self = shift;
367              
368             #
369             # Get points and angles.
370             #
371 26         23 my $point1 = ${$self}{"point1"};
  26         36  
372 26         27 my $point3 = ${$self}{"point3"};
  26         27  
373 26         27 my $angle = ${$self}{"angle"};
  26         36  
374 26         24 my $controlAngle = ${$self}{"controlAngle"};
  26         29  
375 26         26 my $x1 = ${$point1}[0];
  26         33  
376 26         28 my $y1 = ${$point1}[1];
  26         29  
377 26         32 my $x3 = ${$point3}[0];
  26         30  
378 26         28 my $y3 = ${$point3}[1];
  26         24  
379              
380             #
381             # Find the center.
382             #
383 26         91 my $half_cot = cot($angle / 2) / 2;
384 26         538 my $xc = $x1 + ($x3 - $x1) / 2 + ($y3 - $y1) * $half_cot;
385 26         51 my $yc = $y1 + ($y3 - $y1) / 2 - ($x3 - $x1) * $half_cot;
386              
387             #
388             # Find point 2.
389             #
390 26         28 my $c = cos($controlAngle);
391 26         31 my $s = sin($controlAngle);
392 26         31 my $x = $x1 - $xc;
393 26         33 my $y = $y1 - $yc;
394 26         36 my $x2 = $xc + $c * $x + $s * $y;
395 26         33 my $y2 = $yc + -$s * $x + $c * $y;
396              
397 26         74 return ([ $xc, $yc ], [ $x2, $y2 ]);
398             }
399              
400             #
401             # Graphics::Fig::Arc::arc constructor
402             # $proto: prototype
403             # $fig: parent object
404             # @parameters: arc parameters
405             #
406             sub arc {
407 11     11 0 21 my $proto = shift;
408 11         18 my $fig = shift;
409              
410             #
411             # Parse parameters.
412             #
413 11         17 my %parameters;
414 11         14 my $stack = ${$fig}{"stack"};
  11         20  
415 11         14 my $tos = ${$stack}[$#{$stack}];
  11         21  
  11         15  
416 11         16 eval {
417             Graphics::Fig::Parameters::parse($fig, "arc",
418             \%ArcParameterTemplate,
419 11         21 ${$tos}{"options"}, \%parameters, @_);
  11         31  
420             };
421 11 50       46 if ($@) {
422 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
423 0         0 croak("$@");
424             }
425              
426             #
427             # Construct the object. Undefined parameters are set below.
428             #
429             my $self = {
430             subtype => $parameters{"subtype"},
431             lineStyle => $parameters{"lineStyle"},
432             lineThickness => $parameters{"lineThickness"},
433             penColor => $parameters{"penColor"},
434             fillColor => $parameters{"fillColor"},
435             depth => $parameters{"depth"},
436             areaFill => $parameters{"areaFill"},
437             styleVal => $parameters{"styleVal"},
438 11         120 capStyle => $parameters{"capStyle"},
439             point1 => undef,
440             point3 => undef,
441             angle => undef,
442             controlAngle => undef,
443             };
444 11         45 Graphics::Fig::Parameters::copyArrowParameters($self, \%parameters);
445              
446             #
447             # If "r" or "d" given, set $r to radius.
448             #
449 11         12 my $r;
450 11 100       36 if (defined($parameters{"r"})) {
    100          
451 4 50       13 if (defined($parameters{"d"})) {
452 0         0 croak("arc: error: r and d cannot be given together");
453             }
454 4         4 $r = $parameters{"r"};
455              
456             } elsif (defined($parameters{"d"})) {
457 3         6 $r = $parameters{"d"} / 2.0;
458             }
459              
460 11         19 my $points = $parameters{"points"};
461 11 100       26 if (!defined($points)) {
    100          
    100          
    50          
462 7 50       13 if (!defined($r)) {
463 0         0 croak("arc: error: r, d or points parameter required");
464             }
465 7         22 my ($angle, $controlAngle) = &calcAngleParameters(\%parameters);
466 7         10 my ($xc, $yc);
467 7 50       14 if (defined($parameters{"center"})) {
468 0         0 ($xc, $yc) = @{$parameters{"center"}};
  0         0  
469             } else {
470 7         6 ($xc, $yc) = @{$parameters{"position"}};
  7         15  
471             }
472 7         15 my $rotation;
473 7 100       22 if (!defined($rotation = $parameters{"rotation"})) {
474 3         4 $rotation = 0;
475             }
476 7         56 ${$self}{"point1"} = [ $xc + $r * cos($rotation),
  7         13  
477             $yc + $r * -sin($rotation) ];
478 7         56 ${$self}{"point3"} = [ $xc + $r * cos($rotation + $angle),
  7         13  
479             $yc + $r * -sin($rotation + $angle) ];
480 7         8 ${$self}{"angle"} = $angle;
  7         9  
481 7         9 ${$self}{"controlAngle"} = $controlAngle;
  7         14  
482              
483 4         13 } elsif (scalar(@{$points}) == 1) {
484 1         2 my ($xc, $yc, $x3, $y3);
485              
486 1 50       3 if (defined($parameters{"d"})) {
487 0         0 croak("arc: error: d cannot be given with two points");
488             }
489 1 50       4 if (defined($parameters{"r"})) {
490 0         0 croak("arc: error: r cannot be given with two points");
491             }
492 1 50       3 if (defined($parameters{"rotation"})) {
493 0         0 croak("arc: error: radius required with point and rotation");
494             }
495 1 50       2 if (defined($parameters{"center"})) {
496 1         1 ($xc, $yc) = @{$parameters{"center"}};
  1         4  
497             } else {
498 0         0 ($xc, $yc) = @{$parameters{"position"}};
  0         0  
499             }
500 1         4 my ($angle, $controlAngle) = &calcAngleParameters(\%parameters);
501 1         2 my $x = ${$points}[0][0] - $xc;
  1         3  
502 1         1 my $y = ${$points}[0][1] - $yc;
  1         2  
503 1         5 my $c = cos($angle);
504 1         21 my $s = sin($angle);
505 1         6 $x3 = $xc + $c * $x + $s * $y;
506 1         3 $y3 = $yc - $s * $x + $c * $y;
507 1         1 ${$self}{"point1"} = ${$points}[0];
  1         2  
  1         6  
508 1         2 ${$self}{"point3"} = [ $x3, $y3 ];
  1         2  
509 1         2 ${$self}{"angle"} = $angle;
  1         1  
510 1         3 ${$self}{"controlAngle"} = $controlAngle;
  1         2  
511              
512 3         10 } elsif (scalar(@{$points}) == 2) {
513 1 50       4 if (defined($parameters{"d"})) {
514 0         0 croak("arc: error: d cannot be given with two points");
515             }
516 1 50       4 if (defined($parameters{"r"})) {
517 0         0 croak("arc: error: r cannot be given with two points");
518             }
519 1 50       4 if (defined($parameters{"center"})) {
520 0         0 croak("arc: error: center cannot be given with two points");
521             }
522 1 50       3 if (defined($parameters{"rotation"})) {
523 0         0 croak("arc: error: rotation cannot be given with two points");
524             }
525 1         4 my ($angle, $controlAngle) = &calcAngleParameters(\%parameters);
526 1         2 ${$self}{"point1"} = ${$points}[0];
  1         3  
  1         1  
527 1         1 ${$self}{"point3"} = ${$points}[1];
  1         2  
  1         3  
528 1         3 ${$self}{"angle"} = $angle;
  1         2  
529 1         2 ${$self}{"controlAngle"} = $controlAngle;
  1         2  
530              
531 2         7 } elsif (scalar(@{$points}) == 3) {
532 2 50       6 if (defined($parameters{"d"})) {
533 0         0 croak("arc: error: d cannot be given with three points");
534             }
535 2 50       5 if (defined($parameters{"r"})) {
536 0         0 croak("arc: error: r cannot be given with three points");
537             }
538 2 50       6 if (defined($parameters{"direction"})) {
539 0         0 croak("arc: error: direction cannot be given with three points");
540             }
541 2 50       6 if (defined($parameters{"controlAngle"})) {
542 0         0 croak("arc: error: controlAngle cannot be given with three points");
543             }
544 2 50       3 if (defined($parameters{"angle"})) {
545 0         0 croak("arc: error: angle cannot be given with three points");
546             }
547 2         8 my ( $angle, $controlAngle ) = &calcAnglesFromPoints($points);
548 2         3 ${$self}{"point1"} = ${$points}[0];
  2         4  
  2         3  
549 2         2 ${$self}{"point3"} = ${$points}[2];
  2         4  
  2         4  
550 2         2 ${$self}{"angle"} = $angle;
  2         3  
551 2         2 ${$self}{"controlAngle"} = $controlAngle;
  2         3  
552              
553             } else {
554 0         0 croak("arc: error: expected between zero and three points");
555             }
556 11   33     40 my $class = ref($proto) || $proto;
557 11         23 bless($self, $class);
558 11         12 push(@{${$tos}{"objects"}}, $self);
  11         19  
  11         28  
559 11         59 return $self;
560             }
561              
562             #
563             # Graphics::Fig::Arc::arcto constructor
564             # $proto: prototype
565             # $fig: parent object
566             # @parameters: arc parameters
567             #
568             sub arcto {
569 14     14 0 20 my $proto = shift;
570 14         11 my $fig = shift;
571              
572             #
573             # Parse parameters.
574             #
575 14         10 my %parameters;
576 14         14 my $stack = ${$fig}{"stack"};
  14         16  
577 14         13 my $tos = ${$stack}[$#{$stack}];
  14         14  
  14         15  
578 14         15 eval {
579             Graphics::Fig::Parameters::parse($fig, "arcto",
580             \%ArctoParameterTemplate,
581 14         16 ${$tos}{"options"}, \%parameters, @_);
  14         29  
582             };
583 14 50       26 if ($@) {
584 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
585 0         0 croak("$@");
586             }
587              
588             #
589             # Construct the object. Undefined parameters are set below.
590             #
591             my $self = {
592             subtype => $parameters{"subtype"},
593             lineStyle => $parameters{"lineStyle"},
594             lineThickness => $parameters{"lineThickness"},
595             penColor => $parameters{"penColor"},
596             fillColor => $parameters{"fillColor"},
597             depth => $parameters{"depth"},
598             areaFill => $parameters{"areaFill"},
599             styleVal => $parameters{"styleVal"},
600 14         90 capStyle => $parameters{"capStyle"},
601             point1 => undef,
602             point3 => undef,
603             angle => undef,
604             controlAngle => undef,
605             };
606 14         31 Graphics::Fig::Parameters::copyArrowParameters($self, \%parameters);
607              
608 14         16 my $points = $parameters{"points"};
609 14 100       20 if (!defined($points)) {
    100          
    50          
610 8         11 my ($x3, $y3, $angle, $controlAngle);
611 8 100 66     23 if (defined($parameters{"distance"}) ||
612             defined($parameters{"heading"})) {
613 6 50       10 if (defined($parameters{"center"})) {
614 0         0 croak("arcto: error: center cannot be given with distance " .
615             "and heading");
616             }
617 6 50       9 if (!defined($parameters{"distance"})) {
618 0         0 croak("arcto: error: distance must be given with heading");
619             }
620 6 50       9 if (!defined($parameters{"heading"})) {
621 0         0 croak("arcto: error: heading must be given with distance");
622             }
623 6         10 ($angle, $controlAngle) = &calcAngleParameters(\%parameters);
624             $x3 = $parameters{"position"}[0]
625 6         28 + $parameters{"distance"} * cos($parameters{"heading"});
626             $y3 = $parameters{"position"}[1]
627 6         13 - $parameters{"distance"} * sin($parameters{"heading"});
628              
629             } else {
630 2 50       5 if (!defined($parameters{"center"})) {
631 0         0 croak("arcto: error: expected distance and heading, center " .
632             "or points");
633             }
634 2 50       3 if (defined($parameters{"distance"})) {
635 0         0 croak("arcto: error: distance cannot be given with center");
636             }
637 2 50       4 if (defined($parameters{"heading"})) {
638 0         0 croak("arcto: error: heading cannot be given with center");
639             }
640 2         2 my ($xc, $yc) = @{$parameters{"center"}};
  2         4  
641 2         4 ($angle, $controlAngle) = &calcAngleParameters(\%parameters);
642 2         3 my $x = $parameters{"position"}[0] - $xc;
643 2         3 my $y = $parameters{"position"}[1] - $yc;
644 2         5 my $c = cos($angle);
645 2         3 my $s = sin($angle);
646 2         4 $x3 = $xc + $c * $x + $s * $y;
647 2         3 $y3 = $yc - $s * $x + $c * $y;
648             }
649 8         10 ${$self}{"point1"} = $parameters{"position"};
  8         9  
650 8         10 ${$self}{"point3"} = [ $x3, $y3 ];
  8         8  
651 8         9 ${$self}{"angle"} = $angle;
  8         8  
652 8         8 ${$self}{"controlAngle"} = $controlAngle;
  8         8  
653              
654 6         12 } elsif (scalar(@{$points} == 1)) {
655 3 50       6 if (defined($parameters{"center"})) {
656 0         0 croak("arcto: error: center cannot be given with points");
657             }
658 3 50       5 if (defined($parameters{"distance"})) {
659 0         0 croak("arcto: error: distance cannot be given with points");
660             }
661 3 50       5 if (defined($parameters{"heading"})) {
662 0         0 croak("arcto: error: heading cannot be given with points");
663             }
664 3         5 my ($angle, $controlAngle) = &calcAngleParameters(\%parameters);
665 3         3 ${$self}{"point1"} = $parameters{"position"};
  3         5  
666 3         4 ${$self}{"point3"} = $parameters{"points"}[0];
  3         3  
667 3         4 ${$self}{"angle"} = $angle;
  3         3  
668 3         3 ${$self}{"controlAngle"} = $controlAngle;
  3         4  
669              
670 3         5 } elsif (scalar(@{$points} == 2)) {
671 3 50       7 if (defined($parameters{"angle"})) {
672 0         0 croak("arcto: error: angle cannot be given with two points");
673             }
674 3 50       5 if (defined($parameters{"center"})) {
675 0         0 croak("arcto: error: center cannot be given with points");
676             }
677 3 50       4 if (defined($parameters{"controlAngle"})) {
678 0         0 croak("arcto: error: controlAngle cannot be given with two points");
679             }
680 3 50       5 if (defined($parameters{"direction"})) {
681 0         0 croak("arcto: error: direction cannot be given with two points");
682             }
683 3 50       5 if (defined($parameters{"distance"})) {
684 0         0 croak("arcto: error: distance cannot be given with points");
685             }
686 3 50       4 if (defined($parameters{"heading"})) {
687 0         0 croak("arcto: error: heading cannot be given with points");
688             }
689             my ( $angle, $controlAngle ) = &calcAnglesFromPoints([
690 3         4 $parameters{"position"}, ${$points}[0], ${$points}[1] ]);
  3         3  
  3         7  
691 3         6 ${$self}{"point1"} = $parameters{"position"};
  3         4  
692 3         4 ${$self}{"point3"} = ${$points}[1];
  3         4  
  3         4  
693 3         4 ${$self}{"angle"} = $angle;
  3         3  
694 3         4 ${$self}{"controlAngle"} = $controlAngle;
  3         3  
695              
696             } else {
697 0         0 croak("arcto: error: expected point");
698             }
699 14         14 ${$tos}{"options"}{"position"} = ${$self}{"point3"};
  14         18  
  14         14  
700              
701 14   33     35 my $class = ref($proto) || $proto;
702 14         18 bless($self, $class);
703 14         12 push(@{${$tos}{"objects"}}, $self);
  14         11  
  14         23  
704 14         52 return $self;
705             }
706              
707             #
708             # Graphics::Fig::Arc::translate
709             # $self: object
710             # $parameters: reference to parameter hash
711             #
712             sub translate {
713 1     1 0 3 my $self = shift;
714 1         1 my $parameters = shift;
715              
716 1         3 ( ${$self}{"point1"}, ${$self}{"point3"} ) =
  1         2  
717             Graphics::Fig::Parameters::translatePoints(
718 1         3 $parameters, ${$self}{"point1"}, ${$self}{"point3"} );
  1         2  
  1         4  
719              
720 1         3 return 1;
721             }
722              
723             #
724             # Graphics::Fig::Arc::rotate
725             # $self: object
726             # $parameters: reference to parameter hash
727             #
728             sub rotate {
729 1     1 0 3 my $self = shift;
730 1         1 my $parameters = shift;
731 1         2 my $rotation = ${$parameters}{"rotation"};
  1         2  
732              
733 1         2 ( ${$self}{"point1"}, ${$self}{"point3"} ) =
  1         3  
734             Graphics::Fig::Parameters::rotatePoints(
735 1         2 $parameters, ${$self}{"point1"}, ${$self}{"point3"} );
  1         2  
  1         3  
736              
737 1         2 return 1;
738             }
739              
740             #
741             # Graphics::Fig::Arc::scale
742             # $self: object
743             # $parameters: reference to parameter hash
744             #
745             sub scale {
746 1     1 0 2 my $self = shift;
747 1         1 my $parameters = shift;
748 1         2 my $scale = ${$parameters}{"scale"};
  1         2  
749 1 50       3 die unless defined($scale);
750 1         1 my $u = ${$scale}[0];
  1         3  
751 1         1 my $v = ${$scale}[1];
  1         2  
752              
753             #
754             # Simple case: scale proportionally.
755             #
756 1 50       4 if (abs($u) == abs($v)) {
757 0         0 ( ${$self}{"point1"}, ${$self}{"point3"} ) =
  0         0  
758             Graphics::Fig::Parameters::scalePoints(
759 0         0 $parameters, ${$self}{"point1"}, ${$self}{"point3"} );
  0         0  
  0         0  
760              
761             #
762             # If mirrored, invert the direction.
763             #
764 0 0       0 if ($u * $v < 0) {
765 0         0 ${$self}{"angle"} *= -1;
  0         0  
766 0         0 ${$self}{"controlAngle"} *= -1;
  0         0  
767             }
768              
769             #
770             # General case: find a new arc that passes through the three scaled
771             # points.
772             #
773             } else {
774 1         1 my $point1 = ${$self}{"point1"};
  1         2  
775 1         2 my $point3 = ${$self}{"point3"};
  1         2  
776 1         19 my ( $old_center, $point2 ) = &findPoint2($self);
777 1         4 my @newPoints = Graphics::Fig::Parameters::scalePoints($parameters,
778             $point1, $point2, $point3 );
779 1         3 my ( $angle, $controlAngle ) = &calcAnglesFromPoints(\@newPoints);
780              
781 1         2 ${$self}{"point1"} = $newPoints[0];
  1         2  
782 1         2 ${$self}{"point3"} = $newPoints[2];
  1         2  
783 1         1 ${$self}{"angle"} = $angle;
  1         2  
784 1         3 ${$self}{"controlAngle"} = $controlAngle;
  1         4  
785             }
786             }
787              
788             #
789             # Graphics::Fig::Arc::crosses_axis: return positive if a CCW arc
790             # intersects the given axis (helper for getbbox)
791             # $point1: first point
792             # $point3: final point
793             # $axis: axis
794             #
795             sub crosses_axis {
796 4     4 0 8 my $point1 = shift;
797 4         4 my $point3 = shift;
798 4         3 my $axis = shift;
799 4         4 my $x1 = ${$point1}[0];
  4         5  
800 4         5 my $y1 = ${$point1}[1];
  4         4  
801 4         4 my $x3 = ${$point3}[0];
  4         4  
802 4         3 my $y3 = ${$point3}[1];
  4         4  
803 4         5 my $x = ${$axis}[0];
  4         3  
804 4         2 my $y = ${$axis}[1];
  4         5  
805              
806             # Find z component of cross product of (point1 - axis) and (point2 - axis).
807 4         17 return $x1 * $y3 - $x3 * $y1 + ($y1 - $y3) * $x + ($x3 - $x1) * $y;
808             }
809              
810             #
811             # Graphics::Fig::Arc::getbbox: return [[xmin, ymin], [xmax, ymax]]
812             # $self: object
813             # $parameters: getbbox parameters
814             #
815             sub getbbox {
816 1     1 0 2 my $self = shift;
817 1         2 my $parameters = shift;
818              
819 1         1 my $point1 = ${$self}{"point1"};
  1         2  
820 1         2 my $point3 = ${$self}{"point3"};
  1         1  
821 1         2 my $angle = ${$self}{"angle"};
  1         1  
822 1         1 my $x1 = ${$point1}[0];
  1         2  
823 1         2 my $y1 = ${$point1}[1];
  1         1  
824 1         2 my $x3 = ${$point3}[0];
  1         2  
825 1         1 my $y3 = ${$point3}[1];
  1         2  
826              
827             #
828             # Find the center and radius.
829             #
830 1         4 my $half_cot = cot($angle / 2) / 2;
831 1         16 my $xc = $x1 + ($x3 - $x1) / 2 + ($y3 - $y1) * $half_cot;
832 1         10 my $yc = $y1 + ($y3 - $y1) / 2 - ($x3 - $x1) * $half_cot;
833 1         3 my $dx = $x1 - $xc;
834 1         2 my $dy = $y1 - $yc;
835 1         2 my $r = sqrt($dx * $dx + $dy * $dy);
836              
837             #
838             # First, find the bounding box of the endpoints. Then for each
839             # axis the arc crosses, expand the box as needed.
840             #
841 1         4 my $bbox = Graphics::Fig::Parameters::getbboxFromPoints($point1, $point3);
842 1 50       45 if (&crosses_axis($point1, $point3, [ $xc - $r, $yc ]) * $angle > 0) {
843 0 0       0 if ($xc - $r < ${$bbox}[0][0]) {
  0         0  
844 0         0 ${$bbox}[0][0] = $xc - $r;
  0         0  
845             }
846             }
847 1 50       10 if (&crosses_axis($point1, $point3, [ $xc, $yc - $r ]) * $angle > 0) {
848 1 50       2 if ($yc - $r < ${$bbox}[0][1]) {
  1         3  
849 1         2 ${$bbox}[0][1] = $yc - $r;
  1         2  
850             }
851             }
852 1 50       3 if (&crosses_axis($point1, $point3, [ $xc + $r, $yc ]) * $angle > 0) {
853 1 50       2 if ($xc + $r > ${$bbox}[1][0]) {
  1         8  
854 1         2 ${$bbox}[1][0] = $xc + $r;
  1         3  
855             }
856             }
857 1 50       3 if (&crosses_axis($point1, $point3, [ $xc, $yc + $r ]) * $angle > 0) {
858 0 0       0 if ($yc + $r > ${$bbox}[1][1]) {
  0         0  
859 0         0 ${$bbox}[1][1] = $yc + $r;
  0         0  
860             }
861             }
862 1         3 return $bbox;
863             }
864              
865             #
866             # Graphics::Fig::Arc::print
867             # $self: object
868             # $fh: reference to output file handle
869             # $parameters: save parameters
870             #
871             sub print {
872 25     25 0 33 my $self = shift;
873 25         30 my $fh = shift;
874 25         29 my $parameters = shift;
875              
876 25         38 my $figPerInch = Graphics::Fig::_figPerInch($parameters);
877 25         27 my $subtype = ${$self}{"subtype"};
  25         40  
878 25         26 my $direction = ${$self}{"angle"} >= 0;
  25         49  
879 25         25 my $point1 = ${$self}{"point1"};
  25         33  
880 25         52 my ( $center, $point2 ) = &findPoint2($self);
881 25         27 my $point3 = ${$self}{"point3"};
  25         35  
882              
883             #
884             # Print
885             #
886             printf $fh ("5 %d %d %.0f %d %d %d -1 %d %.3f %d %d %d %d ".
887             "%.0f %.0f %.0f %.0f %.0f %.0f %.0f %.0f\n",
888             $subtype,
889 25         33 ${$self}{"lineStyle"},
890 25         35 ${$self}{"lineThickness"} * 80.0,
891 25         30 ${$self}{"penColor"},
892 25         31 ${$self}{"fillColor"},
893 25         28 ${$self}{"depth"},
894 25         33 ${$self}{"areaFill"},
895 25         29 ${$self}{"styleVal"} * 80.0,
896 25         29 ${$self}{"capStyle"},
897             $direction,
898 25         35 defined(${$self}{"fArrow"}) ? 1 : 0,
899 25         40 defined(${$self}{"bArrow"}) ? 1 : 0,
900 25         29 ${$center}[0] * $figPerInch, ${$center}[1] * $figPerInch,
  25         33  
901 25         31 ${$point1}[0] * $figPerInch, ${$point1}[1] * $figPerInch,
  25         28  
902 25         31 ${$point2}[0] * $figPerInch, ${$point2}[1] * $figPerInch,
  25         28  
903 25 100       38 ${$point3}[0] * $figPerInch, ${$point3}[1] * $figPerInch);
  25 100       27  
  25         208  
904 25         97 Graphics::Fig::Parameters::printArrowParameters($self, $fh, $parameters);
905             }
906              
907             1;