File Coverage

blib/lib/CXC/Astro/Regions/CIAO.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch			n/a
condition	1	3	33.3
subroutine	13	13	100.0
pod	1	1	100.0
total	57	59	96.6

package CXC::Astro::Regions::CIAO;

# ABSTRACT: CIAO Compatible Regions

use v5.20;
use warnings;
use experimental 'signatures', 'postderef', 'lexical_subs';

our $VERSION = '0.03';

use CXC::Astro::Regions::CIAO::Types qw(
  Angle
  Tuple
  Length
  NonEmptyStr
  Vertex
  ArrayRef
  XPosition
  YPosition
);

use CXC::Astro::Regions::CIAO::Variant;

package CXC::Astro::Regions::CIAO::Role::Region {
    use Moo::Role;
}

use constant RegionRole => __PACKAGE__ . '::Role::Region';

use namespace::clean;

use parent 'Exporter::Tiny';

my sub pkgpath ( @paths ) {
    join q{::}, __PACKAGE__, map { ucfirst( $_ ) } @paths;
}

my sub args ( @args ) {
    return @args == 1 ? ( name => $args[0] ) : @args;
}

my sub ANGLE      { { name => 'angle',    isa => Angle, args( @_ ) } }
my sub ANGLEPAIR  { { name => 'angles',   isa => Tuple [ Angle, Angle ], args( @_ ) } }
my sub LENGTH     { { name => 'length',   isa => Length, args( @_ ) } }
my sub LENGTHPAIR { { name => undef,      isa => Tuple [ Length, Length ], args( @_ ) } }
my sub STRING     { { name => undef,      isa => NonEmptyStr, args( @_ ) } }
my sub VERTEX     { { name => undef,      isa => Vertex,      args( @_ ) } }
my sub VERTICES   { { name => 'vertices', isa => ArrayRef [Vertex], args( @_ ) } }
my sub XPOS       { { name => undef,      isa => XPosition, args( @_ ) } }
my sub YPOS       { { name => undef,      isa => YPosition, args( @_ ) } }

use Package::Stash;
our @EXPORT_OK = ( 'mkregion' );

# my sub REGION ( $name, $params ) { $Region{$name} = $params }
my $stash = Package::Stash->new( __PACKAGE__ );

my sub REGION ( $region, %spec ) {

    $spec{with} //= [RegionRole];
    my $package = pkgpath( $region );

    if ( exists $spec{name} && $spec{name} ne $region ) {
        my $parent = pkgpath( $spec{name} );
        Moo->import::into( $parent );
        $spec{extends} = [$parent];
    }

    my $variant = Variant( $region, %spec );
    Package::Stash->new( $variant )->add_symbol( q{@CARP_NOT}, [__PACKAGE__] );

    $stash->add_symbol( q{&} . $region, sub { $package->new( @_ ) } );
    push @EXPORT_OK, $region;
}











# |-----------|-----------------------------------------------------|
# | ANNULUS   | (xcenter,ycenter,iradius,oradius)                   |
# |-----------|-----------------------------------------------------|
REGION annulus => (
    name   => 'annulus',
    params => [ VERTEX( 'center' ), LENGTHPAIR( 'radii' ) ],
);











# |-----------|-----------------------------------------------------|
# | BOX       | (xcenter,ycenter,width,height)                      |
# | BOX       | (xcenter,ycenter,width,height,angle)                |
# |-----------|-----------------------------------------------------|
REGION box => (
    name   => 'box',
    params => [ VERTEX( 'center' ), LENGTH( 'width' ), LENGTH( 'height' ), ANGLE( required => !!0 ) ],
);







# |-----------|-----------------------------------------------------|
# | CIRcle    | (xcenter,ycenter,radius)                            |
# |-----------|-----------------------------------------------------|
REGION circle => ( params => [ VERTEX( 'center' ), LENGTH( 'radius' ) ], );











# |-----------|-----------------------------------------------------|
# | ELLipse   | (xcenter,ycenter,xradius,yradius,angle)             |
# |-----------|-----------------------------------------------------|
REGION ellipse =>
  ( params => [ VERTEX( 'center' ), LENGTHPAIR( 'radii' ), ANGLE( default => 0 ) ], );









# |-----------|-----------------------------------------------------|
# | FIELD     | ()                                                  |
# -------------------------------------------------------------------
REGION field => ( params => [], );











# |-----------|-----------------------------------------------------|
# | PIE       | (xcenter,ycenter,iradius,oradius,minangle,maxangle) |
# |-----------|-----------------------------------------------------|
REGION pie => ( params => [ VERTEX( 'center' ), LENGTHPAIR( 'radii' ), ANGLEPAIR, ], );









# |-----------|-----------------------------------------------------|
# | POInt     | (xcenter,ycenter)                                   |
# |-----------|-----------------------------------------------------|
REGION point => ( params => [ VERTEX( 'center' ) ], );









# |-----------|-----------------------------------------------------|
# | POLYgon   | (x1,y1,x2,y2,x3,y3,...)                             |
# |-----------|-----------------------------------------------------|
REGION polygon => ( params => [VERTICES], );










# |-----------|-----------------------------------------------------|
# | RECTangle | (xmin,ymin,xmax,ymax)                               |
# |-----------|-----------------------------------------------------|
REGION rectangle =>
  ( params => [ XPOS( 'xmin' ), YPOS( 'ymin' ), XPOS( 'xmax' ), YPOS( 'ymax' ) ], );









# |-----------|-----------------------------------------------------|
# | REGION    | (file)                                              |
# |-----------|-----------------------------------------------------|
REGION region => ( params => [ STRING( 'file' ) ], );











# |-----------|-----------------------------------------------------|
# | ROTBOX    | (xcenter,ycenter,width,height,angle)                |
# |-----------|-----------------------------------------------------|
REGION rotbox => (
    name   => 'rotbox',
    params => [ VERTEX( 'center' ), LENGTH( 'width' ), LENGTH( 'height' ), ANGLE ],
);











# |-----------|-----------------------------------------------------|
# | SECTor    | (xcenter,ycenter,minangle,maxangle)                 |
# |-----------|-----------------------------------------------------|
REGION sector => ( params => [ VERTEX( 'center' ), ANGLEPAIR, ], );

# No longer need this; clean it up.
undef $stash;










sub mkregion ( $shape, @args ) {
    my $class = pkgpath( $shape );
    my $new   = $class->can( 'new' ) // croak( "unknown region: $shape" );
    $class->$new( @args );
}

1;

#
# This file is part of CXC-Astro-Regions
#
# This software is Copyright (c) 2023 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

__END__