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


line stmt bran cond sub pod time code
1             package Term::ANSIColor::Concise::Table;
2              
3             our $VERSION = "2.04";
4              
5 1     1   1689 use v5.14;
  1         3  
6 1     1   5 use utf8;
  1         3  
  1         6  
7              
8 1     1   24 use Exporter 'import';
  1         2  
  1         101  
9             our @EXPORT = qw();
10             our @EXPORT_OK = qw(
11             colortable colortable6 colortable12 colortable24
12             );
13             our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
14              
15 1     1   7 use Carp;
  1         2  
  1         53  
16 1     1   5 use Data::Dumper;
  1         2  
  1         70  
17             $Data::Dumper::Sortkeys = 1;
18              
19 1     1   7 use Term::ANSIColor::Concise qw(ansi_color map_to_256);
  1         3  
  1         62  
20 1     1   19 use List::Util qw(min);
  1         3  
  1         1053  
21              
22             sub colortable6 {
23 0     0 1   colortableN(
24             step => 6,
25             string => " ",
26             line => 2,
27             x => 1, y => 1, z => 1,
28             @_
29             );
30             }
31              
32             sub colortable12 {
33 0     0 1   colortableN(
34             step => 12,
35             string => " ",
36             x => 1, y => 1, z => 2,
37             @_
38             );
39             }
40              
41             # use charnames ':full';
42              
43             sub colortable24 {
44 0     0 1   colortableN(
45             step => 24,
46             string => "\N{U+2580}", # "\N{UPPER HALF BLOCK}",
47             shift => 1,
48             x => 1, y => 2, z => 4,
49             @_
50             );
51             }
52              
53             sub colortableN {
54 0     0 0   my %arg = (
55             shift => 0,
56             line => 1,
57             row => 3,
58             @_);
59 0           my @combi = do {
60 0           my @default = qw( XYZ YZX ZXY YXZ XZY ZYX );
61 0 0         if (my @s = $arg{row} =~ /[xyz]{3}/ig) {
62 0           @s;
63             } else {
64 0           @default[0 .. $arg{row} - 1];
65             }
66             };
67             my @order = map {
68 0           my @ord = map { { X=>0, Y=>1, Z=>2 }->{$_} } /[XYZ]/g;
  0            
69 0     0     sub { @_[@ord] }
70 0           } map { uc } @combi;
  0            
  0            
71 0           binmode STDOUT, ":utf8";
72 0           for my $order (@order) {
73             my $rgb = sub {
74             sprintf "#%02x%02x%02x",
75 0     0     map { map_to_256($arg{step}, $_) } $order->(@_);
  0            
76 0           };
77 0           for (my $y = 0; $y < $arg{step}; $y += $arg{y}) {
78 0           my @out;
79 0           for (my $z = 0; $z < $arg{step}; $z += $arg{z}) {
80 0           for (my $x = 0; $x < $arg{step}; $x += $arg{x}) {
81 0           my $fg = $rgb->($x, $y, $z);
82 0           my $bg = $rgb->($x, $y + $arg{shift}, $z);
83 0           push @out, ansi_color "$fg/$bg", $arg{string};
84             }
85             }
86 0           print((@out, "\n") x $arg{line});
87             }
88             }
89             }
90              
91             sub colortable {
92 0   0 0 1   my $width = shift || 144;
93 0           my $column = min 6, $width / (4 * 6);
94 0           for my $c (0..5) {
95 0           for my $b (0..5) {
96 0           my @format =
97             ("%d$b$c", "$c%d$b", "$b$c%d", "$b%d$c", "$c$b%d", "%d$c$b")
98             [0 .. $column - 1];
99 0           for my $format (@format) {
100 0           for my $a (0..5) {
101 0           my $rgb = sprintf $format, $a;
102 0           print ansi_color "$rgb/$rgb", " $rgb";
103             }
104             }
105 0           print "\n";
106             }
107             }
108 0           for my $g (0..5) {
109 0           my $grey = $g x 3;
110 0           print ansi_color "$grey/$grey", sprintf(" %-19s", $grey);
111             }
112 0           print "\n";
113 0           for ('L00' .. 'L25') {
114 0           print ansi_color "$_/$_", " $_";
115             }
116 0           print "\n";
117 0           for my $rgb ("RGBCMYKW", "rgbcmykw") {
118 0           for my $c (split //, $rgb) {
119 0           print ansi_color "$c/$c", " $c ";
120             }
121 0           print "\n";
122             }
123 0           for my $rgb (qw(500 050 005 055 505 550 000 555)) {
124 0           print ansi_color "$rgb/$rgb", " $rgb";
125             }
126 0           print "\n";
127             }
128              
129             1;
130              
131             __END__