Acme-AsciiArtinator
view release on metacpan or search on metacpan
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
push @blocks, $block_size;
$block_size = 0;
}
# certain token combos like the special Perl vars
# ($$ $" $| $! etc.) can be separated by spaces and tabs
# but not by newlines! Let's use block of size 0 to
# indicate where a newline is.
if ($char eq "\n") {
push @blocks, 0;
}
} else {
++$block_size;
}
}
if ($block_size > 0) {
push @blocks, $block_size;
}
return @blocks;
}
sub asciiindex_art {
my ($X) = @_;
&tokenize_art($X);
}
#
# replace darkspace on the pic with characters from the code
#
sub print_code_to_pic {
my ($pic, @tokens) = @_;
local $" = '';
my $code = "@tokens";
my @code = split //, $code;
$pic =~ s/(\S)/@code==0?"#":shift @code/ge;
print $pic;
}
#
# find misalignment between multi-character tokens and blocks
# and report position where additional padding is needed for
# alignment
#
sub padding_needed {
my @tokens = @{$_[0]};
my @contexts = @{$_[1]};
my @blocks = @{$_[2]};
my $ib = 0;
my $tc = 0;
my $bc = $blocks[$ib++];
my $it = 0;
while ($bc == 0) {
$bc = $blocks[$ib++];
if ($ib > @blocks) {
print "Error: picture is not large enough to contain code!\n";
print map {(" ",length $_)} @tokens;
print "\n\n@blocks\n";
return [-1,-1];
}
}
foreach my $t (@tokens) {
my $tt = length $t;
defined $tt or print "! \$tt is not defined! \$it=$it \$ib=$ib\n";
defined $bc or print "! \$bc is not defined! \$it=$it \$ib=$ib \$tt=$tt\n";
if ($tt > $bc) {
if ($DEBUG) {
print "Need to pad by $bc spaces at or before position $tc\n";
} else {
print "\rNeed to pad by $bc spaces at or before position $tc ";
}
return [$it, $bc];
}
$bc -= $tt;
#
# for regular Perl variables ( "$x", "@bob" ), it is OK to split
# the sigil and the var name with any whitespace ("$ x", "@\n\tbob").
# For special Perl vars ( '$"', "$/", "$$" ), it is OK to split
# with spaces and tabs but not with newlines.
#
# Check for this condition here and say that padding is needed if
# a special var is currently aligned on a newline.
#
if ($bc == 0 && $blocks[$ib] == 0 && $tokens[$it] eq "\$"
&& $contexts[$it] eq "SIGIL" && $contexts[$it+1] eq "name"
&& length($tokens[$it+1]) == 1 && $tokens[$it+1] =~ /\W/) {
warn "\$tt > \$bc but padding still needed: \n",
(join " : ", @tokens[0 .. $it+1]), "\n",
(join " : ", @contexts[0 .. $it+1]), "\n",
(join " : ", @blocks[0 .. $ib+1]), "\n";
return [$it, 1] if 1;
}
while ($bc == 0) {
$bc = $blocks[$ib++];
if ($ib > @blocks) {
print "Error: picture is not large enough to contain code!\n";
print map {(" ",length $_)} @tokens;
print "\n\n@blocks\n";
return [-1,-1];
}
}
$tc += length $t;
$it++;
}
return;
}
#
# choose a random number between 0 and n-1,
# with the distribution heavily weighted toward
# the high end of the range
#
sub hi_weighted_rand {
my $n = shift;
my (@p, $r, $p);
for ($r = 1; $r <= $n; $r++) {
push @p, $p += $r * $r * $r;
}
$p = int(rand() * $p);
for ($r = 1; $r <= @p; $r++) {
return $r if $p[$r-1] >= $p;
}
return $n;
}
#
# look for opportunity to insert padding into the
# code at the specified location
#
sub try_to_pad {
my ($pos, $npad, $tref, $cref) = @_;
# padding techniques:
# X SIGIL name ---> SIGIL { name }
# XXX ---> ( XXX )
# for XXX in (numeric literal,quoted string)
# XXX ; ---> XXX ;;
# for XXX in (quoted string,numeric literal,regular expression
# <> operator, ")"
# X } ---> ; } for } that ends a code BLOCK
# X ; } ---> ; ; }
# inserting strings in void context after semi-colons (for howmuch > 2)
# = expr ---> = 0|| expr (if expr does not have ops with lower prec than ||)
# = expr ---> = 1&& expr (if expr does not have ops with lower prec than &&)
# = expr ---> = 0 or expr , = 0 xor expr
my $t = 0;
my $it = $pos;
print STDERR "Trying to pad at [$it]: ", join " :: ", @{$tref}[$it-1 .. $it+1], "\n" if $DEBUG;
print STDERR "Contexts: ", join " :: ", @{$cref}[$it-1 .. $it+1], "\n\n" if $DEBUG;
my $z = rand() * 0.5;
$z = 0.45 if $it == 0;
if ($z < 0.25 && $npad > 1) {
# convert SIGIL name --> SIGIL { name }
if ($cref->[$it] eq "name" && $cref->[$it-1] eq "SIGIL") {
print STDERR "Padding name $tref->[$it] at pos $it\n" if $DEBUG;
splice @$tref, $it+1, 0, "}";
splice @$tref, $it, 0, "{";
splice @$cref, $it+1, 0, "filler";
splice @$cref, $it, 0, "filler";
return 2;
}
} elsif ($z < 0.50) {
# try to pad the beginning of a statement with filler
if ($it == 0 || ($tref->[$it-1] eq ";" && $cref->[$it-1] eq "end of statement")
|| ($tref->[$it] eq ";" && $cref->[$it] eq "end of statement")
|| $cref->[$it] eq "flexible filler"
|| $cref->[$it-1] eq "flexible filler") {
print STDERR "Padding with flexible filler x $npad at pos $it\n" if $DEBUG;
while ($npad-- > 0) {
splice @$tref, $it, 0, ";";
splice @$cref, $it, 0, "flexible filler";
return $_[1];
}
}
} elsif ($z < 0.5 && $npad > 1) {
# reserved for future use ?
} elsif ($z < 0.75) {
# this space intentionally left blank
}
return 0;
}
#
# find all misalignments and insert padding into the code
# until all code is aligned or until the padded code is
# too large for the pic.
#
sub pad {
my @tokens = @{$_[0]};
my @contexts = @{$_[1]};
my @blocks = @{$_[2]};
my $nblocks = 0;
map { $nblocks += $_ } @blocks;
my ($needed, $where, $howmuch);
while ($needed = padding_needed(\@tokens,\@contexts,\@blocks)) {
($where,$howmuch) = @$needed;
if ($where < 0 && $howmuch < 0) {
if ($DEBUG) {
print_code_to_pic($Acme::AsciiArtinator::PIC,@tokens);
sleep 1;
}
return;
}
my $npad = $howmuch > 1 ? $howmuch - hi_weighted_rand($howmuch-1) : $howmuch;
while (rand() > 0.95 && $where > 0) {
$where--;
}
while ($where >= 0 && !try_to_pad($where, $npad, \@tokens, \@contexts)) {
$where-- if rand() > 0.4;
}
my $tlength = 0;
map { $tlength += length $_ } @tokens;
if ($tlength > $nblocks) {
print "Padded length exceeds space length.\n";
if ($DEBUG) {
print_code_to_pic($Acme::AsciiArtinator::PIC, @tokens);
print "\n\n";
sleep 1;
}
return;
}
}
([ @tokens ], [ @contexts ]);
}
#
# can run from command line:
#
# perl Acme/AsciiArtinator.pm [-d] art-file code-file [output-file]
#
if ($0 =~ /AsciiArtinator.pm/) {
my $debug = 0;
my $compile_check = 1;
my @opts = grep { /^-/ } @ARGV;
@ARGV = grep { !/^-/ } @ARGV;
foreach my $opt (@opts) {
$debug = 1 if $opt eq '-d';
# $compile_check = 1 if $opt eq '-c';
}
asciiartinate( art_file => $ARGV[0] ,
code_file => $ARGV[1] ,
output => $ARGV[2] || "ascii-art.pl",
debug => $debug ,
'compile-check' => $compile_check );
}
1;
__END__
=head1 NAME
Acme::AsciiArtinator - Embed Perl code in ASCII artwork
=head1 VERSION
0.04
=head1 SYNOPSIS
use Acme::AsciiArtinator;
asciiartinate( { art_file => "ascii.file",
code_file => "code.pl",
output => "output.pl" } );
=head1 DESCRIPTION
Embeds Perl code (or at least gives it a good
college try) into a piece of ASCII artwork by
replacing the non-whitespace
(we'll refer to C<non-whitespace> a lot in this
document, so let's just call it
C<darkspace> for convenience) characters of an
ASCII file with the characters of a Perl script.
If necessary, the code is modified (padded) so
that blocks of contiguous characters (keywords,
quoted strings, alphanumeric literals, etc.)
in the code are aligned with at least the
minimum number of contiguous darkspace
characters in the artwork.
=head1 EXAMPLE
Suppose we have a file called C<spider.pl> with
the following code:
&I();$N=<>;@o=(map{$z=${U}x($x=1+$N-$_);
' 'x$x.($".$F)x$_.($B.$z.$P.$z.$F).($B.$")x$_.$/}
0..$N);@o=(@o,($U.$F)x++$N.($"x3).($B.$U)x$N.$/);
print@o;
sub I{($B,$F,$P,$U)=qw(\\ / | _);}
while($_=pop@o){y'/\\'\/';@o||y#_# #;$t++||y#_ # _#;print}
What this code does is read one value from standard input
and draws a spider web of the given size:
$ echo 5 | perl spiders.pl
\______|______/
/\_____|_____/\
/ /\____|____/\ \
/ / /\___|___/\ \ \
/ / / /\__|__/\ \ \ \
/ / / / /\_|_/\ \ \ \ \
_/_/_/_/_/_/ \_\_\_\_\_\_
\ \ \ \ \ \___/ / / / / /
\ \ \ \ \/_|_\/ / / / /
\ \ \ \/__|__\/ / / /
\ \ \/___|___\/ / /
\ \/____|____\/ /
\/_____|_____\/
/ | \
Suppose we also have a file called C<spider.ascii>
that looks like:
; ,
,; '.
;: :;
:: ::
:: ::
': :
:. :
;' :: :: '
.' '; ;' '.
:: :; ;: ::
; :;. ,;: ::
:; :;: ,;" ::
::. ':; ..,.; ;:' ,.;:
"'"... '::,::::: ;: .;.;""'
'"""....;:::::;,;.;"""
.:::.....'"':::::::'",...;::::;.
;:'.'""'"";.,;:::::;.'"""""". ':;
::' ;::;:::;::.. :;
::. ,;:::::::::::;:.. ::
;' ,;;:;::::::::::::::;";.. ':.
:: ;:" ::::::"__':::::: ": ::
:. :: ::::::;__::::::: :: .;
; :: :::::::__::::::: : ;
' :: ::::::....:::::' ,: '
' :: :::::::::::::" ::
:: ':::::::::"' ::
': """""""' ::
:: ;:
':; ;:"
'; ,;'
"' '"
And B<now> suppose that we think it would be
pretty cool if the code that draws spider
webs on the screen actually looked like a
spider. Well, this is a job for the Acme::AsciiArtinator.
Let's code up a quick script that just says:
use Acme::AsciiArtinator;
asciiartinate( art_file => "spiders.ascii",
code_file => "spiders.pl",
output => "spider-art.pl" );
and run it.
If this works (and it might not, for a variety of
reasons), we will get a new file called C<spider-art.pl>
that looks something like:
& I
() ;$
N= <>
;; ;;
;; ;;
;; ;
;; ;
;; ;; ;; ;
;; ;; ;; ;;
;; ;; ;@ o=
( map {$z =$
{U }x( $x= 1+
$N- $_) ;' 'x $x. ($".
$F)x$_ .($B.$z.$ P. $z.$F).
($B.$")x$_.$/}0..$N);@
o=(@o,($U.$F)x++$N.($"x3).($B.$U
)x$N.$/);;;;print@o;;;sub I{( $B,
$F, $P,$U)=qw(\\ /
| _);;}while($_=pop @o
){ y'/\\'\/';;;@o||y#_# #;; ;;;
;$ t++ ||y#_ # _#;print }# ##
## ## ################ ## ##
# ## ################ # #
# ## ################ ## #
# ## ############## ##
## ############ ##
## ######## ##
## ##
### ###
## ###
## ##
Hey, that was pretty cool! Let's see if it works.
$ echo 6 | perl spider-art.pl
\_______|_______/
/\______|______/\
/ /\_____|_____/\ \
/ / /\____|____/\ \ \
/ / / /\___|___/\ \ \ \
/ / / / /\__|__/\ \ \ \ \
/ / / / / /\_|_/\ \ \ \ \ \
_/_/_/_/_/_/_/ \_\_\_\_\_\_\_
\ \ \ \ \ \ \___/ / / / / / /
\ \ \ \ \ \/_|_\/ / / / / /
\ \ \ \ \/__|__\/ / / / /
\ \ \ \/___|___\/ / / /
\ \ \/____|____\/ / /
\ \/_____|_____\/ /
\/______|______\/
/ | \
=head1 UNDER THE HOOD
To fill in the shape of the spider, we inserted whitespace,
semi-colons, sharps, and maybe the occasional C<{> C<}> pair
into the original code. Certain blocks of text, like
C<print>, C<while>, and C<y#_ # _#> are kept intact since
splitting them would cause the program to either fail to
compile or to behave differently.
The ASCII Artinator tokenizes the code and
does its best to identify
=over 4
=item 1. Character strings that must not be divided
These include alphanumeric literals, quoted strings,
and most regular expressions.
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
Certain coding practices will increase the chance that
C<Acme::AsciiArtinator> will be able to embed your code
in the artwork of your choice. In no particular order,
here are some suggestions:
=over 4
=item * Make sure the original code works
Make sure the code compiles and test it to see if it
works like you expect it to
before running the ASCII Artinator. It would be frustrating to
try to debug an artinated script only to later realize that
there was some bug in the original input.
=item * Get rid of comments
This module won't handle comments very well. There's no way
to stop the ASCII Artinator from splitting your comment across
two lines and breaking the code.
=item * Reduce whitespace
In addition to making the code longer and thus more difficult
to align, any whitespace in your code will be printed out as
space over a darkspace in the art and put a "hole" in your
picture. It would be nice if there was a way to align the
whitespace in the code with the whitespace in the art, but that
is probably something for a far future version.
=item * Avoid significant newlines
Newlines are stripped from the code before the code is tokenized.
If there are any significant newlines (I mean the literal 0x0a char.
It should still be OK to say C<print"\n">), then the artinated
code will run differently.
=item * Consider workarounds for quoted strings
Quoted strings are parsed as a single token. Consider ways to break
them up so that can be split into multiple tokens. For example, instead
of saying C<$h="Hello, world!";>, we could actually say something like:
&I;($c,$e)=qw(, !);$h=H.e.l.l.o.$c.$".W.o.r.l.d.$e;
The modified code is a lot longer, but this code can be split at any
point except in the middle of C<qw>, so it is much more flexible code
from the perspective of the Artinator.
=item * Perform some smart reordering
In the spider example, we see that the largest contiguous blocks of
darkspace are in the center of the spider, and at the beginning and
end of the spider art, there are many smaller blocks of darkspace.
In this case, code that has large tokens in the middle or near the
end of the code will be more flexible than code with large tokens in
the beginning of the code. So for example, we are better off
writing
@o=(map ... );print@o
than
print@o=(map ... )
even through the latter code is a little shorter.
=back
=head1 OPTIONS
The C<asciiartinate> method supports the following options:
=over 4
=item art_file => filename
=item art_string => string
=item art => string
Specifies the ASCII artwork that we'll try to embed code into.
At least one of C<art>, C<art_string>, C<art_file> must be
specified.
=item code_file => filename
=item code_string => string
=item code => string
Specifies the Perl code that we will try to embed into the
art. At least one of C<code>, C<code_string>, C<code_file>
must be specified.
=item output => filename
Specifies the output file for the embedded code. If omitted,
output is written to the file "ascii-art.pl" in the current
directory.
=item compile_check => 0 | 1
Runs the Perl interpreter with the C<-cw> flags on the
original code string and asserts that the code compiles.
=item debug => 0 | 1
Causes the ASCII Artinator to display verbose messages
about what it is trying to do while it is doing what it
is trying to do.
=item test_argv1 => [ @args ], test_argv2 => [ @args ] , test_argv3 => ...
Executes the original and the artinated code and compares the output
to make sure that the artination process did not change the
behavior of the code. A separate test will be conducted for
every C<test_argvE<lt>NNNE<gt>> parameter passed to the
C<asciiartinate> method. The arguments associated with each
parameter will be passed to the code as command-line arguments.
=item test_input1 => [ @data ], test_input2 => [ @data ], test_input3 => ...
Executes the original and the artinated code and compares the output
( run in 1.313 second using v1.01-cache-2.11-cpan-800906f7e73 )