view release on metacpan or  search on metacpan

t/10_Ponie.t  view on Meta::CPAN

#!/usr/bin/perl
# 10_Ponie.t (was text.t)
# This tests OK as taint-safe (i.e. with -Tw added to first line above).

use strict;
use Acme::EyeDrops qw(sightly hjoin_shapes get_eye_string pour_text);

# --------------------------------------------------

select(STDERR);$|=1;select(STDOUT);$|=1;  # autoflush

print "1..34\n";

my $snow = get_eye_string('snow');

my $src = <<'SNOWING';
$_=q~vZvZ&%('$&"'"&(&"&$&"'"&$Z$#$$$#$%$&"'"&(&#
%$&"'"&#Z#$$$#%#%$%$%$%(%%%#%$%$%#Z"%*#$%$%$%$%(%%%#%$%$
%#Z"%,($%$%$%(%%%#%$%$%#Z"%*%"%$%$%$%(%%%#%$%$%#Z#%%"#%#%
$%$%$%$##&#%$%$%$%#Z$&""$%"&$%$%$%#%"%"&%%$%$%#Z%&%&#
%"'"'"'###%*'"'"'"ZT%?ZT%?ZS'>Zv~;
s;\s;;g;
$;='@,=map{$.=$";join"",map((($.^=O)x(-33+ord)),/./g),$/}split+Z;
s/./(rand)<.2?"o":$"/egfor@;=((5x84).$/)x30;map{
system$^O=~W?CLS:"clear";print@;;splice@;,-$_,2,pop@,;
@;=($/,@;);sleep!$%}2..17';
$;=~s;\s;;g;eval$;
SNOWING

# -------------------------------------------------

my $itest = 0;

my $snowflake = pour_text($snow, "",  1, '#');
$snowflake eq $snow or print "not ";
++$itest; print "ok $itest\n";

# -------------------------------------------------

$snowflake = pour_text($snow, $src,  1, "");
my $t = $snowflake; $t =~ s/\s+//g;
my $v = $src; $v =~ s/\s+//g;
substr($t, 0, length($v)) eq $v or print "not ";
++$itest; print "ok $itest\n";
substr($t, length($v)) eq '' or print "not ";
++$itest; print "ok $itest\n";

# -------------------------------------------------

$snowflake = pour_text($snow, $src,  1, '#');
$t = $snowflake;
$t =~ tr/!-~/#/;
$t eq $snow or print "not ";
++$itest; print "ok $itest\n";
$t = $snowflake; $t =~ s/\s+//g;
$v = $src; $v =~ s/\s+//g;
substr($t, 0, length($v)) eq $v or print "not ";
++$itest; print "ok $itest\n";
substr($t, length($v)) eq '#' x (length($t)-length($v)) or print "not ";
++$itest; print "ok $itest\n";

# -------------------------------------------------

$snowflake = sightly( { Shape         => 'snow',
                        SourceString  => $src,
                        Text          => 1,
                        TextFiller    => '#' } );
$t = $snowflake;
$t =~ tr/!-~/#/;
$t eq $snow or print "not ";
++$itest; print "ok $itest\n";
$t = $snowflake; $t =~ s/\s+//g;
$v = $src; $v =~ s/\s+//g;
substr($t, 0, length($v)) eq $v or print "not ";
++$itest; print "ok $itest\n";
substr($t, length($v)) eq '#' x (length($t)-length($v)) or print "not ";
++$itest; print "ok $itest\n";

# -------------------------------------------------

my $shape = "## ###\n";
my $p = pour_text($shape, "", 1, "");
$p eq "\n" or print "not ";
++$itest; print "ok $itest\n";