File Coverage

blib/lib/Term/ANSIColor/Concise/Table.pm

Criterion	Covered	Total	%
statement	20	72	27.7
branch	0	2	0.0
condition	0	2	0.0
subroutine	7	14	50.0
pod	4	5	80.0
total	31	95	32.6

# -*- indent-tabs-mode: nil -*-

package Term::ANSIColor::Concise::Table;

our $VERSION = "3.02";

use v5.14;
use utf8;

use Exporter 'import';
our @EXPORT      = qw();
our @EXPORT_OK   = qw(
    colortable colortable6 colortable12 colortable24
    );
our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);

use Carp;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

use Term::ANSIColor::Concise qw(ansi_color map_to_256);
use List::Util qw(min);

sub colortable6 {
    colortableN(
        step   => 6,
        string => "    ",
        line   => 2,
        x => 1, y => 1, z => 1,
        @_
        );
}

sub colortable12 {
    colortableN(
        step   => 12,
        string => "  ",
        x => 1, y => 1, z => 2,
        @_
        );
}

# use charnames ':full';

sub colortable24 {
    colortableN(
        step   => 24,
        string => "\N{U+2580}", # "\N{UPPER HALF BLOCK}",
        shift  => 1,
        x => 1, y => 2, z => 4,
        @_
        );
}

sub colortableN {
    my %arg = (
        shift => 0,
        line  => 1,
        row   => 3,
        @_);
    my @combi = do {
        my @default = qw( XYZ YZX ZXY  YXZ XZY ZYX );
        if (my @s = $arg{row} =~ /[xyz]{3}/ig) {
            @s;
        } else {
            @default[0 .. $arg{row} - 1];
        }
    };
    my @order = map {
        my @ord = map { { X=>0, Y=>1, Z=>2 }->{$_} } /[XYZ]/g;
        sub { @_[@ord] }
    } map { uc } @combi;
    binmode STDOUT, ":utf8";
    for my $order (@order) {
        my $rgb = sub {
            sprintf "#%02x%02x%02x",
                map { map_to_256($arg{step}, $_) } $order->(@_);
        };
        for (my $y = 0; $y < $arg{step}; $y += $arg{y}) {
            my @out;
            for (my $z = 0; $z < $arg{step}; $z += $arg{z}) {
                for (my $x = 0; $x < $arg{step}; $x += $arg{x}) {
                    my $fg = $rgb->($x, $y, $z);
                    my $bg = $rgb->($x, $y + $arg{shift}, $z);
                    push @out, ansi_color "$fg/$bg", $arg{string};
                }
            }
            print((@out, "\n") x $arg{line});
        }
    }
}

sub colortable {
    my $width = shift || 144;
    my $column = min 6, $width / (4 * 6);
    for my $c (0..5) {
        for my $b (0..5) {
            my @format =
                ("%d$b$c", "$c%d$b", "$b$c%d", "$b%d$c", "$c$b%d", "%d$c$b")
                [0 .. $column - 1];
            for my $format (@format) {
                for my $a (0..5) {
                    my $rgb = sprintf $format, $a;
                    print ansi_color "$rgb/$rgb", " $rgb";
                }
            }
            print "\n";
        }
    }
    for my $g (0..5) {
        my $grey = $g x 3;
        print ansi_color "$grey/$grey", sprintf(" %-19s", $grey);
    }
    print "\n";
    for ('L00' .. 'L25') {
        print ansi_color "$_/$_", " $_";
    }
    print "\n";
    for my $rgb ("RGBCMYKW", "rgbcmykw") {
        for my $c (split //, $rgb) {
            print ansi_color "$c/$c", "  $c ";
        }
        print "\n";
    }
    for my $rgb (qw(500 050 005 055 505 550 000 555)) {
        print ansi_color "$rgb/$rgb", " $rgb";
    }
    print "\n";
}

1;

__END__