File Coverage

blib/lib/Math/Geometry/Construction/Circle.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Math::Geometry::Construction::Circle;
use Moose;

use 5.008008;

use Math::Geometry::Construction::Point;
use Math::Geometry::Construction::Types qw(Point);
use Carp;
use List::Util qw(max);

use overload 'x'    => '_intersect',
#             '.'    => '_point_on',
             'bool' => sub { return 1 };

=head1 NAME

C<Math::Geometry::Construction::Circle> - circle by center and point

=head1 VERSION

Version 0.024

=cut

our $VERSION = '0.024';


###########################################################################
#                                                                         #
#                      Class Variables and Methods                        #
#                                                                         #
###########################################################################

our $ID_TEMPLATE = 'C%09d';

sub id_template { return $ID_TEMPLATE }

###########################################################################
#                                                                         #
#                               Accessors                                 #
#                                                                         #
###########################################################################

with 'Math::Geometry::Construction::Role::Object';
with 'Math::Geometry::Construction::Role::PositionSelection';
with 'Math::Geometry::Construction::Role::Output';
with 'Math::Geometry::Construction::Role::PointSet';
with 'Math::Geometry::Construction::Role::Input';

has 'center'        => (isa      => Point,
			is       => 'ro',
			required => 1);

has 'support'       => (isa      => Point,
			is       => 'ro',
			required => 1);

has '_fixed_radius' => (isa      => 'Num',
			is       => 'rw',
			init_arg => 'radius',
			trigger  => \&_fixed_radius_trigger);

has 'partial_draw'  => (isa      => 'Bool',
			is       => 'rw',
			builder  => '_build_partial_draw',
			lazy     => 1);

has 'min_gap'       => (isa      => 'Num',
			is       => 'rw',
			builder  => '_build_min_gap',
			lazy     => 1);

sub BUILDARGS {
    my ($class, %args) = @_;

    # implicitly checks $args{construction}
    $args{center} = $class->import_point($args{construction},
					 $args{center});

    if(exists($args{support})) {
	if(exists($args{radius})) {
	    warn sprintf("Ignoring ircle init parameter radius.\n");
	    delete $args{radius};
	}

	$args{support} = $class->import_point($args{construction},
					      $args{support});
    }
    elsif(exists($args{radius})) {
	$args{support} = $args{construction}->add_derived_point
	    ('TranslatedPoint',
	     {input      => [$args{center}],
	      translator => [$args{radius}, 0]},
	     {hidden     => 1});
    }

    return \%args;
}

sub BUILD {
    my ($self, $args) = @_;

    $self->style('stroke', 'black') unless($self->style('stroke'));
    $self->style('fill',   'none')  unless($self->style('fill'));

    # The following call also makes sure that the support has been
    # set or can be built.
    $self->register_point($self->support);
}

sub _build_partial_draw {
    my ($self) = @_;

    return $self->construction->partial_circles;
}

sub _build_min_gap {
    my ($self) = @_;

    return $self->construction->min_circle_gap;
}

sub _fixed_radius_trigger {
    my ($self, $new, $old) = @_;

    if(@_ > 2) {
	# change of value, not init
	$self->support->derivate->translator([$new, 0]);
    }
}

###########################################################################
#                                                                         #
#                             Retrieve Data                               #
#                                                                         #
###########################################################################

sub positions {
    my ($self) = @_;

    return map { $_->position } $self->points;
}

sub radius {
    my ($self, @args) = @_;

    if(@args) {
	if(defined($self->_fixed_radius)) {
	    $self->_fixed_radius($args[0]);
	}
	else {
	    croak sprintf('Refusing to set radius on circle %s without '.
			  'fixed radius', $self->id);
	}
    }

    my $center_p  = $self->center->position;
    my $support_p = $self->support->position;

    return if(!$center_p or !$support_p);
    return(abs($support_p - $center_p));
}

