From f14ac6c3e559ca13ec6af8c4bbbd405d10f62d48 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Wed, 31 May 2017 18:09:08 +0300 Subject: [PATCH] Initial commit --- Changes | 4 + MANIFEST | 6 ++ Makefile.PL | 23 +++++ README | 33 ++++++++ lib/Data/Faker/Colour.pm | 177 +++++++++++++++++++++++++++++++++++++++ t/Data-Faker-Colour.t | 30 +++++++ 6 files changed, 273 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/Data/Faker/Colour.pm create mode 100644 t/Data-Faker-Colour.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..5edf115 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Perl extension Data::Faker::Colour. + +0.001 2017-05-31T16:09+01:00 + - Initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..40c2dd9 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,6 @@ +Changes +Makefile.PL +MANIFEST +README +t/Data-Faker-Colour.t +lib/Data/Faker/Colour.pm diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..3d2845b --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,23 @@ +use ExtUtils::MakeMaker; +use strict; +use warnings; + +WriteMakefile( + NAME => 'Data::Faker::Colour', + VERSION_FROM => 'lib/Data/Faker/Colour.pm', + ABSTRACT_FROM => 'lib/Data/Faker/Colour.pm', + AUTHOR => 'Marius Gavrilescu ', + MIN_PERL_VERSION => '5.14.0', + LICENSE => 'perl', + SIGN => 1, + PREREQ_PM => { + qw/Convert::Color::HSLuv 0 + Data::Faker 0/, + }, + META_ADD => { + dynamic_config => 0, + resources => { + repository => 'https://git.ieval.ro/?p=data-faker-colour.git', + }, + } +); diff --git a/README b/README new file mode 100644 index 0000000..07c610d --- /dev/null +++ b/README @@ -0,0 +1,33 @@ +Data-Faker-Colour version 0.001 +=============================== + +This module is a plugin for Data::Faker for generating random colours. +It uses the HSLuv colour space to permit generation of colours with +specific hue, saturation, or lightness values. One use case would be +generating colour schemes. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + +* Convert::Colour::HSLuv +* Data::Faker + +COPYRIGHT AND LICENCE + +Copyright (C) 2017 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.24.1 or, +at your option, any later version of Perl 5 you may have available. + + diff --git a/lib/Data/Faker/Colour.pm b/lib/Data/Faker/Colour.pm new file mode 100644 index 0000000..50b1929 --- /dev/null +++ b/lib/Data/Faker/Colour.pm @@ -0,0 +1,177 @@ +package Data::Faker::Colour; + +use 5.014000; +use strict; +use warnings; +use parent qw/Data::Faker/; +use Convert::Color::HSLuv; + +our $VERSION = '0.001'; + +sub new { bless {}, shift } # Don't call superclass constructor + +sub ir ($) { int rand $_[0] } + +sub colour { + shift; # drop $self + my $cnt = shift // 1; + my %args = @_; + my @ret; + + for (1 .. $cnt) { + push @ret, [ir 256, ir 256, ir 256] + } + + wantarray ? @ret : $ret[0] +} + +sub colour_hsluv { + shift; # drop $self + my @ret; + my ($cnt, $ch, $cs, $cl) = @_; + $cnt //= 1; + $ch //= -1; + $cs //= -1; + $cl //= -1; + + for (1 .. $cnt) { + my ($h, $s, $l) = ($ch, $cs, $cl); + $h = rand 360 if $h < 0; + $s = rand 100 if $s < 0; + $l = rand 100 if $l < 0; + my @colour = Convert::Color::HSLuv->new($h, $s, $l)->rgb; + for (@colour) { + $_ = int (256 * $_); + $_ = 0 if $_ < 0; + $_ = 255 if $_ > 255; + } + push @ret, \@colour + } + + wantarray ? @ret : $ret[0] +} + +sub to_hex { + my ($rgb) = @_; + sprintf "#%02x%02x%02x", @$rgb +} + +sub to_css { + my ($rgb) = @_; + sprintf 'rgb(%d,%d,%d)', @$rgb +} + +sub colour_hex { map { to_hex $_ } colour @_ } +sub colour_css { map { to_css $_ } colour @_ } +sub colour_hsluv_hex { map { to_hex $_ } colour_hsluv @_ } +sub colour_hsluv_css { map { to_css $_ } colour_hsluv @_ } + +BEGIN { + *color = *colour; + *color_hsluv = *colour_hsluv; + *color_hex = *colour_hex; + *color_hsluv_hex = *colour_hsluv_hex; + *color_css = *colour_css; + *color_hsluv_css = *colour_hsluv_css; + + for my $c (qw/colour color/) { + __PACKAGE__->register_plugin( + "${c}" => \&colour, + "${c}_hsluv" => \&colour_hsluv, + "${c}_hex" => \&colour_hex, + "${c}_hsluv_hex" => \&colour_hsluv_hex, + "${c}_css" => \&colour_css, + "${c}_hsluv_css" => \&colour_hsluv_css, + ); + } +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Data::Faker::Colour - Generate random colours + +=head1 SYNOPSIS + + use Data::Faker::Colour; + + local $, = ' '; + my $f = Data::Faker::Colour->new; + say 'Random colour: ', $f->colour_hex; + say 'Three random colours of 60% lightness: ', + $f->colour_hsluv_hex(3, -1, -1, 60); + say 'A colour with 70% saturation, in CSS format: ', + $f->colour_hsluv_css(1, -1, 70); + say '5 colours with hue 120 and lightness 45%: ', + $f->colour_hsluv_hex(5, 150, -1, 45); + +=head1 DESCRIPTION + +This module is a plugin for Data::Faker for generating random colours. +It uses the HSLuv colour space to permit generation of colours with +specific hue, saturation, or lightness values. One use case would be +generating colour schemes. + +It is recommended to use this without Data::Faker, as Data::Faker does +not currently pass arguments to methods. + +=head1 DATA PROVIDERS + +=over + +=item B([I<$cnt>]) + +Generate I<$cnt> (default 1) random colours. +Returns a list of 3-element arrayrefs, representing the R, G, and B +components, each ranging 0-255. + +=item B([I<$cnt>]) + +As above, but returns a list of strings like C<#rrggbb>. + +=item B([I<$cnt>]) + +As above, but returns a list of strings like C. + +=item B([I<$cnt>, I<$H>, I<$S>, I<$L>]) + +Generates I<$cnt> (default 1) random colours using the HSLuv colour +space. You can specify your desired hue, saturation and/or lightness, +and all generated colours will have that hue/saturation/lightness. + +Set I<$H>, I<$S>, I<$L> to a positive value to request a specific +hue/saturation/lightness, or to -1 for a randomly chosen one. They all +default to -1. + +=item B([I<$cnt>, I<$H>, I<$S>, I<$L>]) + +=item B([I<$cnt>, I<$H>, I<$S>, I<$L>]) + +As above but with hex/css output. + +=back + +C can be substituted for C in any of the methods above. + +=head1 SEE ALSO + +L, L, L + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@ieval.roE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2017 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.24.1 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/t/Data-Faker-Colour.t b/t/Data-Faker-Colour.t new file mode 100644 index 0000000..898be9e --- /dev/null +++ b/t/Data-Faker-Colour.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Test::More tests => 8; +BEGIN { use_ok('Data::Faker::Colour') } + +sub valid{ + my $expected = shift; + return unless $expected == @_; + my $ret = 1; + for my $colour (@_) { + $ret &&= 0 <= $colour->[$_] && $colour->[$_] <= 255 for 0, 1, 2; + } + $ret +} + +note 'These tests only check if the generated colours are valid. They don\'t check whether the colours have the requested hue, saturation or lightness'; + +my $f = Data::Faker::Colour->new; + +ok valid (1, $f->colour), 'colour'; +ok valid (5, $f->color(5)), 'color(5)'; + +ok valid (1, $f->colour_hsluv), 'colour_hsluv'; +ok valid (200, $f->colour_hsluv(200, 10)), 'colour_hsluv(200, 10)'; +ok valid (200, $f->colour_hsluv(200, -1, 10)), 'colour_hsluv(200, -1, 10)'; +ok valid (200, $f->colour_hsluv(200, -1, -1, 10)), 'colour_hsluv(200, -1, -1, 10)'; + +ok valid (2000, $f->colour_hsluv(2000, -1, 100, 40)), 'colour_hsluv(2000, -1, 100, 40)'; -- 2.30.2