File Coverage

blib/lib/Image/TextMode/Pixel.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


line stmt bran cond sub pod time code
1             package Image::TextMode::Pixel;
2              
3 1     1   1245 use Moose;
  0            
  0            
4             use Moose::Util::TypeConstraints;
5              
6             subtype 'Image::TextMode::Pixel::Char' => as 'Str' =>
7             where { length( $_ ) == 1 };
8              
9             # Attribute byte constants
10             my $ATTR_BG_NB = 240;
11             my $ATTR_BLINK = 128;
12             my $ATTR_BG = 112;
13             my $ATTR_FG = 15;
14              
15             has 'char' => ( is => 'rw', isa => 'Image::TextMode::Pixel::Char' );
16              
17             has 'fg' => (
18             is => 'rw',
19             isa => 'Int',
20             default => 0,
21             );
22              
23             has 'bg' => (
24             is => 'rw',
25             isa => 'Int',
26             default => 0,
27             );
28              
29             has 'blink' => (
30             is => 'rw',
31             isa => 'Int',
32             default => 0,
33             );
34              
35             =head1 NAME
36              
37             Image::TextMode::Pixel - A base class to represent a text mode "pixel"
38              
39             =head1 DESCRIPTION
40              
41             Represents a "pixel; i.e. a character plus, foreground and background colors and
42             an blink mode setting.
43              
44             =head1 ACCESSORS
45              
46             =over 4
47              
48             =item * char - The character for the pixel
49              
50             =item * fg - The foreground palette index
51              
52             =item * bg - The background palette index
53              
54             =item * blink - The blink bit
55              
56             =back
57              
58             =head1 METHODS
59              
60             =head2 new( %args )
61              
62             Creates a new pixel. If you supply an C<attr> argument, then it will be
63             broken down into its components (fg, bg, and blink). By default, blink mode
64             is off (aka iCEColor is on). Pass a true value for C<blink_mode> to enabled
65             it.
66              
67             =head2 BUILDARGS( %args )
68              
69             A Moose override to extract the C<attr> key and convert it to components,
70             should it exist.
71              
72             =cut
73              
74             sub BUILDARGS {
75             my ( $class, @rest ) = @_;
76              
77             my $options = {};
78             if ( @rest % 2 != 0 ) {
79             $options = pop @rest;
80             }
81              
82             my %args = @rest;
83             my $attr = delete $args{ attr };
84              
85             if ( $attr ) {
86             $attr = $class->_attr_to_components( $attr, $options );
87             %args = ( %args, %$attr );
88             }
89              
90             return \%args;
91             }
92              
93             sub _attr_to_components {
94             my ( $self, $attr, $options ) = @_;
95             $options ||= {};
96             my $blink = $options->{ blink_mode };
97             my %data;
98              
99             $data{ fg } = $attr & $ATTR_FG;
100             $data{ bg } = ( $attr & ( $blink ? $ATTR_BG : $ATTR_BG_NB ) ) >> 4;
101             $data{ blink } = ( $attr && $ATTR_BLINK ) >> 7 if $blink;
102              
103             return \%data;
104             }
105              
106             no Moose;
107              
108             __PACKAGE__->meta->make_immutable;
109              
110             =head1 AUTHOR
111              
112             Brian Cassidy E<lt>bricas@cpan.orgE<gt>
113              
114             =head1 COPYRIGHT AND LICENSE
115              
116             Copyright 2008-2013 by Brian Cassidy
117              
118             This library is free software; you can redistribute it and/or modify
119             it under the same terms as Perl itself.
120              
121             =cut
122              
123             1;