sub _calculate_boundary_positions {
    my ($self, %args) = @_;

    my @positions = grep { defined($_) } $self->positions;
    return([undef, undef], [undef, undef]) if(@positions < 2);

    # sort positions around the circle; note that @sorted_positions
    # contains arrayrefs with position and angle
    my $center_position = $self->center->position; # known to be def
    my @rich_positions  = ();
    foreach(@positions) {
	my $relative = $_ - $center_position;
	my $angle    = atan2($relative->[1], $relative->[0]);
	$angle += 6.28318530717959 if($angle < 0);
	push(@rich_positions, [$_, $angle]);
    }
    my @sorted_positions = sort { $a->[1] <=> $b->[1] } @rich_positions;

    my $n   = @sorted_positions;
    my @max = (undef, undef);
    for(my $i=0;$i<$n;$i++) {
	my $diff;
	if($i + 1 < $n) {
	    $diff = $sorted_positions[$i + 1]->[1]
		- $sorted_positions[$i]->[1];
	}
	else {
	    $diff = $sorted_positions[0]->[1] + 6.28318530717959
		- $sorted_positions[$i]->[1];
	}
	@max = ($i, $diff) if(!defined($max[1]) or $diff > $max[1]);
    }

    my $extend = $self->extend;
    my $radius = $self->radius;  # known to be non-zero

    # if the gap is two small we return nothing
    if($max[1] - ($extend->[0] + $extend->[1]) / $radius
       < $self->min_gap)
    {
	return([undef, undef], [undef, undef]);
    }

    # calculate the boundary positions; note that the order needs to
    # be reversed because we now deal with the part that needs to be
    # drawn, not the gap
    my @boundary_positions = ();
    my $j                  = $max[0];
    my $i                  = ($j + 1) % $n;
    if($extend->[0] == 0) {
	push(@boundary_positions, $sorted_positions[$i]->[0]);
    }
    else {
	my $phi      = $sorted_positions[$i]->[1] - $extend->[0] / $radius;
	my $boundary = $center_position +
	    [$radius * cos($phi), $radius * sin($phi)];
	push(@boundary_positions, $boundary);
    }
    if($extend->[1] == 0) {
	push(@boundary_positions, $sorted_positions[$j]->[0]);
    }
    else {
	my $phi      = $sorted_positions[$j]->[1] + $extend->[1] / $radius;
	my $boundary = $center_position +
	    [$radius * cos($phi), $radius * sin($phi)];
	push(@boundary_positions, $boundary);
    }

    return @boundary_positions;
}

sub draw {
    my ($self, %args) = @_;
    return undef if $self->hidden;

    my $center_position  = $self->center->position;
    my $support_position = $self->support->position;

    if(!$center_position) {
	warn sprintf("Undefined center of circle %s, ".
		     "nothing to draw.\n", $self->id);
	return undef;
    }
    if(!$support_position) {
	warn sprintf("Undefined support of circle %s, ".
		     "nothing to draw.\n", $self->id);
	return undef;
    }

    my $radius = $self->radius;
    if(!$radius) {
	warn sprintf("Radius of circle %s vanishes, ".
		     "nothing to draw.\n", $self->id);
	return undef;
    }

    my @boundary_positions = $self->partial_draw
	? $self->_calculate_boundary_positions(%args)
	: ([undef, undef], [undef, undef]);

    # currently, we just draw the full circle
    $self->construction->draw_circle
	(cx    => $center_position->[0],
	 cy    => $center_position->[1],
	 r     => $radius,
	 x1    => $boundary_positions[0]->[0],
	 y1    => $boundary_positions[0]->[1],
	 x2    => $boundary_positions[1]->[0],
	 y2    => $boundary_positions[1]->[1],
	 style => $self->style_hash,
	 id    => $self->id);

    $self->draw_label('x' => $support_position->[0],
		      'y' => $support_position->[1]);
}

###########################################################################
#                                                                         #
#                              Overloading                                #
#                                                                         #
###########################################################################

sub _intersect {
    my ($self, $intersector) = @_;
    my $class;

    $class = 'Math::Geometry::Construction::Circle';
    if(eval { $intersector->isa($class) }) {
	return $self->construction->add_derived_point
	    ('IntersectionCircleCircle', {input => [$self, $intersector]});
    }

    $class = 'Math::Geometry::Construction::Line';
    if(eval { $intersector->isa($class) }) {
	return $self->construction->add_derived_point
	    ('IntersectionCircleLine', {input => [$self, $intersector]});
    }
}

1;


__END__

=pod

=head1 SYNOPSIS


=head1 DESCRIPTION


=head1 INTERFACE

=head2 Public Attributes

=head2 Methods for Users

=head2 radius

=head2 Methods for Subclass Developers

=head3 as_svg

=head3 id_template


=head1 AUTHOR

Lutz Gehlen, C<< <perl at lutzgehlen.de> >>


=head1 LICENSE AND COPYRIGHT

Copyright 2011-2013 Lutz Gehlen.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut