1#========================================================================== 2# Copyright (c) 1995-1998 Martien Verbruggen 3#-------------------------------------------------------------------------- 4# 5# Name: 6# GD::Graph::colour.pm 7# 8# Description: 9# Package of colour manipulation routines, to be used 10# with GD::Graph. 11# 12# $Id: colour.pm,v 1.10 2005/12/14 04:09:40 ben Exp $ 13# 14#========================================================================== 15 16 17package GD::Graph::colour; 18 19($GD::Graph::colour::VERSION) = '$Revision: 1.10 $' =~ /\s([\d.]+)/; 20 21=head1 NAME 22 23GD::Graph::colour - Colour manipulation routines for use with GD::Graph 24 25=head1 SYNOPSIS 26 27use GD::Graph::colour qw(:colours :lists :files :convert); 28 29=head1 DESCRIPTION 30 31The B<GD::Graph::colour> package provides a few routines to work with 32colours. The functionality of this package is mainly defined by what is 33needed, now and historically, by the GD::Graph modules. 34 35=cut 36 37use vars qw( @EXPORT_OK %EXPORT_TAGS ); 38use strict; 39require Exporter; 40use Carp; 41 42@GD::Graph::colour::ISA = qw( Exporter ); 43 44@EXPORT_OK = qw( 45 _rgb _luminance _hue add_colour 46 colour_list sorted_colour_list 47 read_rgb 48 hex2rgb rgb2hex 49); 50%EXPORT_TAGS = ( 51 colours => [qw( add_colour _rgb _luminance _hue )], 52 lists => [qw( colour_list sorted_colour_list )], 53 files => [qw( read_rgb )], 54 convert => [qw( hex2rgb rgb2hex )], 55); 56 57my %RGB = ( 58 white => [0xFF,0xFF,0xFF], 59 lgray => [0xBF,0xBF,0xBF], 60 gray => [0x7F,0x7F,0x7F], 61 dgray => [0x3F,0x3F,0x3F], 62 black => [0x00,0x00,0x00], 63 lblue => [0x00,0x00,0xFF], 64 blue => [0x00,0x00,0xBF], 65 dblue => [0x00,0x00,0x7F], 66 gold => [0xFF,0xD7,0x00], 67 lyellow => [0xFF,0xFF,0x00], 68 yellow => [0xBF,0xBF,0x00], 69 dyellow => [0x7F,0x7F,0x00], 70 lgreen => [0x00,0xFF,0x00], 71 green => [0x00,0xBF,0x00], 72 dgreen => [0x00,0x7F,0x00], 73 lred => [0xFF,0x00,0x00], 74 red => [0xBF,0x00,0x00], 75 dred => [0x7F,0x00,0x00], 76 lpurple => [0xFF,0x00,0xFF], 77 purple => [0xBF,0x00,0xBF], 78 dpurple => [0x7F,0x00,0x7F], 79 lorange => [0xFF,0xB7,0x00], 80 orange => [0xFF,0x7F,0x00], 81 pink => [0xFF,0xB7,0xC1], 82 dpink => [0xFF,0x69,0xB4], 83 marine => [0x7F,0x7F,0xFF], 84 cyan => [0x00,0xFF,0xFF], 85 lbrown => [0xD2,0xB4,0x8C], 86 dbrown => [0xA5,0x2A,0x2A], 87); 88 89=head1 FUNCTIONS 90 91=head2 colour_list( I<number of colours> ) 92 93Returns a list of I<number of colours> colour names known to the package. 94Exported with the :lists tag. 95 96=cut 97 98sub colour_list 99{ 100 my $n = ( $_[0] ) ? $_[0] : keys %RGB; 101 return (keys %RGB)[0 .. $n-1]; 102} 103 104=head2 sorted_colour_list( I<number of colours> ) 105 106Returns a list of I<number of colours> colour names known to the package, 107sorted by luminance or hue. 108B<NB.> Right now it always sorts by luminance. Will add an option in a later 109stage to decide sorting method at run time. 110Exported with the :lists tag. 111 112=cut 113 114sub sorted_colour_list 115{ 116 my $n = $_[0] ? $_[0] : keys %RGB; 117 return (sort by_luminance keys %RGB)[0 .. $n-1]; 118 # return (sort by_hue keys %rgb)[0..$n-1]; 119 120 sub by_luminance { _luminance(@{$RGB{$b}}) <=> _luminance(@{$RGB{$a}}) } 121 sub by_hue { _hue(@{$RGB{$b}}) <=> _hue(@{$RGB{$a}}) } 122} 123 124=head2 _rgb( I<colour name> ) 125 126Returns a list of the RGB values of I<colour name>. if the colour name 127is a string of the form that is acceptable to the hex2rgb sub, then the 128colour will be added to the list dynamically. 129Exported with the :colours tag. 130 131=cut 132 133my %warned_clrs = (); 134 135# return the RGB values of the colour name 136sub _rgb 137{ 138 my $clr = shift or return; 139 140 # Try adding the colour if it doesn't exist yet. It may be of a 141 # parseable form 142 add_colour($clr) unless exists $RGB{$clr}; 143 144 my $rgb_ref = $RGB{$clr}; 145 if (!defined $rgb_ref) 146 { 147 $rgb_ref = $RGB{'black'}; 148 unless ($warned_clrs{$clr}) 149 { 150 $warned_clrs{$clr}++; 151 carp "Colour $clr is not defined, reverting to black"; 152 } 153 }; 154 155 @{$rgb_ref}; 156} 157 158=head2 _hue( I<R,G,B> ) 159 160Returns the hue of the colour with the specified RGB values. 161Exported with the :colours tag. 162 163=head2 _luminance( I<R,G,B> ) 164 165Returns the luminance of the colour with the specified RGB values. 166Exported with the :colours tag. 167 168=cut 169 170# return the luminance of the colour (RGB) 171sub _luminance 172{ 173 (0.212671 * $_[0] + 0.715160 * $_[1] + 0.072169 * $_[2])/0xFF 174} 175 176# return the hue of the colour (RGB) 177sub _hue 178{ 179 ($_[0] + $_[1] + $_[2])/(3 * 0xFF) 180} 181 182=head2 add_colour(colourname => [$r, $g, $b]) or 183add_colour('#7fe310') 184 185Self-explanatory. 186Exported with the :colours tag. 187 188=cut 189 190sub add_colour 191{ 192 my $name = shift; 193 my $val = shift; 194 195 if (!defined $val) 196 { 197 my @rgb = hex2rgb($name) or return; 198 $val = [@rgb]; 199 } 200 201 if (ref $val && ref $val eq 'ARRAY') 202 { 203 $RGB{$name} = [@{$val}]; 204 return $name; 205 } 206 207 return; 208} 209 210=head2 rgb2hex($red, $green, $blue) 211 212=head2 hex2rgb('#7fe310') 213 214These functions translate a list of RGB values into a hexadecimal 215string, as is commonly used in HTML and the Image::Magick API, and vice 216versa. 217Exported with the :convert tag. 218 219=cut 220 221# Color translation 222sub rgb2hex 223{ 224 return unless @_ == 3; 225 my $color = '#'; 226 foreach my $cc (@_) 227 { 228 $color .= sprintf("%02x", $cc); 229 } 230 return $color; 231} 232 233sub hex2rgb 234{ 235 my $clr = shift; 236 my @rgb = $clr =~ /^#([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2})$/i; 237 return unless @rgb; 238 return map { hex $_ } @rgb; 239} 240 241=head2 read_rgb( F<file name> ) 242 243Reads in colours from a rgb file as used by the X11 system. 244 245Doing something like: 246 247 use GD::Graph::bars; 248 use GD::Graph::colour; 249 250 GD::Graph::colour::read_rgb("rgb.txt") or die "cannot read colours"; 251 252Will allow you to use any colours defined in rgb.txt in your graph. 253Exported with the :files tag. 254 255=cut 256 257# 258# Read a rgb.txt file (X11) 259# 260# Expected format of the file: 261# 262# R G B colour name 263# 264# Fields can be separated by any number of whitespace 265# Lines starting with an exclamation mark (!) are comment and 266# will be ignored. 267# 268# returns number of colours read 269 270sub read_rgb($) # (filename) 271{ 272 my $fn = shift; 273 my $n = 0; 274 my $line; 275 276 open(RGB, $fn) or return 0; 277 278 while (defined($line = <RGB>)) 279 { 280 next if ($line =~ /\s*!/); 281 chomp($line); 282 283 # remove leading white space 284 $line =~ s/^\s+//; 285 286 # get the colours 287 my ($r, $g, $b, $name) = split(/\s+/, $line, 4); 288 289 # Ignore bad lines 290 next unless (defined $name); 291 292 $RGB{$name} = [$r, $g, $b]; 293 $n++; 294 } 295 296 close(RGB); 297 298 return $n; 299} 300 301sub version { $GD::Graph::colour::VERSION } 302 303sub dump_colours 304{ 305 my $max = $_[0] ? $_[0] : keys %RGB; 306 my $n = 0; 307 308 my $clr; 309 foreach $clr (sorted_colour_list($max)) 310 { 311 last if $n > $max; 312 print "colour: $clr, " . 313 "${$RGB{$clr}}[0], ${$RGB{$clr}}[1], ${$RGB{$clr}}[2]\n" 314 } 315} 316 317 318"Just another true value"; 319 320__END__ 321 322=head1 PREDEFINED COLOUR NAMES 323 324white, 325lgray, 326gray, 327dgray, 328black, 329lblue, 330blue, 331dblue, 332gold, 333lyellow, 334yellow, 335dyellow, 336lgreen, 337green, 338dgreen, 339lred, 340red, 341dred, 342lpurple, 343purple, 344dpurple, 345lorange, 346orange, 347pink, 348dpink, 349marine, 350cyan, 351lbrown, 352dbrown. 353 354=head1 AUTHOR 355 356Martien Verbruggen E<lt>mgjv@tradingpost.com.auE<gt> 357 358=head2 Copyright 359 360GIFgraph: Copyright (c) 1995-1999 Martien Verbruggen. 361Chart::PNGgraph: Copyright (c) 1999 Steve Bonds. 362GD::Graph: Copyright (c) 1999 Martien Verbruggen. 363 364All rights reserved. This package is free software; you can redistribute 365it and/or modify it under the same terms as Perl itself. 366 367=head1 SEE ALSO 368 369L<GD::Graph>, 370L<GD::Graph::FAQ> 371 372