view release on metacpan or  search on metacpan

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

package Acme::Pony;

$VERSION = '1.1.2';

open 0 or print "Can't Pony '$0'\n" and exit;
(my $code = join "", <0>) =~ s/.*^\s*use\s+Acme::Pony\s*;\n//sm;

if($code!~/^[buffyX\s]*$/i) { # if it hasn't been encoded
	my $code=ponyize("$code\n__END__");
	open(0, ">$0") or print "Can't Ponyize $0\n" and exit();
	print {0} "use Acme::Pony;\n$code" and exit();
} else {
	$code=unpony($code); # $code=~s/\n__END__//;
	eval($code);
	exit();
}

sub ponyize {
	my @chars = split(//, unpack "b*", pop);
	my $i=0;
	my @BUFFY=qw(B U F F Y);
	my @buffy=qw(b u f f y);
	foreach (@chars) {
		$_ = $_ ? $BUFFY[$i] : $buffy[$i];
		$i++; $i %= 5;
	}
	
	@chars=scalepony(@chars);

	join('',@chars);
}

sub unpony {
	my @chars=grep { /[buffy]/i; } split(//, pop);
	foreach (@chars) {
		$_=($_=~/[buffy]/)?0:1;
	}
	pack "b*", join '', @chars;
}

sub scalepony {
	my @chars = @_;
	my $chars = join '', @chars;
  my $wantlength = length $chars;
  my $scale;

  # What scale do we want?
  if ($wantlength > 201242) {
    $scale = 1000 * sqrt($wantlength / 201242);
  } else {
    $scale = 1000 / sqrt(201242 / $wantlength);
  }
  $scale *= 0.95;

  # These were worked out by hand with very accurate graph paper
  my @xpoints = (0.26735840061026, 0.290728815714195, 0.297102536393109, 0.299227321848579, 0.322598690483758, 0.348092937511919, 0.36933761362914, 0.403331002479181, 0.430951624181552, 0.450073104062043, 0.471317780179264, 0.484066492912084, 0.49681...
  # ... or I may have used Sketch...
  my @ypoints = (0.0303060573188429, 0.0417852818858603, 0.0264797254557372, 0.0150004436442946, 0.0417852818858603, 0.0666571259291486, 0.0685702346162763, 0.0915289699724368, 0.118313922702853, 0.141272371836888, 0.169970719476557, 0.21014800546111...

  # Scale the points (with ASCII 'fixed' font size scaling too)
  @xpoints = map { $_ *= $scale; $_ = int($_) } @xpoints;
  @ypoints = map { $_ *= $scale * 5 / 9; $_ = int($_) } @ypoints;
  my $n = @xpoints;

  return if ($n < 3); # not even a triangle, boring

  # Find the min and max y values
  my($miny, $maxy) = ($ypoints[0], $ypoints[0]);
  foreach my $y (@ypoints) {
    if ($y < $miny) {
      $miny = $y;
    } elsif ($y > $maxy) {
      $maxy = $y}
  }

  my @ascii;

  # Can you say "generic polygon scanline fill"?
  foreach my $y ($miny .. $maxy) {
    my($ind1, $ind2, $y1, $y2, $x1, $x2, @polyints);

    foreach my $i (0 .. $n-1) {
      if (!$i) {
	$ind1 = $n-1;
	$ind2 = 0;
      } else {
	$ind1 = $i-1;
	$ind2 = $i;
      }
      $y1 = $ypoints[$ind1];
      $y2 = $ypoints[$ind2];
      if ($y1 < $y2) {
	$x1 = $xpoints[$ind1];
	$x2 = $xpoints[$ind2];
      } elsif ($y1 > $y2) {
	$y2 = $ypoints[$ind1];
	$y1 = $ypoints[$ind2];
	$x2 = $xpoints[$ind1];
	$x1 = $xpoints[$ind2];
      } else {
	next;
      }
      if (($y >= $y1) && ($y < $y2)) {
	push @polyints, ($y-$y1) * ($x2-$x1) / ($y2-$y1) + $x1;
      } elsif (($y == $maxy) && ($y > $y1) && ($y <= $y2)) {
	push @polyints, ($y-$y1) * ($x2-$x1) / ($y2-$y1) + $x1;
      }
    }

    @polyints = sort { $a <=> $b } @polyints;

    while (@polyints) {
      my($x1, $x2) = (pop @polyints, pop @polyints);
      ($x1, $x2) = ($x2, $x1) if $x1 > $x2;

      foreach my $x ($x1 .. $x2) {
	$ascii[$y][$x1++] = 'X';
      }