# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2009-2011 -- leonerd@leonerd.org.uk
package Convert::Color::VGA;
use strict;
use warnings;
use base qw( Convert::Color::RGB );
__PACKAGE__->register_color_space( 'vga' );
use Carp;
our $VERSION = '0.09';
=head1 NAME
C<Convert::Color::VGA> - named lookup for the basic VGA colors
=head1 SYNOPSIS
Directly:
use Convert::Color::VGA;
my $red = Convert::Color::VGA->new( 'red' );
# Can also use index
my $black = Convert::Color::VGA->new( 0 );
Via L<Convert::Color>:
use Convert::Color;
my $cyan = Convert::Color->new( 'vga:cyan' );
=head1 DESCRIPTION
This subclass of L<Convert::Color::RGB> provides predefined colors for the 8
basic VGA colors. Their names are
black
red
green
yellow
blue
magenta
cyan
white
They may be looked up either by name, or by numerical index within this list.
=cut
my %vga_colors = (
black => [ 0, 0, 0 ],
red => [ 1, 0, 0 ],
green => [ 0, 1, 0 ],
yellow => [ 1, 1, 0 ],
blue => [ 0, 0, 1 ],
magenta => [ 1, 0, 1 ],
cyan => [ 0, 1, 1 ],
white => [ 1, 1, 1 ],
);
# Also indexes
my @vga_colors = qw(
black red green yellow blue magenta cyan white
);
__PACKAGE__->register_palette(
enumerate_once => sub {
my $class = shift;
map { $class->new( $_ ) } @vga_colors;
},
);
=head1 CONSTRUCTOR
=cut
=head2 $color = Convert::Color::VGA->new( $name )
Returns a new object to represent the named color.
=head2 $color = Convert::Color::VGA->new( $index )
Returns a new object to represent the color at the given index.
=cut
sub new
{
my $class = shift;
if( @_ == 1 ) {
my ( $name, $index );
if( $_[0] =~ m/^\d+$/ ) {
$index = $_[0];
$index >= 0 and $index < @vga_colors or
croak "No such VGA color at index $index";
$name = $vga_colors[$index];
}
else {
$name = $_[0];
$vga_colors[$_] eq $name and ( $index = $_, last ) for 0 .. 7;
defined $index or croak "No such VGA color named '$name'";
}
my $self = $class->SUPER::new( @{ $vga_colors{$name} } );
$self->[3] = $index;
return $self;
}
else {
croak "usage: Convert::Color::VGA->new( NAME ) or ->new( INDEX )";
}
}
=head1 METHODS
=cut
=head2 $index = $color->index
The index of the VGA color.
=cut
sub index
{
my $self = shift;
return $self->[3];
}
=head2 $name = $color->name
The name of the VGA color.
=cut
sub name
{
my $self = shift;
return $vga_colors[$self->index];
}
=head1 SEE ALSO
=over 4
=item *
L<Convert::Color> - color space conversions
=back
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
0x55AA;