Acme-Colour

 view release on metacpan or  search on metacpan

CHANGES  view on Meta::CPAN

        - renamed private methods to start with _
        - documented the default method
        - increased test coverage to 100%

1.01 Fri May 14 16:21:26 BST 2004
	- regenerated with new Module::Build, which means the
	  Makefile.PL now contains Test::Exception

1.00 Sun Sep 28 17:50:26 BST 2003
	- moved to Module::Build
	- throw exceptions using Error when given unknown colours

0.20 Tue Aug 20 19:35:23 BST 2002
	- require 5.6.1 as it runs out of memory for some
          reason on 5.005_003 (spotted by Daniel)

0.19 Tue Jul  2 11:31:32 BST 2002
	- Fix minor warning

0.18 Mon Jun 17 15:33:38 GMT 2002
	- Minor doc patch and support for colour constants

README  view on Meta::CPAN

      my $yellow = $red + $green; # add()s the two colours

      my $cyan = "cyan";           # now an Acme::Colour object
      my $magenta = "magenta";     # likewise
      my $blue = $cyan - $magenta; # mix()es the two colours

NOTES
    A good explanation of colour and colour mixing is available at:
    http://www.photoshopfocus.com/cool_tips/tips_color_basics_p1.htm

    This module throws an exception upon unknown colours.

    No, "colour" is not a typo.

AUTHOR
    Leon Brocard <acme@astray.com>

COPYRIGHT
    Copyright (C) 2002-3, Leon Brocard

    This module is free software; you can redistribute it or modify it under

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

}

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 {

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;

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

}

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;

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

  my $cyan = "cyan";           # now an Acme::Colour object
  my $magenta = "magenta";     # likewise
  my $blue = $cyan - $magenta; # mix()es the two colours

=head1 NOTES

A good explanation of colour and colour mixing is available at:
http://www.photoshopfocus.com/cool_tips/tips_color_basics_p1.htm

This module throws an exception upon unknown colours.

No, "colour" is not a typo.

=head1 AUTHOR

Leon Brocard E<lt>F<acme@astray.com>E<gt>

=head1 COPYRIGHT

Copyright (C) 2002-3, Leon Brocard

t/simple.t  view on Meta::CPAN

my $yellow = $red + $green;
is($yellow->colour, "yellow"->colour, "red and green make yellow");

my $cyan = "cyan";
my $magenta = "magenta";
my $blue = $cyan - $magenta;
is($blue->colour, "blue"->colour, "cyan and magenta make blue");

# Now let's test the errors

throws_ok {$c = Acme::Colour->new("bogus1")} qr/Colour bogus1 is unknown/;

# We have to monkey about on the insides to test this
$c->{colour} = "bogus2";
throws_ok {$c->add("bogus3")} qr/Colour bogus2 is unknown/;
$c->{colour} = "red";

throws_ok {$c->add("bogus4")} qr/Colour bogus4 is unknown/;

# We have to monkey about on the insides to test this
$c->{colour} = "bogus5";
throws_ok {$c->mix("bogus6")} qr/Colour bogus5 is unknown/;
$c->{colour} = "red";

throws_ok {$c->mix("bogus7")} qr/Colour bogus7 is unknown/;