File Coverage

blib/lib/App/Greple/subst/dyncmap.pm

Criterion	Covered	Total	%
statement	17	54	31.4
branch	0	18	0.0
condition	0	3	0.0
subroutine	6	13	46.1
pod	0	4	0.0
total	23	92	25.0

=encoding utf-8

=head1 NAME

-Msubst::dyncmap - Getopt::EX Dynamic colormap module

=head1 SYNOPSIS

  option --subst-color-light \
    -Msubst::dyncmap \
    --colormap \
    --dyncmap \
    range=0-2,except=000:111:222,shift=3,even="555D/%s",odd="I;000/%s"

=head1 DESCRIPTION

Parameter is given in a form of B<name>=I<value> and connected by
comma.

=over 7

=item B<range>=I<s>-I<e>[:I<s>-I<e>[:I<s>-I<e>]]

RGB range. All range can be given like C<0-2:0-2:0-2>, or if the
number of range is less than three, last range is repeated.

Each RGB value is in the range of 0 to 5, and produces 6x6x6 216
colors.

=item B<except>

Specify exception value, like C<000:111:222>.

=item B<even>=I<colormap>

=item B<odd>=I<colormap>

Colormap string for even and odd index.  String is given to C<sprintf>
function with RGB parameter.

=item B<shift>=I<number>

Range is shifted by this value for odd index map.  Shifted value have
to be in the range of 0 to 5.

=item B<sort>=[I<none>,I<average>,I<luminance>]

Specify sort algorithm.  Default is B<average>.

=item B<reverse>=[0,1]

If true, map is reversed.

=back

=head1 SEE ALSO

L<Getopt::EX>, L<Getopt::EX::Colormap>

L<App::Greple>, L<App::Greple::subst>

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright 2020-2021 Kazumasa Utashiro.

You can redistribute it and/or modify it under the same terms
as Perl itself.

=cut

package App::Greple::subst::dyncmap;

use v5.14;
use strict;
use warnings;

use Carp;
use Data::Dumper;
use List::Util qw(notall pairmap reduce sum);

##
## Dyamic colormap generator
##

sub dyncmap {
    my %opt = @_;
    for ($opt{range}) {
	my @range = pairmap { [ $a..$b ] } /([0-5])-([0-5])/g
	    or die "$_: range format error";
	push @range, $range[-1] while @range < 3;
	$_ = \@range;
    }
    my @cm = cmap(%opt);
    join ',', @cm;
}

sub combination {
    my $c = reduce {
	[ map { my @a = @$_; map { [ @a, $_ ] } @$b } @$a ];
    } [ [] ], @_;
    @$c;
}

sub rgb {
    if (notall { 0 <= $_ && $_ <= 5 } @_) {
	local $" = '';
	die "@_: Invalid RGB value";
    }
    my($r, $g, $b) = @_;
    if ($r == $g and $r == $b) {
	qw(L03 L07 L11 L15 L19 L23)[$r];
    } else {
	"$r$g$b";
    }
}

my %sort = (
    none => undef,
    average => sub {
	local $" = '';
	map  { $_->[0] }
	sort { $a->[1] <=> $b->[1] || $a->[2] cmp $b->[2] }
	map  { [ $_, sum(@$_), "@$_" ] }
	@_;
    },
    luminance => sub {
	map  { $_->[0] }
	sort { $a->[1] <=> $b->[1] }
	map  { [ $_, $$_[0]*30 + $$_[1]*59 + $$_[2]*11 ] }
	@_;
    },
    );

sub cmap {
    my %opt = (shift => 0, except => '', sort => 'average', @_);
    my @cm = combination @{$opt{range}};
    if (my %except = map { $_ => 1 } $opt{except} =~ /\b(\d\d\d)\b/g) {
	local $" = '';
	@cm = grep { not $except{"@$_"} } @cm;
    }
    if (my $algorithm = $opt{sort}) {
	exists $sort{$algorithm} or die "$algorithm: unknown algorithm";
	if (my $sort = $sort{$algorithm}) {
	    @cm = $sort->(@cm);
	}
    }
    @cm = reverse @cm if $opt{reverse};
    my @map = map {
	( sprintf($opt{even}, rgb(@$_) ),
	  sprintf($opt{odd},  rgb(map $_ + $opt{shift}, @$_) ) );
    } @cm;
}

1;

__DATA__

mode function

option --dyncmap &dyncmap($<shift>)