view release on metacpan or  search on metacpan

lib/Graphics/Grid/Types.pm  view on Meta::CPAN

package Graphics::Grid::Types;

# ABSTRACT: Custom types and coercions used by Graphics::Grid

use 5.014;
use warnings;

our $VERSION = '0.0001'; # VERSION

use Ref::Util qw(is_plain_arrayref);
use Type::Library -base, -declare => qw(
  UnitName Unit UnitArithmetic UnitLike
  GPar
  PlottingCharacter
  LineType LineEnd LineJoin
  FontFace
  Color
  Justification Clip
);

use Type::Utils -all;
use Types::Standard -types;


class_type Unit, { class => 'Graphics::Grid::Unit' };
coerce Unit,
  from Value,    via { 'Graphics::Grid::Unit'->new($_) },
  from ArrayRef, via { 'Graphics::Grid::Unit'->new($_) };

class_type UnitArithmetic, { class => 'Graphics::Grid::UnitArithmetic' };

declare UnitLike, as ConsumerOf["Graphics::Grid::UnitLike"];
coerce UnitLike,
  from Value,    via { 'Graphics::Grid::Unit'->new($_) },
  from ArrayRef, via { 'Graphics::Grid::Unit'->new($_) };

class_type GPar, { class => 'Graphics::Grid::GPar' };
coerce GPar, from HashRef, via { 'Graphics::Grid::GPar'->new($_) };

class_type Color, { class => 'Graphics::Color::RGB' };
coerce Color, from Str, via {
    if ( $_ =~ /^\#[[:xdigit:]]+$/ ) {
        'Graphics::Color::RGB'->from_hex_string($_);
    }
    else {
        'Graphics::Color::RGB'->from_color_library($_);
    }
};

declare Justification, as ArrayRef [Num], where { @$_ == 2 };
coerce Justification, from Str, via {
    state $mapping;
    unless ($mapping) {
        $mapping = {
            left   => [ 0,   0.5 ],
            top    => [ 0.5, 1 ],
            right  => [ 1,   0.5 ],
            bottom => [ 0.5, 0 ],
            center => [ 0.5, 0.5 ],
            centre => [ 0.5, 0.5 ],
        };
        $mapping->{bottom_left}  = $mapping->{left_bottom}  = [ 0, 0 ];
        $mapping->{top_left}     = $mapping->{left_top}     = [ 0, 1 ];
        $mapping->{bottom_right} = $mapping->{right_bottom} = [ 1, 0 ];
        $mapping->{top_right}    = $mapping->{right_top}    = [ 1, 1 ];
    }

    unless ( exists $mapping->{$_} ) {
        die "invalid justification";
    }