view release on metacpan or  search on metacpan

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

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};

    my ( $r1, $g1, $b1 ) = ( $r{$colour}, $g{$colour}, $b{$colour} );
    my ( $r2, $g2, $b2 ) = ( $r{$add},    $g{$add},    $b{$add} );

    ( $r1, $g1, $b1 ) = ( 1 - $r1, 1 - $g1, 1 - $b1 );
    ( $r2, $g2, $b2 ) = ( 1 - $r2, 1 - $g2, 1 - $b2 );

    $r1 += $r2 * $factor;
    $g1 += $g2 * $factor;
    $b1 += $b2 * $factor;
    $r1 = 1 if $r1 > 1;
    $g1 = 1 if $g1 > 1;
    $b1 = 1 if $b1 > 1;

    ( $r1, $g1, $b1 ) = ( 1 - $r1, 1 - $g1, 1 - $b1 );

    my $closest = $self->_closest( $r1, $g1, $b1 );
    $self->{colour} = $closest;
}

sub _closest {
    my ( $self, $r1, $g1, $b1 ) = @_;

    my $bestdelta = 100;
    my $closest;
    foreach my $colour ( sort keys %r ) {
        my ( $r2, $g2, $b2 ) = ( $r{$colour}, $g{$colour}, $b{$colour} );
        my $delta
            = sqrt( ( $r1 - $r2 )**2 + ( $g1 - $g2 )**2 + ( $b1 - $b2 )**2 );
        if ( $delta < $bestdelta ) {
            $closest   = $colour;
            $bestdelta = $delta;
        }
    }
    return $closest;
}

1;

__END__

=head1 NAME

Acme::Colour - additive and subtractive human-readable colours

=head1 SYNOPSIS

  # light
  $c = Acme::Colour->new("black");
  $colour = $c->colour; # black
  $c->add("red");   # $c->colour now red
  $c->add("green"); # $c->colour now yellow

  # pigment
  $c = Acme::Colour->new("white");
  $c->mix("cyan");    # $c->colour now cyan
  $c->mix("magenta"); # $c->colour now blue

=head1 DESCRIPTION

The Acme::Colour module mixes colours with human-readable names.

There are two types of colour mixing: the mixing of lights and the
mixing of pigments. If one take two differently coloured beams of
light and projects them on to a screen, the mixing of these lights
occurs according to the principle of additive colour mixing. If one
mixes two differently coloured paints they mix according to the
principle of subtractive colour mixing.

=head1 METHODS

=head2 new()

The new() method creates a new colour. It takes an optional argument
which is the initial colour used:

  $c = Acme::Colour->new("black");

=head2 colour()

The colour() method returns the current colour. Note that
stringification of the colour object magically returns the colour too:

  $colour = $c->colour; # black
  print "The colour is $c!\n";

=head2 add()

The add() method performs additive mixing on the colour. It takes in
the colour to add in:

  $c->add("red");