• Your recent searches
Acme-AsciiArtinator
4 results

 view release on metacpan or  search on metacpan

ascii-art.pl  view on Meta::CPAN 


${_}="rst";;;;;;;
 while(<>){print
  "Hello",", ",
   "world!\n" 
    if /st/;}
     #######
      #####
       ###
        #

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

    $CODE = $opts{"code_string"};
  } elsif ($opts{"code"}) {
    $CODE = $opts{"code"};
  } else {
    croak "Invalid spec. Must specify  code, code_file,  or  code_string \n";
  }

  if (defined $opts{"output"}) {
    $OUTPUT = $opts{"output"};
  } else {
    print STDERR "Output will go to \"ascii-art.pl\"\n" if $DEBUG;
    $OUTPUT = "ascii-art.pl";
  }

  if (defined $opts{"compile-check"}) {
    my $fh;
    open($fh, ">", "ascii-art.$$.pl");
    print $fh $CODE;
    close $fh;

    my $c1 = &compile_check("ascii-art.$$.pl");
    unlink "ascii-art.$$.pl";
    if ($c1 > 0) {
      croak "Initial code in ",$opts{"code"},$opts{"code_string"},
	    $opts{"code_file"}," does not compile!\n";
    }
  }

  my $ntest = 1;
  while (defined $opts{"test_argv$ntest"} || defined $opts{"test_input$ntest"}) {
    my (@test_argv, @test_stdin) = ();

    @test_argv = @{$opts{"test_argv$ntest"}} if defined $opts{"test_argv$ntest"};
    @test_stdin = @{$opts{"test_input$ntest"}} if defined $opts{"test_input$ntest"};
    my $fh;
    if (open($fh, ">", "ascii-art-test-$ntest-$$.pl")) {
      print $fh $CODE;
      close $fh;

      my $output = "";
      if (defined $opts{"test_input$ntest"}) {
	open($fh, ">", "ascii-art-test-$ntest-$$.stdin");
	print $fh @test_stdin;
	close $fh;
	print qq{Running test: $^X ascii-art-test-$ntest-$$.pl @test_argv < ascii-art-test-$ntest-$$.stdin\n} if $DEBUG;
	$output = qx{$^X ascii-art-test-$ntest-$$.pl @test_argv < ascii-art-test-$ntest-$$.stdin};
	unlink "ascii-art-test-$ntest-$$.stdin";
      } else {
	print qq{Running test: $^X ascii-art-test-$ntest-$$.pl @test_argv\n};
	$output = qx{$^X ascii-art-test-$ntest-$$.pl @test_argv};
      }
      print "Ran pre-test # $ntest with argv: \"@test_argv\", stdin: \"@test_stdin\"\n";

      $Acme::AsciiArtinator::TestOutput[$ntest] = $output;
      unlink "ascii-art-test-$ntest-$$.pl";
    } else {
      carp "Could not write code to disk in order to run pre-test.\n";
    }
  } continue {
    $ntest++;
  }

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 


  my $max_tries = $opts{"retry"} || 100;


  my @tokens = &asciiindex_code($CODE);
  my @contexts = @asciiartinate::contexts;
  my @blocks = &asciiindex_art($PIC);

  my $ipad;
  for ($ipad = 0; $ipad < $max_tries; $ipad++) {
    print "\n\n\n\nPad try # $ipad\n\n\n\n"; 

    my ($newt,$newc) = &pad(\@tokens, \@contexts, \@blocks);
    if (defined $newc) {

      for (my $i=0; $i<@$newt; $i++) {
	print $newt->[$i], "\t", $newc->[$i], "\n";
      }

      @tokens = @$newt;

      if ($opts{"filler"} != 0) {
	&tweak_padding($opts{"filler"}, \@tokens, \@contexts);
      }

      print_code_to_pic($PIC, @tokens);

      my $fh;
      open($fh, ">", $OUTPUT);
      select $fh;
      print_code_to_pic($PIC, @tokens);
      select STDOUT;
      close $fh;

      my $c1 = &compile_check($OUTPUT);
      if ($c1 > 0) {
	croak "Artinated code does not compile! Darn.\n";
	exit $c1 >> 8;
      }

      ##################################################

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

      my @output = <$fh>;
      close $fh;

      # test output
      #
      # make sure artinated code produces same outputs
      # as the original code on the test cases.
      #
      $ntest = 1;
      if (defined $opts{"test_argv1"}) {
	print "Running post-tests on artinated code\n";
      }
      while (defined $opts{"test_argv$ntest"} || defined $opts{"test_input$ntest"}) {
	my (@test_argv, @test_stdin) = ();

	print "Testing output # $ntest:\n";

	@test_argv = @{$opts{"test_argv$ntest"}} if defined $opts{"test_argv$ntest"};
	@test_stdin = @{$opts{"test_input$ntest"}} if defined $opts{"test_input$ntest"};
	my $fh;
	next if !defined $Acme::AsciiArtinator::TestOutput[$ntest];

	my $output = "";
	if (defined $opts{"test_input$ntest"}) {
	  open($fh, ">", "ascii-art-test-$ntest-$$.stdin");
	  print $fh @test_stdin;
	  close $fh;
	  $output = qx{$^X "$OUTPUT" @test_argv < ascii-art-test-$ntest-$$.stdin};
	  unlink "ascii-art-test-$ntest-$$.stdin";
	} else {
	  $output = qx{$^X "$OUTPUT" @test_argv};
	}
	print "Ran post-test # $ntest with argv: \"@test_argv\", stdin: \"@test_stdin\"\n";
    
	if ($output eq $Acme::AsciiArtinator::TestOutput[$ntest]) {
	  print "Post-test # $ntest: PASS\n";
	  $Acme::AsciiArtinator::TestResult[$ntest] = "PASS";
	} else {
	  print "Post-test # $ntest: FAIL\n";
	  $Acme::AsciiArtinator::TestResult[$ntest] = "FAIL";
	  print STDERR "-- " x 13, "\n";
	  print STDERR "Original results for test # $ntest:\n";
	  print STDERR "-- " x 7, "\n";
	  print STDERR $Acme::AsciiArtinator::TestOutput[$ntest];
	  print STDERR "\n", "-- " x 13, "\n";
	  print STDERR "Final results for test # $ntest:\n";
	  print STDERR $output;
	  print STDERR "\n", "-- " x 13, "\n\n";
	}
      } continue {
	$ntest++;
      }
      return @output;
    }
  }

  if ($ipad >= $max_tries) {
    croak "The ASCII Artinator was unable to embed your code in the picture ",
      "after $max_tries tries.\n";
  }
}

