lib/Data/Faker/Colour.pm

   1 package Data::Faker::Colour;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6 use parent qw/Data::Faker/;
   7 use Convert::Color::HSLuv;
   8
   9 our $VERSION = '0.001';
  10
  11 sub new { bless {}, shift } # Don't call superclass constructor
  12
  13 sub ir ($) { int rand $_[0] }
  14
  15 sub colour {
  16         shift; # drop $self
  17         my $cnt = shift // 1;
  18         my %args = @_;
  19         my @ret;
  20
  21         for (1 .. $cnt) {
  22                 push @ret, [ir 256, ir 256, ir 256]
  23         }
  24
  25         wantarray ? @ret : $ret[0]
  26 }
  27
  28 sub colour_hsluv {
  29         shift; # drop $self
  30         my @ret;
  31         my ($cnt, $ch, $cs, $cl) = @_;
  32         $cnt //= 1;
  33         $ch  //= -1;
  34         $cs  //= -1;
  35         $cl  //= -1;
  36
  37         for (1 .. $cnt) {
  38                 my ($h, $s, $l) = ($ch, $cs, $cl);
  39                 $h = rand 360 if $h < 0;
  40                 $s = rand 100 if $s < 0;
  41                 $l = rand 100 if $l < 0;
  42                 my @colour = Convert::Color::HSLuv->new($h, $s, $l)->rgb;
  43                 for (@colour) {
  44                         $_ = int (256 * $_);
  45                         $_ = 0 if $_ < 0;
  46                         $_ = 255 if $_ > 255;
  47                 }
  48                 push @ret, \@colour
  49         }
  50
  51         wantarray ? @ret : $ret[0]
  52 }
  53
  54 sub to_hex {
  55         my ($rgb) = @_;
  56         sprintf "#%02x%02x%02x", @$rgb
  57 }
  58
  59 sub to_css {
  60         my ($rgb) = @_;
  61         sprintf 'rgb(%d,%d,%d)', @$rgb
  62 }
  63
  64 sub colour_hex       { map { to_hex $_ } colour @_ }
  65 sub colour_css       { map { to_css $_ } colour @_ }
  66 sub colour_hsluv_hex { map { to_hex $_ } colour_hsluv @_ }
  67 sub colour_hsluv_css { map { to_css $_ } colour_hsluv @_ }
  68
  69 BEGIN {
  70         *color           = *colour;
  71         *color_hsluv     = *colour_hsluv;
  72         *color_hex       = *colour_hex;
  73         *color_hsluv_hex = *colour_hsluv_hex;
  74         *color_css       = *colour_css;
  75         *color_hsluv_css = *colour_hsluv_css;
  76
  77         for my $c (qw/colour color/) {
  78                 __PACKAGE__->register_plugin(
  79                         "${c}"           => \&colour,
  80                         "${c}_hsluv"     => \&colour_hsluv,
  81                         "${c}_hex"       => \&colour_hex,
  82                         "${c}_hsluv_hex" => \&colour_hsluv_hex,
  83                         "${c}_css"       => \&colour_css,
  84                         "${c}_hsluv_css" => \&colour_hsluv_css,
  85                 );
  86         }
  87 }
  88
  89 1;
  90 __END__
  91
  92 =encoding utf-8
  93
  94 =head1 NAME
  95
  96 Data::Faker::Colour - Generate random colours
  97
  98 =head1 SYNOPSIS
  99
 100   use Data::Faker::Colour;
 101
 102   local $, = ' ';
 103   my $f = Data::Faker::Colour->new;
 104   say 'Random colour: ', $f->colour_hex;
 105   say 'Three random colours of 60% lightness: ',
 106       $f->colour_hsluv_hex(3, -1, -1, 60);
 107   say 'A colour with 70% saturation, in CSS format: ',
 108       $f->colour_hsluv_css(1, -1, 70);
 109   say '5 colours with hue 120 and lightness 45%: ',
 110       $f->colour_hsluv_hex(5, 150, -1, 45);
 111
 112 =head1 DESCRIPTION
 113
 114 This module is a plugin for Data::Faker for generating random colours.
 115 It uses the HSLuv colour space to permit generation of colours with
 116 specific hue, saturation, or lightness values. One use case would be
 117 generating colour schemes.
 118
 119 It is recommended to use this without Data::Faker, as Data::Faker does
 120 not currently pass arguments to methods.
 121
 122 =head1 DATA PROVIDERS
 123
 124 =over
 125
 126 =item B<colour>([I<$cnt>])
 127
 128 Generate I<$cnt> (default 1) random colours.
 129 Returns a list of 3-element arrayrefs, representing the R, G, and B
 130 components, each ranging 0-255.
 131
 132 =item B<colour_hex>([I<$cnt>])
 133
 134 As above, but returns a list of strings like C<#rrggbb>.
 135
 136 =item B<colour_css>([I<$cnt>])
 137
 138 As above, but returns a list of strings like C<rgb(r, g, b)>.
 139
 140 =item B<colour_hsluv>([I<$cnt>, I<$H>, I<$S>, I<$L>])
 141
 142 Generates I<$cnt> (default 1) random colours using the HSLuv colour
 143 space. You can specify your desired hue, saturation and/or lightness,
 144 and all generated colours will have that hue/saturation/lightness.
 145
 146 Set I<$H>, I<$S>, I<$L> to a positive value to request a specific
 147 hue/saturation/lightness, or to -1 for a randomly chosen one. They all
 148 default to -1.
 149
 150 =item B<colour_hsluv_hex>([I<$cnt>, I<$H>, I<$S>, I<$L>])
 151
 152 =item B<colour_hsluv_css>([I<$cnt>, I<$H>, I<$S>, I<$L>])
 153
 154 As above but with hex/css output.
 155
 156 =back
 157
 158 C<color> can be substituted for C<colour> in any of the methods above.
 159
 160 =head1 SEE ALSO
 161
 162 L<Data::Faker>, L<Convert::Colour>, L<Convert::Colour::HSLuv>
 163
 164 =head1 AUTHOR
 165
 166 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 167
 168 =head1 COPYRIGHT AND LICENSE
 169
 170 Copyright (C) 2017 by Marius Gavrilescu
 171
 172 This library is free software; you can redistribute it and/or modify
 173 it under the same terms as Perl itself, either Perl version 5.24.1 or,
 174 at your option, any later version of Perl 5 you may have available.
 175
 176
 177 =cut