view release on metacpan or  search on metacpan

lib/Acme/Colour.pm  view on Meta::CPAN

package Acme::Colour;
use strict;
use warnings;
use Error;
use Graphics::ColorNames;
use List::Util qw(max min);
use vars qw($VERSION);

$VERSION = '1.06';

use overload
    '""' => \&colour,
    '+'  => \&_oadd,
    '-'  => \&_osub;

my ( %r, %g, %b );

sub import {
    my $class = shift;
    my $hash  = {@_};

    $class->_build_colours();

    if ( $hash->{constants} ) {
        overload::constant( 'q' => \&_createnew );
    } else {

        # do nothing for now
    }
}

sub _build_colours {
    my $class = shift;

    if ( scalar( keys %r ) == 0 ) {
        tie my %COLOURS, 'Graphics::ColorNames', 'X';

        foreach my $colour ( keys %COLOURS ) {
            next if $colour =~ /\d/;
            my ( $r, $g, $b )
                = map { hex($_) / 255 }
                ( $COLOURS{$colour}
                    =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i
                );
            $r{$colour} = $r;
            $g{$colour} = $g;
            $b{$colour} = $b;

            #    print "$colour: $r/$g/$b\n";
        }
    }
}

sub _createnew {
    my $colour = shift;
    my $interp = shift;

    if ( exists $r{$interp} ) {
        return Acme::Colour->new($interp);
    } else {
        return $interp;
    }
}

sub _oadd {
    my $a = shift;
    my $b = shift;
    $a->add($b);
    return $a;
}

sub _osub {
    my $a = shift;
    my $b = shift;
    $a->mix($b);
    return $a;
}

sub new {
    my ( $class, $colour ) = @_;

    my $self = {};
    bless $self, $class;

    if ( defined $colour ) {
        unless ( exists $r{$colour} ) {
            throw Error::Simple("Colour $colour is unknown");
        }
        $self->{colour} = $colour;
    } else {
        $self->{colour} = $self->default;
    }

    return $self;
}

sub default {
    return "white";
}

sub colour {