File Coverage

blib/lib/Convert/Color/VGA.pm
Criterion Covered Total %
statement 29 30 96.6
branch 5 8 62.5
condition 3 6 50.0
subroutine 7 7 100.0
pod 3 3 100.0
total 47 54 87.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2009-2022 -- leonerd@leonerd.org.uk
5              
6             package Convert::Color::VGA 0.17;
7              
8 10     10   228155 use v5.14;
  10         46  
9 10     10   64 use warnings;
  10         17  
  10         303  
10 10     10   53 use base qw( Convert::Color::RGB );
  10         19  
  10         1555  
11              
12             __PACKAGE__->register_color_space( 'vga' );
13              
14 10     10   68 use Carp;
  10         30  
  10         4688  
15              
16             =head1 NAME
17              
18             C - named lookup for the basic VGA colors
19              
20             =head1 SYNOPSIS
21              
22             Directly:
23              
24             use Convert::Color::VGA;
25              
26             my $red = Convert::Color::VGA->new( 'red' );
27              
28             # Can also use index
29             my $black = Convert::Color::VGA->new( 0 );
30              
31             Via L:
32              
33             use Convert::Color;
34              
35             my $cyan = Convert::Color->new( 'vga:cyan' );
36              
37             =head1 DESCRIPTION
38              
39             This subclass of L provides predefined colors for the 8
40             basic VGA colors. Their names are
41              
42             black
43             red
44             green
45             yellow
46             blue
47             magenta
48             cyan
49             white
50              
51             They may be looked up either by name, or by numerical index within this list.
52              
53             =cut
54              
55             my %vga_colors = (
56             black => [ 0, 0, 0 ],
57             red => [ 1, 0, 0 ],
58             green => [ 0, 1, 0 ],
59             yellow => [ 1, 1, 0 ],
60             blue => [ 0, 0, 1 ],
61             magenta => [ 1, 0, 1 ],
62             cyan => [ 0, 1, 1 ],
63             white => [ 1, 1, 1 ],
64             );
65              
66             # Also indexes
67             my @vga_colors = qw(
68             black red green yellow blue magenta cyan white
69             );
70              
71             __PACKAGE__->register_palette(
72             enumerate_once => sub {
73             my $class = shift;
74             map { $class->new( $_ ) } @vga_colors;
75             },
76             );
77              
78             =head1 CONSTRUCTOR
79              
80             =cut
81              
82             =head2 new
83              
84             $color = Convert::Color::VGA->new( $name )
85              
86             Returns a new object to represent the named color.
87              
88             $color = Convert::Color::VGA->new( $index )
89              
90             Returns a new object to represent the color at the given index.
91              
92             =cut
93              
94             sub new
95             {
96 11     11 1 111 my $class = shift;
97              
98 11 50       27 if( @_ == 1 ) {
99 11         15 my ( $name, $index );
100              
101 11 100       35 if( $_[0] =~ m/^\d+$/ ) {
102 1         3 $index = $_[0];
103 1 50 33     7 $index >= 0 and $index < @vga_colors or
104             croak "No such VGA color at index $index";
105              
106 1         4 $name = $vga_colors[$index];
107             }
108             else {
109 10         15 $name = $_[0];
110 10   66     59 $vga_colors[$_] eq $name and ( $index = $_, last ) for 0 .. 7;
111 10 50       23 defined $index or croak "No such VGA color named '$name'";
112             }
113              
114 11         18 my $self = $class->SUPER::new( @{ $vga_colors{$name} } );
  11         55  
115              
116 11         38 $self->[3] = $index;
117              
118 11         30 return $self;
119             }
120             else {
121 0         0 croak "usage: Convert::Color::VGA->new( NAME ) or ->new( INDEX )";
122             }
123             }
124              
125             =head1 METHODS
126              
127             =cut
128              
129             =head2 index
130              
131             $index = $color->index
132              
133             The index of the VGA color.
134              
135             =cut
136              
137             sub index
138             {
139 6     6 1 12 my $self = shift;
140 6         31 return $self->[3];
141             }
142              
143             =head2 name
144              
145             $name = $color->name
146              
147             The name of the VGA color.
148              
149             =cut
150              
151             sub name
152             {
153 3     3 1 23 my $self = shift;
154 3         8 return $vga_colors[$self->index];
155             }
156              
157             =head1 SEE ALSO
158              
159             =over 4
160              
161             =item *
162              
163             L - color space conversions
164              
165             =back
166              
167             =head1 AUTHOR
168              
169             Paul Evans
170              
171             =cut
172              
173             0x55AA;