File Coverage

blib/lib/Text/ASCII/Stylize.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

# ABSTRACT: Turns figlets into styled figlets
use strict;
use warnings;
package Text::ASCII::Stylize;
use Moose;
use YAML::Tiny;
use Try::Tiny;
use Getopt::Long;

use constant DEFAULT_FORMAT => 'id-software';

has 'in' => (
	is => 'rw',
	isa => 'ArrayRef'
);

has 'dib' => (
	is => 'rw',
	isa => 'ArrayRef'
);

has 'yaml' => (
	is => 'rw',
	isa => 'Object'
);

has 'format' => (
	is => 'rw',
	isa => 'Str',
);

sub main {
	my ($self) = @_;
	$self->proc_options();
	$self->defaults();
	$self->proc_in();
	$self->proc_yaml();
	$self->proc_seq();
	$self->blit();
}

sub put {
	my ($self,$x,$y,$ch) = @_;
	try {
		$self->dib->[$y]->[$x] = $ch;
	} catch {
		return(0);
	};
}

sub get {
	my ($self,$x,$y) = @_;
	my $ret;

	return(0) if $x < 0 || $y < 0;

	try {
		$ret = $self->dib->[$y]->[$x];
	} catch {
		return(0);
	};

	return($ret) if $ret;
	return(0);
}

sub rio {
	my ($self,$x,$y,$ch,$w) = @_;
	if(&$w) {
		$self->put($x,$y,$ch);
	}
}

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

	# top down
	$self->letters_top_half();
	$self->letters_full();
	$self->letters_bottom_half();

	# left right
	$self->letters_top_left();
	$self->letters_bottom_left();
	$self->letters_top_right();
	$self->letters_bottom_right();
}

sub letters_full {
	my ($self) = @_;
	my ($idx_x,$idx_y) = (0,0);
	for my $y (@{$self->dib}) {
		for my $x (@{$y}) {
			$self->rio($idx_x,$idx_y,$self->yaml->[0]->{preset}->{letters}->{blocks}->{fill},sub {
				my $block = $self->get($idx_x,$idx_y);
				if($block =~ /[|\$&\()V\/\\=\:\<\>;]/) {
					1;
				} else {
					0;
				}
			});
			$idx_x++;
		}
		$idx_x = 0;
		$idx_y++;
	}
}

