File Coverage

blib/lib/Graphics/Fig/Ellipse.pm
Criterion Covered Total %
statement 425 477 89.1
branch 73 124 58.8
condition 7 21 33.3
subroutine 17 17 100.0
pod 0 8 0.0
total 522 647 80.6


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::Ellipse;
18             our $VERSION = 'v1.0.5';
19              
20 12     12   72 use strict;
  12         22  
  12         306  
21 12     12   62 use warnings;
  12         21  
  12         232  
22 12     12   49 use Carp;
  12         20  
  12         498  
23 12     12   56 use Math::Trig;
  12         20  
  12         1656  
24 12     12   81 use Graphics::Fig::Color;
  12         30  
  12         314  
25 12     12   58 use Graphics::Fig::Matrix;
  12         20  
  12         279  
26 12     12   55 use Graphics::Fig::Parameters;
  12         20  
  12         45130  
27              
28             #
29             # RE_INT: regular expression matching an integer
30             #
31             my $RE_INT = "(?:(?:[-+]?)(?:[0123456789]+))";
32              
33             #
34             # Graphics::Fig::Ellipse::generalToCanonical
35             # ( $A, $B, $C, $D, $E, $F )
36             #
37             # Returns:
38             # ( $a, $b, $xc, $yc, $rotation )
39             #
40             sub generalToCanonical {
41 12     12 0 36 my ($A, $B, $C, $D, $E, $F) = @_;
42              
43 12         32 my $d = $B * $B - 4.0 * $A * $C;
44 12 50       28 if ($d > - Graphics::Fig::Matrix::EPS) {
45 0         0 croak("given points do not describe a circle or ellipse");
46             }
47 12         59 my $p = 2.0 * ($A*$E*$E + $C*$D*$D - $B*$D*$E + $d*$F);
48 12         20 my $q = $A + $C;
49 12         28 my $r = sqrt(($A - $C) * ($A - $C) + $B * $B);
50 12         33 my $a = -sqrt($p * ($q + $r)) / $d;
51 12         28 my $b = -sqrt($p * ($q - $r)) / $d;
52 12         29 my $xc = (2*$C*$D - $B*$E) / $d;
53 12         26 my $yc = (2*$A*$E - $B*$D) / $d;
54 12         16 my $rotation;
55 12 100       42 if (abs($B) < Graphics::Fig::Matrix::EPS) {
56 9 50       30 if ($A <= $C) {
57 9         28 $rotation = 0;
58             } else {
59 0         0 $rotation = pi / 2.0;
60             }
61             } else {
62 3         13 $rotation = atan2(-($C - $A - $r) / $B, 1.0);
63             }
64 12         48 return ($a, $b, $xc, $yc, $rotation);
65             }
66              
67             #
68             # Graphics::Fig::_convertCircleSubtype
69             # $self: class instance
70             # $prefix: error message prefix
71             # $value: {radius|diameter}
72             # $context: parameter context
73             #
74             sub _convertCircleSubtype {
75 1     1   2 my $self = shift;
76 1         2 my $prefix = shift;
77 1         1 my $value = shift;
78 1         2 my $context = shift;
79              
80 1 50       4 if ($value eq "radius") {
81 0         0 return 3;
82             }
83 1 50       3 if ($value eq "diameter") {
84 1         3 return 4;
85             }
86 0 0       0 if ($value =~ m/^$RE_INT$/) {
87 0 0 0     0 if ($value != 3 && $value != 4) {
88 0         0 croak("${prefix}: ${value}: error: " .
89             "expected integer between 3 and 4");
90 0         0 return $value;
91             }
92             }
93 0         0 croak("${prefix}: ${value}: error: expected {radius|diameter}");
94             }
95              
96             #
97             # Graphics::Fig::_convertEllipseSubtype
98             # $self: class instance
99             # $prefix: error message prefix
100             # $value: {radius|diameter}
101             # $context: parameter context
102             #
103             sub _convertEllipseSubtype {
104 1     1   2 my $self = shift;
105 1         2 my $prefix = shift;
106 1         2 my $value = shift;
107 1         2 my $context = shift;
108              
109 1 50       4 if ($value eq "radii") {
110 0         0 return 1;
111             }
112 1 50       2 if ($value eq "diameters") {
113 1         3 return 2;
114             }
115 0 0       0 if ($value =~ m/^$RE_INT$/) {
116 0 0 0     0 if ($value != 1 && $value != 2) {
117 0         0 croak("${prefix}: ${value}: error: " .
118             "expected integer between 1 and 2");
119 0         0 return $value;
120             }
121             }
122 0         0 croak("${prefix}: ${value}: error: expected {radii|diameters}");
123             }
124              
125             my @EllipseCommonParameters = (
126             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
127             \%Graphics::Fig::Parameters::PositionParameter, # must be second
128             \%Graphics::Fig::Parameters::CenterParameter,
129             \%Graphics::Fig::Parameters::ColorParameter,
130             \%Graphics::Fig::Parameters::DepthParameter,
131             @Graphics::Fig::Parameters::FillParameters,
132             @Graphics::Fig::Parameters::LineParameters,
133             \%Graphics::Fig::Parameters::PointsParameter,
134             \%Graphics::Fig::Parameters::RotationParameter,
135             );
136              
137             #
138             # Circle Parameters
139             #
140             my %CircleParameterTemplate = (
141             positional => {
142             "." => [ "d" ],
143             "@" => [ "points" ],
144             },
145             named => [
146             @EllipseCommonParameters,
147             {
148             name => "subtype",
149             convert => \&_convertCircleSubtype,
150             },
151             {
152             name => "d",
153             aliases => [ "diameter" ],
154             convert => \&Graphics::Fig::Parameters::convertLength,
155             },
156             {
157             name => "r",
158             aliases => [ "radius" ],
159             convert => \&Graphics::Fig::Parameters::convertLength,
160             },
161             ],
162             );
163              
164             #
165             # Ellipse Parameters
166             #
167             my %EllipseParameterTemplate = (
168             positional => {
169             ".." => [ "a", "b" ],
170             "..." => [ "a", "b", "rotation" ],
171             "@" => [ "points" ],
172             },
173             named => [
174             @EllipseCommonParameters,
175             {
176             name => "subtype",
177             convert => \&_convertEllipseSubtype,
178             },
179             {
180             name => "a",
181             convert => \&Graphics::Fig::Parameters::convertLength,
182             },
183             {
184             name => "b",
185             convert => \&Graphics::Fig::Parameters::convertLength,
186             },
187             ],
188             );
189              
190              
191             #
192             # Graphics::Fig::Ellipse::circle constructor
193             # $proto: prototype
194             # $fig: parent object
195             # @parameters: circle parameters
196             #
197             sub circle {
198 8     8 0 12 my $proto = shift;
199 8         13 my $fig = shift;
200              
201             #
202             # Parse parameters.
203             #
204 8         10 my %parameters;
205 8         12 my $stack = ${$fig}{"stack"};
  8         12  
206 8         12 my $tos = ${$stack}[$#{$stack}];
  8         13  
  8         12  
207 8         21 eval {
208             Graphics::Fig::Parameters::parse($fig, "circle",
209             \%CircleParameterTemplate,
210 8         88 ${$tos}{"options"}, \%parameters, @_);
  8         53  
211             };
212 8 50       19 if ($@) {
213 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
214 0         0 croak("$@");
215             }
216              
217             #
218             # Construct the object. Undefined parameters are set below.
219             #
220             my $self = {
221             subtype => undef,
222             center => undef,
223             a => undef,
224             b => undef,
225             rotation => undef,
226             lineStyle => $parameters{"lineStyle"},
227             lineThickness => $parameters{"lineThickness"},
228             penColor => $parameters{"penColor"},
229             fillColor => $parameters{"fillColor"},
230             depth => $parameters{"depth"},
231             areaFill => $parameters{"areaFill"},
232 8         73 styleVal => $parameters{"styleVal"},
233             };
234              
235             #
236             # If "r" or "d" given, set $r to radius and $dr to "r" or "d",
237             # respectively.
238             #
239 8         15 my $r;
240             my $dr;
241 8 100       24 if (defined($parameters{"r"})) {
    100          
242 2 50       7 if (defined($parameters{"d"})) {
243 0         0 croak("circle: error: r and d cannot be given together");
244             }
245 2         5 $r = $parameters{"r"};
246 2         4 $dr = "r";
247              
248             } elsif (defined($parameters{"d"})) {
249 4         40 $r = $parameters{"d"} / 2.0;
250 4         10 $dr = "d";
251             }
252              
253             #
254             # Set subtype.
255             #
256 8 100 100     54 if (defined($parameters{"subtype"})) {
    100          
257 1         2 ${$self}{"subtype"} = $parameters{"subtype"};
  1         2  
258             } elsif (defined($dr) && $dr eq "d") {
259 4         6 ${$self}{"subtype"} = 4;
  4         10  
260             } else {
261 3         7 ${$self}{"subtype"} = 3;
  3         5  
262             }
263              
264             #
265             # Find circle from points.
266             #
267 8 100       20 if (defined(my $points = $parameters{"points"})) {
268             #
269             # Diameter or radius cannot be given with points.
270             #
271 2 50       4 if (defined($r)) {
272 0         0 croak("circle: ${dr} and points cannot be given together");
273             }
274              
275             #
276             # One point
277             #
278 2 100       3 if (@{$points} == 1) {
  2 50       5  
279             #
280             # Find the center.
281             #
282 1 50       3 if (defined($parameters{"center"})) {
283 1         2 ${$self}{"center"} = $parameters{"center"};
  1         3  
284             } else {
285 0         0 ${$self}{"center"} = $parameters{"position"};
  0         0  
286             }
287              
288             #
289             # Find radius as the length of the vector relative to center.
290             #
291 1         2 my $dx = ${$points}[0][0] - ${$self}{"center"}[0];
  1         4  
  1         2  
292 1         2 my $dy = ${$points}[0][1] - ${$self}{"center"}[1];
  1         2  
  1         2  
293 1         3 my $a = sqrt($dx*$dx + $dy*$dy);
294 1         2 ${$self}{"a"} = $a;
  1         2  
295 1         1 ${$self}{"b"} = $a;
  1         2  
296             # rotation set below
297              
298             #
299             # Three points: calc circle from three arbitrary points.
300             #
301 1         4 } elsif (@{$points} == 3) {
302 1 50       3 if (defined($parameters{"center"})) {
303 0         0 croak("circle: error: center may not be given with " .
304             "three points");
305             }
306             #
307             # Let A = 1. Solve for D, E and F:
308             # D x1 + E y1 + F == -(x1^2 + y1^2)
309             # D x2 + E y2 + F == -(x2^2 + y2^2)
310             # D x3 + E y3 + F == -(x3^2 + y3^2)
311             #
312 1         2 my $x1 = ${$points}[0][0];
  1         2  
313 1         3 my $y1 = ${$points}[0][1];
  1         1  
314 1         2 my $x2 = ${$points}[1][0];
  1         2  
315 1         1 my $y2 = ${$points}[1][1];
  1         2  
316 1         2 my $x3 = ${$points}[2][0];
  1         2  
317 1         2 my $y3 = ${$points}[2][1];
  1         2  
318 1         7 my @M = (
319             [ $x1, $y1, 1, -($x1*$x1 + $y1*$y1) ],
320             [ $x2, $y2, 1, -($x2*$x2 + $y2*$y2) ],
321             [ $x3, $y3, 1, -($x3*$x3 + $y3*$y3) ],
322             );
323 1         6 my $d = Graphics::Fig::Matrix::reduce(\@M);
324 1 50       3 if (abs($d) < Graphics::Fig::Matrix::EPS) {
325 0         0 croak("arc: error: singular matrix");
326             }
327 1         2 my $D = $M[0][3];
328 1         2 my $E = $M[1][3];
329 1         7 my $F = $M[2][3];
330            
331             #
332             # Convert to canonical form. Returned rotation is
333             # always zero -- ignore it.
334             #
335 1         5 my ($a, $b, $xc, $yc, $dummy_rotation) =
336             &generalToCanonical(1, 0, 1, $D, $E, $F);
337 1 50       3 die "$a != $b" unless $a == $b;
338 1 50       4 die "rotation = $dummy_rotation" unless $dummy_rotation == 0.0;
339 1         2 ${$self}{"center"} = [ $xc, $yc ];
  1         2  
340 1         3 ${$self}{"a"} = $a;
  1         1  
341 1         2 ${$self}{"b"} = $a;
  1         3  
342             # rotation set below
343              
344             } else {
345 0         0 croak("circle: error: expected either 1 or 3 points");
346             }
347              
348             #
349             # Find the rotation.
350             #
351 2 50       3 die unless ref(${$self}{"center"}) eq "ARRAY";
  2         6  
352 2 50       5 if (defined($parameters{"rotation"})) {
353 0         0 ${$self}{"rotation"} = $parameters{"rotation"};
  0         0  
354             } else {
355 2         3 my $dx = ${$points}[0][0] - ${$self}{"center"}[0];
  2         3  
  2         4  
356 2         2 my $dy = ${$points}[0][1] - ${$self}{"center"}[1];
  2         3  
  2         4  
357 2         9 ${$self}{"rotation"} = atan2(-$dy, $dx);
  2         4  
358             }
359              
360             } else {
361             #
362             # Make sure r or d was given.
363             #
364 6 50       16 if (!defined($r)) {
365 0         0 croak("circle: error: expected r, d or points");
366             }
367              
368             #
369             # Find the center.
370             #
371 6 100       14 if (defined($parameters{"center"})) {
372 5         7 ${$self}{"center"} = $parameters{"center"};
  5         8  
373             } else {
374 1         2 ${$self}{"center"} = $parameters{"position"};
  1         2  
375             }
376              
377             #
378             # Set the axes.
379             #
380 6         9 ${$self}{"a"} = $r;
  6         11  
381 6         7 ${$self}{"b"} = $r;
  6         9  
382              
383             #
384             # Find the rotation.
385             #
386 6 50       21 if (defined($parameters{"rotation"})) {
387 0         0 ${$self}{"rotation"} = $parameters{"rotation"};
  0         0  
388             } else {
389 6         9 ${$self}{"rotation"} = 0;
  6         10  
390             }
391             }
392              
393 8   33     27 my $class = ref($proto) || $proto;
394 8         14 bless($self, $class);
395 8         11 push(@{${$tos}{"objects"}}, $self);
  8         18  
  8         21  
396 8         35 return $self;
397             }
398              
399             #
400             # Graphics::Fig::Ellipse::ellipse constructor
401             # $proto: prototype
402             # $fig: parent object
403             # @parameters: ellipse parameters
404             #
405             sub ellipse {
406 7     7 0 11 my $proto = shift;
407 7         9 my $fig = shift;
408              
409             #
410             # Parse parameters.
411             #
412 7         11 my %parameters;
413 7         9 my $stack = ${$fig}{"stack"};
  7         11  
414 7         9 my $tos = ${$stack}[$#{$stack}];
  7         12  
  7         10  
415 7         11 eval {
416             Graphics::Fig::Parameters::parse($fig, "ellipse",
417             \%EllipseParameterTemplate,
418 7         53 ${$tos}{"options"}, \%parameters, @_);
  7         50  
419             };
420 7 50       29 if ($@) {
421 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
422 0         0 croak("$@");
423             }
424              
425             #
426             # Construct the object. Undefined parameters are set below.
427             #
428             my $self = {
429             subtype => undef,
430             center => undef,
431             a => undef,
432             b => undef,
433             rotation => undef,
434             lineStyle => $parameters{"lineStyle"},
435             lineThickness => $parameters{"lineThickness"},
436             penColor => $parameters{"penColor"},
437             fillColor => $parameters{"fillColor"},
438             depth => $parameters{"depth"},
439             areaFill => $parameters{"areaFill"},
440 7         57 styleVal => $parameters{"styleVal"},
441             };
442              
443             #
444             # Find the subtype.
445             #
446 7 100       28 if (defined($parameters{"subtype"})) {
447 1         2 ${$self}{"subtype"} = $parameters{"subtype"};
  1         2  
448             } else {
449 6         10 ${$self}{"subtype"} = 1;
  6         21  
450             }
451              
452             #
453             # Find ellipse from points.
454             #
455 7 100       18 if (defined(my $points = $parameters{"points"})) {
456 4 50 33     21 if (defined($parameters{"a"}) || defined($parameters{"b"})) {
457 0         0 croak("ellipse: axes and points cannot be given together");
458             }
459              
460             #
461             # Two points: calculate ellipse from 2 points, center and rotation.
462             # Requires (x1^2 - x2^2)(y1^2 - y2^2) < 0 after rotating the major
463             # axis to an x or y axis.
464             #
465 4 100       7 if (@{$points} == 2) {
  4 100       9  
    50          
466             #
467             # Find the center.
468             #
469 1         2 my ($xc, $yc);
470 1 50       3 if (defined($parameters{"center"})) {
471 1         1 ( $xc, $yc ) = @{$parameters{"center"}};
  1         4  
472             } else {
473 0         0 ( $xc, $yc ) = @{$parameters{"position"}};
  0         0  
474             }
475 1         2 ${$self}{"center"} = [ $xc, $yc ];
  1         2  
476              
477             #
478             # Translate the points to center.
479             #
480 1         2 my $x1 = ${$points}[0][0] - $xc;
  1         3  
481 1         1 my $y1 = ${$points}[0][1] - $yc;
  1         2  
482 1         2 my $x2 = ${$points}[1][0] - $xc;
  1         3  
483 1         1 my $y2 = ${$points}[1][1] - $yc;
  1         2  
484              
485             #
486             # Find the rotation. If not given, calculate it from the
487             # first point.
488             #
489 1         2 my $rotation;
490 1 50       3 if (!defined($rotation = $parameters{"rotation"})) {
491 1         6 $rotation = atan2(-$y1, $x1);
492             }
493 1         1 ${$self}{"rotation"} = $rotation;
  1         2  
494              
495             #
496             # Rotate the ellipse clockwise to place major axis along
497             # the x-axis.
498             #
499 1         2 my $c = cos($rotation);
500 1         3 my $s = sin($rotation);
501 1         4 ( $x1, $y1 ) = ( $c * $x1 - $s * $y1, $s * $x1 + $c * $y1 );
502 1         3 ( $x2, $y2 ) = ( $c * $x2 - $s * $y2, $s * $x2 + $c * $y2 );
503              
504             # Let A = 1. Solve for C and F:
505             # C y1^2 + F == -x1^2
506             # C y2^2 + F == -x2^2
507             #
508 1         3 my @M = (
509             [ $y1*$y1, 1, -$x1*$x1 ],
510             [ $y2*$y2, 1, -$x2*$x2 ],
511             );
512 1         4 my $d = Graphics::Fig::Matrix::reduce(\@M);
513 1 50       3 if (abs($d) < Graphics::Fig::Matrix::EPS) {
514 0         0 croak("ellipse: error: singular matrix");
515             }
516 1         2 my $C = $M[0][2];
517 1         2 my $F = $M[1][2];
518 1         4 my ($a, $b, $dummy_xc, $dummy_yc, $dummy_rotation) =
519             &generalToCanonical(1, 0, $C, 0.0, 0.0, $F);
520 1 50       4 die unless abs($dummy_xc) < Graphics::Fig::Matrix::EPS;
521 1 50       4 die unless abs($dummy_yc) < Graphics::Fig::Matrix::EPS;
522              
523             #
524             # Swap $a and $b if the minor diagonal is larger than the
525             # major diagonal, i.e. dummy_rotation is not zero.
526             #
527 1 50       3 if (1.0 > $C) {
528 0         0 ($a, $b) = ($b, $a);
529             }
530 1         2 ${$self}{"a"} = $a;
  1         2  
531 1         2 ${$self}{"b"} = $b;
  1         8  
532 1         2 ${$self}{"rotation"} = $rotation;
  1         3  
533              
534             #
535             # Three points: calculate ellipse from 3 arbitrary points and center.
536             #
537 3         12 } elsif (@{$points} == 3) {
538 1 50       3 if (defined($parameters{"rotation"})) {
539 0         0 croak("ellipse: error: rotation may not be given " .
540             "with 3 points");
541             }
542              
543             #
544             # Find the center.
545             #
546 1         3 my ($xc, $yc);
547 1 50       3 if (defined($parameters{"center"})) {
548 0         0 ( $xc, $yc ) = @{$parameters{"center"}};
  0         0  
549             } else {
550 1         2 ( $xc, $yc ) = @{$parameters{"position"}};
  1         3  
551             }
552 1         3 ${$self}{"center"} = [ $xc, $yc ];
  1         1  
553              
554             #
555             # Find the three vectors relative to center.
556             #
557 1         3 my $x1 = ${$points}[0][0] - $xc;
  1         2  
558 1         1 my $y1 = ${$points}[0][1] - $yc;
  1         2  
559 1         2 my $x2 = ${$points}[1][0] - $xc;
  1         2  
560 1         2 my $y2 = ${$points}[1][1] - $yc;
  1         2  
561 1         2 my $x3 = ${$points}[2][0] - $xc;
  1         2  
562 1         2 my $y3 = ${$points}[2][1] - $yc;
  1         2  
563              
564             #
565             # Let A = 1. Solve for B, C and F:
566             # B x1 y1 + C y1^2 + F == -x1^2
567             # B x2 y2 + C y2^2 + F == -x2^2
568             # B x3 y1 + C y3^2 + F == -x3^2
569             #
570 1         6 my @M = (
571             [ $x1*$y1, $y1*$y1, 1, -$x1*$x1 ],
572             [ $x2*$y2, $y2*$y2, 1, -$x2*$x2 ],
573             [ $x3*$y3, $y3*$y3, 1, -$x3*$x3 ],
574             );
575 1         3 my $d = Graphics::Fig::Matrix::reduce(\@M);
576 1 50       5 if (abs($d) < Graphics::Fig::Matrix::EPS) {
577 0         0 croak("ellipse: error: singular matrix");
578             }
579 1         11 my $B = $M[0][3];
580 1         3 my $C = $M[1][3];
581 1         2 my $F = $M[2][3];
582 1         4 my ($a, $b, $dummy_xc, $dummy_yc, $rotation) =
583             &generalToCanonical(1, $B, $C, 0.0, 0.0, $F);
584 1 50       3 die unless abs($dummy_xc) < Graphics::Fig::Matrix::EPS;
585 1 50       4 die unless abs($dummy_yc) < Graphics::Fig::Matrix::EPS;
586              
587 1         1 ${$self}{"a"} = $a;
  1         2  
588 1         1 ${$self}{"b"} = $b;
  1         2  
589 1         2 ${$self}{"rotation"} = $rotation;
  1         3  
590              
591 2         7 } elsif (@{$points} == 5) {
592 2 50       22 if (defined($parameters{"center"})) {
593 0         0 croak("ellipse: error: center may not be given " .
594             "with 5 points");
595             }
596 2 50       7 if (defined($parameters{"rotation"})) {
597 0         0 croak("ellipse: error: rotation may not be given " .
598             "with 5 points");
599             }
600              
601             #
602             # Find the vectors relative to the figure origin.
603             #
604 2         5 my $x1 = ${$points}[0][0];
  2         5  
605 2         4 my $y1 = ${$points}[0][1];
  2         5  
606 2         4 my $x2 = ${$points}[1][0];
  2         4  
607 2         3 my $y2 = ${$points}[1][1];
  2         4  
608 2         4 my $x3 = ${$points}[2][0];
  2         3  
609 2         4 my $y3 = ${$points}[2][1];
  2         4  
610 2         16 my $x4 = ${$points}[3][0];
  2         12  
611 2         5 my $y4 = ${$points}[3][1];
  2         3  
612 2         4 my $x5 = ${$points}[4][0];
  2         4  
613 2         4 my $y5 = ${$points}[4][1];
  2         5  
614              
615             #
616             # Let A = 1. Solve for B, C, D, E and F:
617             #
618             # B x1 y1 + C y1^2 + D x1 + E y1 + F == -x1^2
619             # B x2 y2 + C y2^2 + D x2 + E y2 + F == -x2^2
620             # B x3 y3 + C y3^2 + D x3 + E y3 + F == -x3^2
621             # B x4 y4 + C y4^2 + D x4 + E y4 + F == -x4^2
622             # B x5 y5 + C y5^2 + D x5 + E y5 + F == -x5^2
623             #
624 2         20 my @M = (
625             [ $x1*$y1, $y1*$y1, $x1, $y1, 1, -$x1*$x1 ],
626             [ $x2*$y2, $y2*$y2, $x2, $y2, 1, -$x2*$x2 ],
627             [ $x3*$y3, $y3*$y3, $x3, $y3, 1, -$x3*$x3 ],
628             [ $x4*$y4, $y4*$y4, $x4, $y4, 1, -$x4*$x4 ],
629             [ $x5*$y5, $y5*$y5, $x5, $y5, 1, -$x5*$x5 ],
630             );
631 2         10 my $d = Graphics::Fig::Matrix::reduce(\@M);
632 2 50       8 if (abs($d) < Graphics::Fig::Matrix::EPS) {
633 0         0 croak("ellipse: error: singular matrix");
634             }
635 2         4 my $B = $M[0][5];
636 2         5 my $C = $M[1][5];
637 2         4 my $D = $M[2][5];
638 2         5 my $E = $M[3][5];
639 2         3 my $F = $M[4][5];
640              
641             #
642             # Convert to canonical form.
643             #
644 2         8 my ($a, $b, $xc, $yc, $rotation) =
645             &generalToCanonical(1, $B, $C, $D, $E, $F);
646              
647 2         6 ${$self}{"a"} = $a;
  2         4  
648 2         4 ${$self}{"b"} = $b;
  2         5  
649 2         5 ${$self}{"center"} = [ $xc, $yc ];
  2         68  
650 2         4 ${$self}{"rotation"} = $rotation;
  2         67  
651              
652             } else {
653 0         0 croak("ellipse: error: expected either 2, 3 or 5 points");
654             }
655              
656              
657             } else {
658 3 50 33     12 if (!defined($parameters{"a"}) || !defined($parameters{"b"})) {
659 0         0 croak("ellipse: error: expected (a, b) or points");
660             }
661              
662             #
663             # Find the center.
664             #
665 3         5 my ($xc, $yc);
666 3 50       4 if (defined($parameters{"center"})) {
667 0         0 ( $xc, $yc ) = @{$parameters{"center"}};
  0         0  
668             } else {
669 3         6 ( $xc, $yc ) = @{$parameters{"position"}};
  3         6  
670             }
671 3         5 ${$self}{"center"} = [ $xc, $yc ];
  3         5  
672              
673             #
674             # Set axes.
675             #
676 3         4 ${$self}{"a"} = $parameters{"a"};
  3         5  
677 3         4 ${$self}{"b"} = $parameters{"b"};
  3         3  
678              
679             #
680             # Find rotation.
681             #
682 3 100       7 if (defined($parameters{"rotation"})) {
683 1         2 ${$self}{"rotation"} = $parameters{"rotation"};
  1         2  
684             } else {
685 2         2 ${$self}{"rotation"} = 0.0;
  2         3  
686             }
687             }
688              
689 7   33     29 my $class = ref($proto) || $proto;
690 7         14 bless($self, $class);
691 7         9 push(@{${$tos}{"objects"}}, $self);
  7         8  
  7         18  
692 7         43 return $self;
693             }
694              
695             #
696             # Graphics::Fig::Ellipse::translate
697             # $self: object
698             # $parameters: reference to parameter hash
699             #
700             sub translate {
701 4     4 0 6 my $self = shift;
702 4         13 my $parameters = shift;
703              
704 4         8 ( ${$self}{"center"} ) = Graphics::Fig::Parameters::translatePoints(
705 4         7 $parameters, ${$self}{"center"});
  4         9  
706              
707 4         8 return 1;
708             }
709              
710             #
711             # Graphics::Fig::Ellipse::rotate
712             # $self: object
713             # $parameters: reference to parameter hash
714             #
715             sub rotate {
716 5     5 0 9 my $self = shift;
717 5         7 my $parameters = shift;
718 5         8 my $rotation = ${$parameters}{"rotation"};
  5         8  
719              
720 5         12 ( ${$self}{"center"} ) = Graphics::Fig::Parameters::rotatePoints(
721 5         9 $parameters, ${$self}{"center"});
  5         21  
722 5         8 ${$self}{"rotation"} += $rotation;
  5         9  
723              
724 5         13 return 1;
725             }
726              
727             #
728             # Graphics::Fig::Ellipse::scale
729             # $self: object
730             # $parameters: reference to parameter hash
731             #
732             sub scale {
733 1     1 0 2 my $self = shift;
734 1         2 my $parameters = shift;
735 1         2 my $scale = ${$parameters}{"scale"};
  1         16  
736 1 50       3 die unless defined($scale);
737 1         2 my $u = ${$scale}[0];
  1         2  
738 1         1 my $v = ${$scale}[1];
  1         3  
739              
740             #
741             # Simple case: scale proportionally. Rotation does not change.
742             #
743 1 50       2 if ($u == $v) {
744 0         0 ${$self}{"a"} *= $u;
  0         0  
745 0         0 ${$self}{"b"} *= $v;
  0         0  
746              
747             #
748             # General case: calculate new a, b, and rotation from general form.
749             # It's not sufficient to simply scale a and b by the projection on
750             # the rotation because when the ellipse is distorted, the position
751             # of the axes shifts along the perimeter. Note that subtype circle
752             # becomes an ellipse in "print" if necessary.
753             #
754             } else {
755 1         2 my $a = ${$self}{"a"};
  1         2  
756 1         1 my $b = ${$self}{"b"};
  1         3  
757 1         1 my $c = cos(${$self}{"rotation"});
  1         3  
758 1         1 my $s = sin(${$self}{"rotation"});
  1         3  
759 1         4 my $A = ($a*$a*$s*$s + $b*$b*$c*$c) / ($u*$u);
760 1         4 my $B = 2.0 * ($b*$b - $a*$a) * -$s * $c / ($u*$v);
761 1         2 my $C = ($a*$a*$c*$c + $b*$b*$s*$s) / ($v*$v);
762 1         2 my $F = -$a*$a*$b*$b;
763 1         3 my @R = &generalToCanonical($A, $B, $C, 0.0, 0.0, $F);
764 1         2 ${$self}{"a"} = $R[0];
  1         2  
765 1         2 ${$self}{"b"} = $R[1];
  1         12  
766 1         3 ${$self}{"rotation"} = $R[4];
  1         3  
767             }
768 1         6 ( ${$self}{"center"} ) = Graphics::Fig::Parameters::scalePoints(
769 1         3 $parameters, ${$self}{"center"});
  1         5  
770             }
771              
772             #
773             # Graphics::Fig::Elliipse return [[xmin, ymin], [xmax, ymax]]
774             # $self: object
775             # $parameters: getbbox parameters
776             #
777             sub getbbox {
778 9     9 0 17 my $self = shift;
779 9         12 my $parameters = shift;
780              
781 9         14 my $center = ${$self}{"center"};
  9         18  
782 9         13 my $a = ${$self}{"a"};
  9         16  
783 9         11 my $b = ${$self}{"b"};
  9         13  
784 9         13 my $rotation = ${$self}{"rotation"};
  9         16  
785 9         11 my $xc = ${$center}[0];
  9         16  
786 9         11 my $yc = ${$center}[1];
  9         13  
787 9         18 my $c = cos($rotation);
788 9         14 my $s = sin($rotation);
789 9         19 my $dx = sqrt($a*$a*$c*$c + $b*$b*$s*$s);
790 9         19 my $dy = sqrt($b*$b*$c*$c + $a*$a*$s*$s);
791 9         40 return Graphics::Fig::Parameters::getbboxFromPoints(
792             [ $xc + $dx, $yc ],
793             [ $xc, $yc + $dy ],
794             [ $xc - $dx, $yc ],
795             [ $xc, $yc - $dy ]);
796             }
797              
798             #
799             # Graphics::Fig::Ellipse::print
800             # $self: object
801             # $fh: referece to output file handle
802             # $parameters: save parameters
803             #
804             sub print {
805 15     15 0 33 my $self = shift;
806 15         24 my $fh = shift;
807 15         21 my $parameters = shift;
808              
809 15         38 my $figPerInch = Graphics::Fig::_figPerInch($parameters);
810              
811             #
812             # If a != b after converting to fig units and the subtype is
813             # a circle, change it to an ellipse.
814             #
815 15         21 my $subtype = ${$self}{"subtype"};
  15         25  
816 15 50       19 die unless defined(${$self}{"subtype"});
  15         33  
817 15         21 my $scaled_a = sprintf("%.0f", ${$self}{"a"} * $figPerInch);
  15         49  
818 15         21 my $scaled_b = sprintf("%.0f", ${$self}{"b"} * $figPerInch);
  15         37  
819 15 100       44 if ($scaled_a != $scaled_b) {
820 7 50       20 if ($subtype == 3) {
    50          
821 0         0 $subtype = 1;
822             } elsif ($subtype == 4) {
823 0         0 $subtype = 2;
824             }
825             }
826              
827             #
828             # Calculate start and end points.
829             #
830 15         20 my $dx = ${$self}{"a"} * cos(${$self}{"rotation"});
  15         20  
  15         89  
831 15         26 my $dy = -${$self}{"a"} * sin(${$self}{"rotation"});
  15         28  
  15         30  
832 15         29 my @start;
833 15 100       34 if ($subtype & 1) {
834 9         11 @start = @{${$self}{"center"}};
  9         22  
  9         24  
835             } else {
836 6         14 @start = ( ${${$self}{"center"}}[0] - $dx,
  6         16  
837 6         8 ${${$self}{"center"}}[1] - $dy );
  6         11  
  6         13  
838             }
839 15         17 my @end = ( ${${$self}{"center"}}[0] + $dx,
  15         31  
840 15         29 ${${$self}{"center"}}[1] + $dy );
  15         18  
  15         32  
841              
842             #
843             # Print
844             #
845             printf $fh ("1 %d %d %.0f %d %d %d -1 %d %.3f 1 %.4f " .
846             "%.0f %.0f %.0f %.0f %.0f %.0f %.0f %.0f\n",
847             $subtype,
848 15         24 ${$self}{"lineStyle"},
849 15         24 ${$self}{"lineThickness"} * 80.0,
850 15         18 ${$self}{"penColor"},
851 15         21 ${$self}{"fillColor"},
852 15         28 ${$self}{"depth"},
853 15         18 ${$self}{"areaFill"},
854 15         21 ${$self}{"styleVal"} * 80.0,
855 15         19 ${$self}{"rotation"},
856 15         24 ${$self}{"center"}[0] * $figPerInch,
857 15         20 ${$self}{"center"}[1] * $figPerInch,
  15         178  
858             $scaled_a,
859             $scaled_b,
860             $start[0] * $figPerInch,
861             $start[1] * $figPerInch,
862             $end[0] * $figPerInch,
863             $end[1] * $figPerInch);
864             }
865              
866             1;