#
# run a file containing Perl code for a Perl compilation check
#
sub compile_check {
  my ($file) = @_;
  print "\n";
  print "- " x 20, "\n";
  print "Compile check for $file:\n";
  print "- " x 20, "\n";
  print `$^X -cw "$file"`;
  print "- " x 20, "\n";
  return $?;
}

sub tweak_padding {
  my ($filler, $tref, $cref) = @_;

  # TODO: if there are many consecutive characters of padding
  #       in the code, we can improve its appearance by 
  #       inserting some quoted text in void context.

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

  #   punctuation strings from @token_keywords
  #

  my ($i, $j, $Q, @tokens, $token, $sigil, @contexts, @blocks);

  $sigil = 0;
  for ($i = 0; $i < @INPUT; $i++) {
    $_ = $INPUT[$i];
    $Q = "@INPUT[$i..$#INPUT]";

    print STDERR "\$Q = ", substr($Q,0,8), "... SIGIL=$sigil\n" if $_ eq "q" && $DEBUG;

    # $#  could be "the output format of printed numbers"
    # or it could be the start of an expression like  $#X  or  $#{@$X}
    # in the latter case we need $# + one more token to be contiguous
    if ($Q =~ /^\$\#\{/ || $Q =~ /^\$\#\w+/) {
      $token = $&;
      push @tokens, $token;
      push @contexts, "\$# operator";
      $i = $i - 1 + length $token;
      $sigil = 0;
      next;
    }

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 


      } else {
	push @contexts, "unknown";
      }
    }

    $sigil = 0;
  }

  if ($DEBUG) {
    print "- " x 20,"\n";
    my @c = @contexts;
    foreach $token (@tokens) {
      my $cc = shift @c;
      print $token,"\t",$cc,"\n";
    }
    print "- " x 20,"\n";
    print "Total token count: ", scalar @tokens, "\n";
  }

  @asciiartinate::contexts = @contexts;
  @asciiartinate::tokens = @tokens;

  @tokens;
}

sub asciiindex_code {
  my ($X) = @_;

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

}

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

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

	  (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;
}

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

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

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

  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 ]);
}

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

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
          \______|______/
          /\_____|_____/\
         / /\____|____/\ \
        / / /\___|___/\ \ \
       / / / /\__|__/\ \ \ \

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

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

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

         \ \ \/____|____\/ / /
          \ \/_____|_____\/ /
           \/______|______\/
           /       |       \

=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

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 


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

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN 

=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

t/01-artinate.t  view on Meta::CPAN 

my $art = '
XXXXXXXXXXXXXXX
 XXXXXXXXXXXXX
  XXXXXXXXXXX
   XXXXXXXXX
    XXXXXXX
     XXXXX
      XXX
       X';

my $code = '$_="rst";print"Hello",", ","world!\n" if /st/;';

my @output = asciiartinate( code => $code, art => $art);
my $output = join '', @output;

print STDERR @output;

ok($output =~ /print/);
ok($output =~ /Hello/);
ok($output =~ /;;/ || $output =~ /\{\w+\}/);

################################################

@output = asciiartinate( code => $code, art => $art, test_argv1 => [] );
ok(defined $Acme::AsciiArtinator::TestOutput[1]);
ok(not defined $Acme::AsciiArtinator::TestOutput[0]);
ok(not defined $Acme::AsciiArtinator::TestOutput[2]);

t/02-test_input.t  view on Meta::CPAN 

XXXXXXXXXXXXXXXXX
 XXXXXXXXXXXXXXX
  XXXXXXXXXXXXX
   XXXXXXXXXXX
    XXXXXXXXX
     XXXXXXX
      XXXXX
       XXX
        X';

my $code = '$_="rst";while(<>){print"Hello",", ","world!\n" if /st/;}';

my @input1 = ("hello world!\n",
	      "it's been nice knowing you\n",
	      "ist been nice\n");

my @output = asciiartinate( code => $code, art => $art,
			 test_argv1 => [], test_input1 => \@input1,
		         test_argv2 => ["hello"],  test_input2 => [] );

ok(defined $Acme::AsciiArtinator::TestOutput[1]);



( run in 0.968 second using v1.01-cache-2.11-cpan-de7293f3b23 )