home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Acorn User 10
/
AU_CD10.iso
/
Updates
/
Perl
/
Non-RPC
/
!Perl
/
riscos
/
RISCOS
/
Colour.pm
< prev
next >
Wrap
Text File
|
1999-01-19
|
3KB
|
118 lines
package RISCOS::Colour;
require Exporter;
use strict;
use vars qw (@ISA @EXPORT_OK $VERSION);
@ISA = qw(Exporter);
@EXPORT_OK = qw(pack_colour unpack_colour interpolate_colour);
$VERSION = 0.03;
sub pack_colour {
my @result;
foreach (@_) {
if (ref $_ eq 'ARRAY') {
# (red, green, blue) -> 0xBBGGRR00 (little Endian)
push @result, pack 'xC3', $$_[0], $$_[1], $$_[2]
} elsif (ref $_ eq 'SCALAR') {
push @result, $$_
} else {
push @result, pack ('I', defined ($_) ? $_ : -1);
}
}
wantarray ? @result : $result[0];
}
sub unpack_colour {
return (defined $_[0] and $_[0] ne 'ÿÿÿÿ') ? [unpack ('xC3', $_[0])] : undef
unless wantarray;
map { (defined $_ and $_ ne 'ÿÿÿÿ') ? [unpack ('xC3', $_)] : () } @_;
}
sub interpolate_colour {
my $steps = 0;
my ($start, $end, @result, @step, $add_end);
while (defined ($end = shift)) {
if (ref $end eq 'ARRAY') {
if (defined $start) {
foreach (0..2) {$step[$_] = ($end->[$_] - $start->[$_])
/ $steps;}
$_ = 0;
while ($_ < $steps) {
push @result, [$start->[0] + $step[0] * $_,
$start->[1] + $step[1] * $_,
$start->[2] + $step[2] * $_];
$_++;
}
}
$start = $end;
} else {
$steps = abs $end;
$add_end = $end < 0;
}
}
push @result, [@$start] if $add_end;
@result;
}
1;
__END__
=head1 NAME
RISCOS::Colour -- conversions between S<RISC OS> colour values and arrays
=head1 SYNOPSIS
use RISCOS::Units qw(unpack_colour);
$col = unpack_colour ($packed);
print "Red = $$col[0]; Green = $$col[1]; $Blue = $$col[2]\n";
=head1 DESCRIPTION
This module provides conversion functions between arrays of RGB values
and 32 bit integers used by S<RISC OS> to store colours.
=over 4
=item pack_colour <colour>, ...
C<pack_colour> packs integers or arrays of RGB triples into 4 bytes as used in
blocks passed to S<RISC OS> SWIs. C<undef> maps to -1 ('C<ÿÿÿÿ>') which is used
in DrawFiles to mean transparent, integers are taken to be a single colour of
the form 0xBBGGRR00, scalar references are assumed to be already packed, and
array references are assumed to point to 3 integers (red, green, blue) in the
rage 0 - 255. To convert a single colour call in scalar conted:
$colour = pack_colour [1, 0, 1];
# Pack magenta, passing ref to an anonyomous hash
To convert a list call in list context:
($fore, $back) = pack_colour([0,0,0], [255, 255, 255])
# Black on white
=item unpack_colour <colour>, ...
C<unpack_clour> converts 4 byte colours to arrays of RGB values. When called in
B<scalar context> a single B<array reference> is returned for the first
argument. When called in B<list context> an <array of array references> is
returned.
($fore, $back) = unpack_colour ($fore_raw, $back_raw);
print "Red = $$fore[0]; Green = $$fore[1]; $Blue = $$fore[2]\n";
=back
=head1 BUGS
Not tested enough yet.
=head1 AUTHOR
Nicholas Clark <F<nick@unfortu.net>>
=cut