# 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;
