File Coverage

blib/lib/CXC/Astro/Regions/CFITSIO.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::CFITSIO;

# ABSTRACT: CFITSIO Compatible Regions

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

our $VERSION = '0.03';

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

use CXC::Astro::Regions::CFITSIO::Variant;

package CXC::Astro::Regions::CFITSIO::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       ( Xc, Yc, Rin, Rout )
REGION annulus => (
    name   => 'annulus',
    params => [ VERTEX( 'center' ), LENGTHPAIR( 'radii' ) ],
);











# Box           ( Xc, Yc, Wdth, Hght, A )   V within the region
REGION box => (
    name   => 'box',
    params => [ VERTEX( 'center' ), LENGTH( 'width' ), LENGTH( 'height' ), ANGLE( default => 0 ) ],
);







# Circle        ( Xc, Yc, R )
REGION circle => ( params => [ VERTEX( 'center' ), LENGTH( 'radius' ) ], );








# Diamond       ( Xc, Yc, Wdth, Hght, A )
REGION diamond =>
  ( params => [ VERTEX( 'center' ), LENGTH( 'width' ), LENGTH( 'height' ), ANGLE( default => 0 ) ],
  );











# Ellipse       ( Xc, Yc, Rx, Ry, A )
REGION ellipse =>
  ( params => [ VERTEX( 'center' ), LENGTHPAIR( 'radii' ), ANGLE( default => 0 ) ], );












# Elliptannulus ( Xc, Yc, Rinx, Riny, Routx, Routy, Ain, Aout )
REGION elliptannulus =>
  ( params => [ VERTEX( 'center' ), LENGTHPAIR( 'inner' ), LENGTHPAIR( 'outer' ), ANGLEPAIR ], );








# Line          ( X1, Y1, X2, Y2 )
REGION line => ( params => [ VERTEX( 'v1' ), VERTEX( 'v2' ) ], );









#  Point         ( X1, Y1 )
REGION point => ( params => [ VERTEX( 'center' ) ], );









# Polygon       ( X1, Y1, X2, Y2, ... )
REGION polygon => ( params => [VERTICES], );











#  Rectangle     ( X1, Y1, X2, Y2, A )
REGION rectangle => (
    params => [ XPOS( 'xmin' ), YPOS( 'ymin' ), XPOS( 'xmax' ), YPOS( 'ymax' ), ANGLE( default => 0 ) ],
);










# Sector        ( Xc, Yc, Amin, Amax )
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__