File Coverage

blib/lib/Image/Caa/DriverANSI.pm
Criterion Covered Total %
statement 11 33 33.3
branch 0 8 0.0
condition n/a
subroutine 3 7 42.8
pod 0 5 0.0
total 14 53 26.4


line stmt bran cond sub pod time code
1             package Image::Caa::DriverANSI;
2            
3 1     1   5 use strict;
  1         2  
  1         42  
4 1     1   5 use warnings;
  1         2  
  1         643  
5            
6             sub new {
7 9     9 0 19 my ($class) = @_;
8            
9 9         31 my $self = bless {}, $class;
10            
11 9         215 $self->{color_map} = {
12             int(Image::Caa::CAA_COLOR_BLACK) => [30,1],
13             int(Image::Caa::CAA_COLOR_RED) => [31,1],
14             int(Image::Caa::CAA_COLOR_GREEN) => [32,1],
15             int(Image::Caa::CAA_COLOR_YELLOW) => [33,1],
16             int(Image::Caa::CAA_COLOR_BLUE) => [34,1],
17             int(Image::Caa::CAA_COLOR_MAGENTA) => [35,1],
18             int(Image::Caa::CAA_COLOR_CYAN) => [36,1],
19             int(Image::Caa::CAA_COLOR_LIGHTGRAY) => [37,1],
20            
21             int(Image::Caa::CAA_COLOR_DARKGRAY) => [30,0],
22             int(Image::Caa::CAA_COLOR_LIGHTRED) => [31,0],
23             int(Image::Caa::CAA_COLOR_LIGHTGREEN) => [32,0],
24             int(Image::Caa::CAA_COLOR_BROWN) => [33,0],
25             int(Image::Caa::CAA_COLOR_LIGHTBLUE) => [34,0],
26             int(Image::Caa::CAA_COLOR_LIGHTMAGENTA) => [35,0],
27             int(Image::Caa::CAA_COLOR_LIGHTCYAN) => [36,0],
28             int(Image::Caa::CAA_COLOR_WHITE) => [37,0],
29             };
30            
31 9         29 $self->{color_pairs} = {};
32            
33 9         76 return $self;
34             }
35            
36             sub init {
37 0     0 0   my ($self) = @_;
38            
39 0           $self->{current_color_key} = '';
40 0           $self->{last_x} = 0;
41             }
42            
43             sub set_color{
44 0     0 0   my ($self, $fg, $bg) = @_;
45            
46 0           my $key = "$fg:$bg";
47            
48 0           $self->{current_color_key} = $key;
49            
50 0 0         if (!defined $self->{color_pairs}->{$key}){
51            
52 0           my ($fg_col, $fg_dark) = @{$self->{color_map}->{$fg}};
  0            
53 0           my ($bg_col, $bg_dark) = @{$self->{color_map}->{$bg}};
  0            
54            
55 0           $bg_col += 10;
56            
57 0 0         $self->{color_pairs}->{$key} = "\e[${fg_col};".($fg_dark?2:1).";${bg_col};".($bg_dark?6:5)."m";
    0          
58             }
59             }
60            
61             sub putchar{
62 0     0 0   my ($self, $x, $y, $outch) = @_;
63            
64 0 0         if ($x < $self->{last_x}){
65            
66 0           print "\n";
67             }
68            
69 0           $self->{last_x} = $x;
70            
71 0           print $self->{color_pairs}->{$self->{current_color_key}};
72 0           print $outch;
73 0           print "\e[0m";
74             }
75            
76             sub fini {
77 0     0 0   my ($self) = @_;
78            
79 0           print "\n";
80             }
81            
82             1;