sub letters_top_half {
	my ($self) = @_;
	my ($idx_x,$idx_y) = (0,0);
	for my $y (@{$self->dib}) {
		for my $x (@{$y}) {
			$self->rio($idx_x,$idx_y,$self->yaml->[0]->{preset}->{letters}->{blocks}->{'top-half'},sub {
				my $block = $self->get($idx_x,$idx_y);
				if($block =~ /[-'`*]/) {
					1;
				} else {
					0;
				}
			});
			$idx_x++;
		}
		$idx_x = 0;
		$idx_y++;
	}
}

sub letters_top_left {
	my ($self) = @_;
	my ($idx_x,$idx_y) = (0,0);
	for my $y (@{$self->dib}) {
		for my $x (@{$y}) {
			$self->rio($idx_x,$idx_y,$self->yaml->[0]->{preset}->{letters}->{blocks}->{'top-left'},sub {
				my $block = $self->get($idx_x,$idx_y);
				my $block_above = ($self->get($idx_x,$idx_y - 1) || ' ');
				my $block_left = ($self->get($idx_x - 1,$idx_y) || ' ');
				if($block_left =~ /[\s]/ && $block_above =~ /[\s]/ && $block =~ /[^\s]/) {
					1;
				} else {
					0;
				}
			});
			$idx_x++;
		}
		$idx_x = 0;
		$idx_y++;
	}
}

sub letters_top_right {
	my ($self) = @_;
	my ($idx_x,$idx_y) = (0,0);
	for my $y (@{$self->dib}) {
		for my $x (@{$y}) {
			$self->rio($idx_x,$idx_y,$self->yaml->[0]->{preset}->{letters}->{blocks}->{'top-right'},sub {
				my $block = $self->get($idx_x,$idx_y);
				my $block_above = ($self->get($idx_x,$idx_y - 1) || ' ');
				my $block_diag = ($self->get($idx_x + 1,$idx_y - 1) || ' ');
				my $block_right = ($self->get($idx_x + 1,$idx_y) || ' ');
				if($block_right =~ /[\s]/ && $block_above =~ /[\s]/ && $block_diag =~ /[\s]/ && $block =~  /[^\s]/) {
					return(1);
				} else {
					return(0);
				}
			});
			$idx_x++;
		}
		$idx_x = 0;
		$idx_y++;
	}
}

sub letters_bottom_left {
	my ($self) = @_;
	my ($idx_x,$idx_y) = (0,0);
	for my $y (@{$self->dib}) {
		for my $x (@{$y}) {
			$self->rio($idx_x,$idx_y,$self->yaml->[0]->{preset}->{letters}->{blocks}->{'bottom-left'},sub {
				my $block = $self->get($idx_x,$idx_y);
				my $block_below = ($self->get($idx_x,$idx_y + 1) || ' ');
				my $block_diag = ($self->get($idx_x - 1,$idx_y + 1) || ' ');
				my $block_left = ($self->get($idx_x - 1,$idx_y) || ' ');
				if($block_left =~ /[\s]/ && $block_below =~ /[\s]/ && $block_diag =~ /[\s]/ && $block =~  /[^\s]/) {
					return(1);
				} else {
					return(0);
				}
			});
			$idx_x++;
		}
		$idx_x = 0;
		$idx_y++;
	}
}

sub letters_bottom_right {
	my ($self) = @_;
	my ($idx_x,$idx_y) = (0,0);
	for my $y (@{$self->dib}) {
		for my $x (@{$y}) {
			$self->rio($idx_x,$idx_y,$self->yaml->[0]->{preset}->{letters}->{blocks}->{'bottom-right'},sub {
				my $block = $self->get($idx_x,$idx_y);
				my $block_below = ($self->get($idx_x,$idx_y + 1) || ' ');
				my $block_diag = ($self->get($idx_x + 1,$idx_y + 1) || ' ');
				my $block_right = ($self->get($idx_x + 1,$idx_y) || ' ');
				if($block_right =~ /[\s]/ && $block_below =~ /[\s]/ && $block_diag =~ /[\s]/ && $block =~  /[^\s]/) {
					return(1);
				} else {
					return(0);
				}
			});
			$idx_x++;
		}
		$idx_x = 0;
		$idx_y++;
	}
}

sub letters_bottom_half {
	my ($self) = @_;
	my ($idx_x,$idx_y) = (0,0);
	for my $y (@{$self->dib}) {
		for my $x (@{$y}) {
			$self->rio($idx_x,$idx_y,$self->yaml->[0]->{preset}->{letters}->{blocks}->{'bottom-half'},sub {
				my $block = $self->get($idx_x,$idx_y);
				if($block =~ /[_,]/) {
					return(1);
				} else {
					return(0);
				}
			});
			$idx_x++;
		}
		$idx_x = 0;
		$idx_y++;
	}
}

sub fill_fill {
	my ($self) = @_;
	my ($idx_x,$idx_y) = (0,0);
	for my $y (@{$self->dib}) {
		for my $x (@{$y}) {
			$self->rio($idx_x,$idx_y,$self->yaml->[0]->{preset}->{letters}->{blocks}->{'fill-fill'},sub {
				my $block = $self->get($idx_x,$idx_y);
				my $block_above = ($self->get($idx_x,$idx_y - 1) || ' ');
				my $block_below = ($self->get($idx_x,$idx_y + 1) || ' ');
				my $block_left = ($self->get($idx_x - 1,$idx_y) || ' ');
				my $block_right = ($self->get($idx_x + 1,$idx_y) || ' ');
				if(($block_below =~ /[\s]/ && $block_above =~ /[\s]/ && $block_right =~ /[\s]/ && $block_left =~ /[\s]/) && $block =~  /[\s]/) {
					return(1);
				} else {
					return(0);
				}
			});
			$idx_x++;
		}
		$idx_x = 0;
		$idx_y++;
	}
}

sub proc_options {
    my $self = shift;
    my $opt_format = DEFAULT_FORMAT;
    eval {
        GetOptions('format=s' => \$opt_format);
        $self->format($opt_format);
    };

    die "Regrettably, this is not a valid format option.  Choose one of (id-software or seth-able)." if $@;

    return(0);
}

sub proc_seq {
	my ($self) = @_;
	$self->letters;
	$self->fill_fill;
}

sub proc_yaml {
	my ($self) = @_;
	open(my $yaml_filehandle,'<','./text_ascii_stylize.d/' . $self->format . '.yml') or die('cannot open < format.yml');
	my @lines = <$yaml_filehandle>;
	close($yaml_filehandle);

	my $yaml = YAML::Tiny->read_string("@lines");
	$self->yaml($yaml);
}

sub defaults {
	my ($self) = @_;
	my @in = <>;
	$self->in(\@in);
}

sub blit {
	my ($self) = @_;
	for my $y (@{$self->dib}) {
		for my $x (@{$y}) {
			print $x;
		}
		print "\n";
	}
}

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

	my @rows = @{$self->in};
	my @dib;
	for my $y (@rows) {

		my @row;

		chomp($y);
		for(my $x = 0;$x < length($y);$x++) {
			push @row,substr($y,$x,1);
		}
		push @dib,\@row;
	}
	$self->dib(\@dib);
}

1;