File Coverage

blib/lib/Text/FIGlet/Ransom.pm

Criterion	Covered	Total	%
statement	67	101	66.3
branch	24	46	52.1
condition			n/a
subroutine	6	7	85.7
pod	2	4	50.0
total	99	158	62.6

package Text::FIGlet::Ransom;
require 5;
use strict;
use vars qw/$VERSION @ISA/;
use Carp 'croak';
$VERSION = 2.17;
@ISA = 'Text::FIGlet::Font';

#Roll our own for 5.005, and remove somewhat heavy List::Util dependency
sub max{ (sort @_)[-1]; }
sub sum{ my $cnt; $cnt += $_ foreach @_; return $cnt}

sub new{
  shift();
  my $self = {-U=>0, -v=>'center', -m=>-1, @_};
  my(@fonts, %fonts);


  if( ref($self->{-f}) eq 'HASH' ){
    croak "No default specified" unless defined($self->{-f}->{undef});
    croak "Insufficient number of fonts, 2 or more please" unless keys(%{$self->{-f}}) > 1;
    $self->{_fonts} = [delete($self->{-f}->{undef}), keys %{$self->{-f}}];
  }
  else{
    croak "Insufficient number of fonts, 2 or more please" unless scalar(@{$self->{-f}}) > 1;
    $self->{_fonts} = $self->{-f};
  }


  #Load the fonts
  my $x =0;
  foreach my $font ( @{$self->{_fonts}} ){
      push(@fonts, Text::FIGlet::Font->new(%$self, -f=>$font));
      $fonts{$font} = $x++;
  }


  #Synthesize a header
  #Hardblank = DEL
  $self->{_header}->[0] = "\x7F";
  #Height
  $self->{_header}->[1] = max( map {$_->{_header}->[1]} @fonts );
  #Base height
  $self->{_header}->[2] = max( map {$_->{_header}->[2]} @fonts );
  #Max glyph width
  $self->{_header}->[3] = $self->{_maxLen} = max( map {$_->{_maxLen}} @fonts );
  #Smush = none
  $self->{_header}->[4] = 0;
  #Comment line count, calculated when dumping @_ ... include chr to font mapping?
  #R2L = false
  $self->{_header}->[6] = 0;

  if( $self->{-v} eq 'base' ){
    my $descender = max( map {$_->{_header}->[1] - $_->{_header}->[2]} @fonts );
    $self->{_header}->[1] = $self->{_header}->[2] + $descender;
  }


  #Assemble the body
  for(my $i=32; $i<127; $i++ ){
    my($c, $R);
    if( ref($self->{-f}) eq 'HASH' ){
      while( my($k,$v) = each(%{$self->{-f}}) ){
	if( chr($i) =~ /$v/ ){
	  $c = $fonts[$R=$fonts{$k}]->{_font}->[$i];
	  #Reset counter, may be more trouble than the short-circuit is worth
	  keys %{$self->{-f}};
	  last;
	}
      }
      $c = $fonts[$R=0]->{_font}->[$i] unless $c;
    }
    else{
      $R = rand(scalar(@fonts));
      $c = $fonts[$R]->{_font}->[$i];
      $self->{_map}->[$R] .= chr($i);
    }

    #Vertical-alignment & padding
    if( my $delta = $self->{_header}->[1] - $fonts[$R]->{_header}->[1] ){
      #Parens around qw for 5.005
      local($self->{-v}) = (qw/top center center bottom/)[rand(4)]
	if $self->{-v} eq 'random';


      my $ws = $self->{-m} == 0 ? $c->[0] : sum(@$c[0,1,2]);
      if( $self->{-v} eq 'top' ){
	push(@$c, (' 'x$ws)x$delta);
      }
      elsif( $self->{-v} eq 'baseline' ){
	my $t = $self->{_header}->[2] - $fonts[$R]->{_header}->[2];
	my $b = $self->{_header}->[1] - $fonts[$R]->{_header}->[1] - $t;
	splice(@$c, 3, 0, (' 'x$ws)x$t) if $t;
	push(@$c, (' 'x$ws)x$b) if $b;
      }
      elsif( $self->{-v} eq 'bottom' ){
	splice(@$c, 3, 0, (' 'x$ws)x$delta);
      }
      elsif( $self->{-v} eq 'center' ){
	my $t = int($delta/2);
	my $b = $delta - $t;
	splice(@$c, 3, 0, (' 'x$ws)x$t) if $t;
	push(@$c, (' 'x$ws)x$b) if $b;
      }
    }


    #XXX -m... freeze/thaw? horizontally center w/ padding -height..-1

    #Common hardblank
    my $iHard=$fonts[$R]->{_header}->[0];
    foreach my $j(-$self->{_header}->[1]..-1){
      $c->[$j]=~ s/$iHard/$self->{_header}->[0]/g;
      #$c->[$j].= Text::FIGlet::UTF8len($c->[$j]);
    }

    $self->{_font}->[$i] = $c;
  }

  bless($self);
}

sub freeze{
    my $self = shift;
    my $font;

    foreach my $opt ( sort grep {/^-/} keys %{$self} ){
	my $val = $self->{$opt};
	if( ref($val) eq 'ARRAY' ){
	    $val = '[qw/'. join(' ', @$val) . '/]';
	    if( $opt eq '-f' ){
		for(my $f=0; $f< scalar @{$self->{_map}}; $f++ ){
		    $val .= "\n#\tfont$f $self->{_map}->[$f]";
		    $self->{_header}->[5]++;
		}
	    }
	}
	elsif( ref($val) eq 'HASH' ){
	    $val = '{undef,'. $self->{_fonts}->[0] .','. join(',',%{$val}) .'}';
	}
	$font .= sprintf "#%s => %s\n", $opt, $val;
	$self->{_header}->[5]++;
    }

    $font = sprintf("flf2a%s %s %s %s %s %s %s\n", @{$self->{_header}}). $font;

    for(my $i=32; $i<= scalar @{$self->{_font}}; $i++ ){
	my $c = $self->{_font}->[$i];
	foreach my $j(-$self->{_header}->[1]..-1){
	    $font .= $c->[$j] . ($j<-1?"\x1F\n":"\x1F\x1F\n");
	}
    }
    return $font;
}

1;
__END__