File Coverage

blib/lib/Image/TextMode/Pixel.pm

Criterion	Covered	Total	%
statement	24	24	100.0
branch	8	8	100.0
condition	2	5	40.0
subroutine	4	4	100.0
pod	1	1	100.0
total	39	42	92.8

package Image::TextMode::Pixel;

use Moo;
use Types::Standard qw( Int );

# Attribute byte constants
my $ATTR_BG_NB = 240;
my $ATTR_BLINK = 128;
my $ATTR_BG    = 112;
my $ATTR_FG    = 15;

has 'char' => ( is => 'rw', isa => sub { die '$_[ 0 ] is not a single character' unless length( $_[ 0 ] ) == 1 } );

has 'fg' => (
    is      => 'rw',
    isa     => Int,
    default => 0,
);

has 'bg' => (
    is      => 'rw',
    isa     => Int,
    default => 0,
);

has 'blink' => (
    is      => 'rw',
    isa     => Int,
    default => 0,
);

=head1 NAME

Image::TextMode::Pixel - A base class to represent a text mode "pixel"

=head1 DESCRIPTION

Represents a "pixel; i.e. a character plus, foreground and background colors and
an blink mode setting.

=head1 ACCESSORS

=over 4

=item * char - The character for the pixel

=item * fg - The foreground palette index

=item * bg - The background palette index

=item * blink - The blink bit

=back

=head1 METHODS

=head2 new( %args )

Creates a new pixel. If you supply an C argument, then it will be
broken down into its components (fg, bg, and blink). By default, blink mode
is off (aka iCEColor is on). Pass a true value for C to enabled
it.

=head2 BUILDARGS( %args )

A Moose override to extract the C key and convert it to components,
should it exist.

=cut

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

    my $options = {};
    if ( @rest % 2 != 0 ) {
        $options = pop @rest;
    }

    my %args = @rest;
    my $attr = delete $args{ attr };

    if ( $attr ) {
        $attr = $class->_attr_to_components( $attr, $options );
        %args = ( %args, %$attr );
    }

    return \%args;
}

sub _attr_to_components {
    my ( $self, $attr, $options ) = @_;
    $options ||= {};
    my $blink = $options->{ blink_mode };
    my %data;

    $data{ fg }    = $attr & $ATTR_FG;
    $data{ bg }    = ( $attr & ( $blink ? $ATTR_BG : $ATTR_BG_NB ) ) >> 4;
    $data{ blink } = ( $attr && $ATTR_BLINK ) >> 7 if $blink;

    return \%data;
}

=head1 AUTHOR

Brian Cassidy [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright 2008-2015 by Brian Cassidy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;