#!/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";
$p = pour_text($shape, 'X', 1, "");
$p eq "X\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XX', 1, "");
$p eq "XX\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XXX', 1, "");
$p eq "XX X\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XXXXX', 1, "");
$p eq "XX XXX\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XXXXXX', 1, "");
$p eq "XX XXX\n\nX\n" or print "not ";
++$itest; print "ok $itest\n";
my $shape_gap = "## ###\n\n####\n";
$p = pour_text($shape_gap, 'XXXXX', 4, "");
$p eq "XX XXX\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape_gap, 'XXXXXX', 4, "");
$p eq "XX XXX\n\nX\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape_gap, 'XXXXXXXXX', 4, "");
$p eq "XX XXX\n\nXXXX\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape_gap, 'XXXXXXXXXX', 4, "");
$p eq "XX XXX\n\nXXXX\n\n\n\n\nX\n" or print "not ";
++$itest; print "ok $itest\n";
# -------------------------------------------------
$p = pour_text($shape, '', 2, '#');
$p eq "## ###\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'X', 2, '#');
$p eq "X# ###\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XX', 2, '#');
$p eq "XX ###\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XXX', 2, '#');
$p eq "XX X##\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XXXX', 2, '#');
$p eq "XX XX#\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XXXXX', 2, '#');
$p eq "XX XXX\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XXXXXX', 2, '#');
$p eq "XX XXX\n\n\nX# ###\n" or print "not ";
++$itest; print "ok $itest\n";
# -------------------------------------------------
$p = pour_text($shape, 'X', 3, 'abc');
$p eq "Xa bca\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'X', 3, 'abcd');
$p eq "Xa bcd\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'XXXXX', 3, 'abc');
$p eq "XX XXX\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, '1234567', 3, 'abc');
$p eq "12 345\n\n\n\n67 abc\n" or print "not ";
++$itest; print "ok $itest\n";
# -------------------------------------------------
$p = sightly( { SourceString => 'knob',
Width => 1,
Text => 1,
TextFiller => '#' } );
$p eq "k\nn\no\nb\n" or print "not ";
++$itest; print "ok $itest\n";
$p = sightly( { SourceString => 'knob',
Width => 3,
Text => 1,
TextFiller => '#' } );
$p eq "kno\nb##\n" or print "not ";
++$itest; print "ok $itest\n";
$p = sightly( { SourceString => 'knob',
Width => 4,
Text => 1,
TextFiller => '#' } );
$p eq "knob\n" or print "not ";
++$itest; print "ok $itest\n";
# -------------------------------------------------
$p = hjoin_shapes(2, "##\n###\n", "#\n##\n###\n");
$p eq "## #\n### ##\n ###\n" or print "not ";
++$itest; print "ok $itest\n";
# -------------------------------------------------