File Coverage

blib/lib/Image/Caa/DriverCurses.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Image::Caa::DriverCurses;

use strict;
use warnings;
use Curses;

sub new {
	my ($class, $args) = @_;

	my $self = bless {}, $class;

	$self->{window} = $args->{window};
	$self->{has_color} = 0;

	$self->{color_pair_next} = 1;
	$self->{color_pairs} = {};

	return $self;
}

sub init {
	my ($self) = @_;

	$self->{has_color} = has_colors();

	start_color() if $self->{has_color};
}

sub set_color{
	my ($self, $fg, $bg) = @_;

	return unless $self->{has_color};

	my $bright = $fg > 7;

	$fg -= 8 if $fg > 7;
	$bg -= 8 if $bg > 7;

	my $key = "$fg:$bg";

	if (!defined $self->{color_pairs}->{$key}){

		my $pr = $self->{color_pair_next};
		$self->{color_pair_next}++;

		init_pair($pr, $fg, $bg);
		$self->{color_pairs}->{$key} = $pr;

		print "new pair: $key\n";
	}

	$self->{window}->attron( $bright ? A_BOLD : A_DIM );
	$self->{window}->attron(COLOR_PAIR($self->{color_pairs}->{$key}));
}

sub putchar{
	my ($self, $x, $y, $outch) = @_;

	$self->{window}->addch($y, $x, $outch);
}

sub fini {
	my ($self) = @_;
}


1;