File Coverage

File:blib/lib/Image/Caa/DriverCurses.pm
Coverage:83.3%

linestmtbrancondsubtimecode
1package Image::Caa::DriverCurses;
2
3
1
1
1
1
5
2
7
use strict;
4
1
1
1
1
5
2
5
use warnings;
5
1
0
0
1
3
use Curses;
6
7sub new {
8        my ($class, $args) = @_;
9
10        my $self = bless {}, $class;
11
12        $self->{window} = $args->{window};
13        $self->{has_color} = 0;
14
15        $self->{color_pair_next} = 1;
16        $self->{color_pairs} = {};
17
18        return $self;
19}
20
21sub init {
22        my ($self) = @_;
23
24        $self->{has_color} = has_colors();
25
26        start_color() if $self->{has_color};
27}
28
29sub set_color{
30        my ($self, $fg, $bg) = @_;
31
32        return unless $self->{has_color};
33
34        my $bright = $fg > 7;
35
36        $fg -= 8 if $fg > 7;
37        $bg -= 8 if $bg > 7;
38
39        my $key = "$fg:$bg";
40
41        if (!defined $self->{color_pairs}->{$key}){
42
43                my $pr = $self->{color_pair_next};
44                $self->{color_pair_next}++;
45
46                init_pair($pr, $fg, $bg);
47                $self->{color_pairs}->{$key} = $pr;
48
49                print "new pair: $key\n";
50        }
51
52        $self->{window}->attron( $bright ? A_BOLD : A_DIM );
53        $self->{window}->attron(COLOR_PAIR($self->{color_pairs}->{$key}));
54}
55
56sub putchar{
57        my ($self, $x, $y, $outch) = @_;
58
59        $self->{window}->addch($y, $x, $outch);
60}
61
62sub fini {
63        my ($self) = @_;
64}
65
66
671;