File Coverage

blib/lib/Ascii/Text.pm

Criterion	Covered	Total	%
statement	29	29	100.0
branch			n/a
condition			n/a
subroutine	11	11	100.0
pod			n/a
total	40	40	100.0

package Ascii::Text;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.22';

use Rope;
use Rope::Autoload;
use Term::Size::ReadKey;
use Module::Load;
use Types::Standard qw/Int Str Enum HashRef FileHandle/;

use overload "&{}" => sub {
	my $self = shift;
	return sub { $self->render(@_); }
};

property max_width => (
	initable => 1,
	writeable => 1,
	type => Int,
	builder => sub {
		Term::Size::ReadKey::chars *STDOUT{IO};
	}
);

property override_empty_space => (
	initable => 1,
	writeable => 1,
	type => Int,
	value => 0
);

property pad => (
	initable => 1,
	writeable => 1,
	type => Int,
	value => 0,
);

property font => (
	initable => 1,
	writeable => 1,
	type => Str,
	value => 'Boomer'
);

property align => (
	initable => 1,
	writeable => 1,
	type => Enum[qw( left center right )],
	value => 'left'
);

property color => (
	initable => 1,
	type => Str,
	writeable => 1,
);

property color_map => (
	initable => 1,
	writeable => 1,
	type => HashRef,
	builder => sub { return {
		black => "\e[30m",
		red => "\e[31m",
		green => "\e[32m",
		yellow => "\e[33m",
		blue => "\e[34m",
		magenta => "\e[35m",
		cyan => "\e[36m",
		white => "\e[37m",
		bright_black => "\e[90m",
		bright_red => "\e[91m",
		bright_green => "\e[92m",
		bright_yellow => "\e[93m",
		bright_blue => "\e[94m",
		bright_magenta => "\e[95m",
		bright_cyan => "\e[96m",
		bright_white => "\e[37m",
	} }
);

property fh => (
	initable => 1,
	writeable => 1,
	builder => sub {
		return *STDOUT;
	}
);

function font_class => sub {
	my $class = sprintf "Ascii::Text::Font::%s", $_[0]->font;
	load $class;
	return $class;
};

function stringify => sub {
	my ($self, $text, $wrap) = @_;
	my $stringify = [];
	$self->render($text, $stringify);
	return join "", grep { $wrap ? $_ !~ m/^\s+$/ : $_ } @{$stringify};
};

function render => sub {
	my ($self, $text, $stringify) = @_;
	$text =~ s/[^ 0-9A-Za-z]//;
	my $class = $self->font_class->new;
	my @words = split /\s+/, $text;
	my %character_map;
	for (@words) {
		my @characters = split //, $_;
		for (@characters) {
			next if $character_map{$_};
			my $character = "character_$_";
			$character = $class->$character;
			$character_map{$_} = $character;
		}
	}
	my ($width, @line) = $self->new_line();
	while (@words) {
		my @characters = split //, shift @words;
		for (my $i = 0; $i < scalar @characters; $i++) {
			my $character = $character_map{$characters[$i]};
			for (my $i = 0; $i < scalar @{$character}; $i++) {
				push @{$line[$i]}, @{$character->[$i]};
			}
			$width -= scalar @{$character->[0]};

			my $next = $characters[$i + 1];
			if ($next && $width < scalar @{$character_map{$next}->[0]}) {
				$self->print_line(\@line, $stringify);
				($width, @line) = $self->new_line();
			}
		}
		if ($words[0]) {
			@characters = split //, $words[0];
			my $space = $self->_empty_space($class) || $class->space;
			my $required_width = scalar @{$space->[0]};
			$required_width += @{$character_map{$_}->[0]} for @characters;
			if ($width > $required_width) {
				for (my $i = 0; $i < scalar @{$space}; $i++) {
					push @{$line[$i]}, @{$space->[$i]}, " ";
				}
				$width = $width - scalar @{$space->[0]};
				next;
			}
		}
		$self->print_line(\@line, $stringify);
		($width, @line) = $self->new_line();
	}
	if ($self->color && $self->color_map->{$self->color}) {
		if ($stringify) {
			push @{$stringify}, "\e[0m";
		} else {
			my $fh = $self->fh;
			print $fh "\e[0m";
		}
	}
};

function new_line => sub {
	return ($_[0]->max_width, [],[],[],[],[],[]);
};

function print_line => sub {
	my ($self, $line, $stringify) = @_;
	my $line_width = @{$line->[0]};
	my $pad = $self->align eq 'center'
		? ($self->max_width - $line_width) / 2
		: $self->align eq 'right'
		? $self->max_width - $line_width
		: $self->pad;
	$pad = $pad && $pad > 0 ? " " x $pad : "";
	my $fh = $self->fh;
	for (@{$line}) {
		next unless scalar @{$_};
		if ($self->color && $self->color_map->{$self->color}) {
			if ($stringify) {
				push @{$stringify}, $self->color_map->{$self->color};
			} else {
				print $fh $self->color_map->{$self->color};
			}
		}
		my $l = $pad;
		$l .= join "", @{$_};
		$l .= "\n";
		if ($stringify) {
			push @{$stringify}, $l;
		} else {
			print $fh $l;
		}
	}
};


function list => sub {
	my ($self) = @_;
	my $base_path = __FILE__;
	$base_path =~ s/.pm$//;
	$base_path .= '/Font';
	opendir my $dir, $base_path or die $!;
	my @files = sort grep { $_ =~ s/\.pm$//; $_ !~ m/^\./ } readdir $dir;
	closedir $dir;
	return @files;
};

function _empty_space => sub {
	my ($self, $font) = @_;
	return unless $self->override_empty_space;
	return [$font->default_character($self->override_empty_space)];
};

1;

__END__