view release on metacpan or  search on metacpan

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

    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 {
    my $self = shift;
    return $self->{colour};
}

sub add {
    my $self   = shift;
    my $add    = shift;
    my $factor = shift;
    $factor = 1 unless defined $factor;

    my $colour = $self->colour;

    throw Error::Simple("Colour $colour is unknown")
        unless exists $r{$colour};
    throw Error::Simple("Colour $add is unknown")
        unless exists $r{$add};

    my ( $r1, $g1, $b1 ) = ( $r{$colour}, $g{$colour}, $b{$colour} );
    my ( $r2, $g2, $b2 ) = ( $r{$add},    $g{$add},    $b{$add} );
    $r1 += $r2 * $factor;
    $g1 += $g2 * $factor;
    $b1 += $b2 * $factor;
    $r1 = 1 if $r1 > 1;
    $g1 = 1 if $g1 > 1;
    $b1 = 1 if $b1 > 1;
    my $closest = $self->_closest( $r1, $g1, $b1 );
    $self->{colour} = $closest;
}

sub mix {
    my $self   = shift;
    my $add    = shift;
    my $factor = shift;
    $factor = 1 unless defined $factor;

    my $colour = $self->colour;

    throw Error::Simple("Colour $colour is unknown")
        unless exists $r{$colour};
    throw Error::Simple("Colour $add is unknown")
        unless exists $r{$add};