view release on metacpan or  search on metacpan

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

sub _pour_compact_chunk {
   my ($rtok, $sidx, $n, $slen) = @_; my @mytok;
   for my $i ($sidx .. $sidx + $n - 1) {
      if ($i > $sidx+1 && $rtok->[$i-1] eq '.' && substr($rtok->[$i], 0, 1)
      eq "'" && substr($rtok->[$i-2], 0, 1) eq "'") {
         pop(@mytok); my $qtok = pop(@mytok);  # 'a'.'b' to 'ab'
         push(@mytok, substr($qtok, 0, -1) . substr($rtok->[$i], 1));
      } else {
         push(@mytok, $rtok->[$i]);
      }
   }
   push(@mytok, $rtok->[$sidx+$n]);  # _pour_chunk checks next token
   _pour_chunk(\@mytok, 0, $#mytok, $slen);
}

# Pour unsightly text $txt into shape defined by string $tlines.
sub pour_text {
   my ($tlines, $txt, $gap, $tfill) = @_;
   $txt =~ s/\s+//g;
   my $ttlen = 0; my $txtend = length($txt);
   my @tnlines = map(length() ? [map length, split/([^ ]+)/] : undef,
      split(/\n/, $tlines));
   for my $r (grep($_, @tnlines)) {
      for my $i (0 .. $#{$r}) { $i & 1 and $ttlen += $r->[$i] }
   }
   my $nshape = int($txtend/$ttlen); my $rem = $txtend % $ttlen;
   if ($rem || !$nshape) {
      ++$nshape;
      $txt .= $tfill x (int(($ttlen-$rem)/length($tfill))+1)
         if length($tfill);
   }
   my $s = ""; my $p = 0;
   for (my $n = 1; 1; ++$n, $s .= "\n" x $gap) {
      for my $r (@tnlines) {
         if ($r) {
            for my $i (0 .. $#{$r}) {
               if ($i & 1) {
                  $s .= substr($txt, $p, $r->[$i]); $p += $r->[$i];
                  return "$s\n" if !length($tfill) && $p >= $txtend;
               } else {
                  $s .= ' ' x $r->[$i];
               }
            }
         }
         $s .= "\n";
      }
      last if $n >= $nshape;
   }
   $s;
}

# Make filler code to stuff on end of program to fill last shape.
sub _make_filler {
   my $fv = shift;    # list reference of filler variables
   my $nfv = @{$fv};
   # Beware with these filler values.
   # Avoid $; $" ';' (to avoid clash with " and ; in later parsing).
   # END block is trouble because it is executed after this filler.
   # Setting $^ or $~ (but not $:) to weird values resets $@.
   # For example: $~='?'&'!'; (this looks like a Perl bug to me).
   # For now, just stick with letters and numbers.
   my @filleqto = (
      [ q#'.'#, '^', q^'~'^ ], [ q#'@'#, '|', q^'('^ ],
      [ q#')'#, '^', q^'['^ ], [ q#'`'#, '|', q^'.'^ ],
      [ q#'('#, '^', q^'}'^ ], [ q#'`'#, '|', q^'!'^ ],
      [ q#')'#, '^', q^'}'^ ], [ q#'*'#, '|', q^'`'^ ],
      [ q#'+'#, '^', q^'_'^ ], [ q#'&'#, '|', q^'@'^ ],
      [ q#'['#, '&', q^'~'^ ], [ q#','#, '^', q^'|'^ ]
   );
   $nfv > @filleqto and die "too many fv";
   my $rem = @filleqto % $nfv;
   $rem and splice(@filleqto, -$rem);
   my $v = -1;
   map(($fv->[++$v % $nfv], '=', @{$_}, ';'), @filleqto);
}

# Pour sightly program $prog into shape defined by string $tlines.
sub pour_sightly {
   my ($tlines, $prog, $gap, $fillv, $compact, $ihandler) = @_;
   $ihandler ||= \&_def_ihandler;
   my $ttlen = 0;
   my @tnlines = map(length() ? [map length, split/([^ ]+)/] : undef,
      split(/\n/, $tlines));
   for my $r (grep($_, @tnlines)) {
      for my $i (0 .. $#{$r}) { $i & 1 and $ttlen += $r->[$i] }
   }
   my $outstr = ""; my @ptok;
   if ($prog) {
      if ($prog =~ /^''=~/g) {
         push(@ptok, ($tlines =~ /(\S+)/ ? length($1) : 0) == 3 ?
            "'?'" : "''", '=~');
      } elsif ($prog =~ /(.*eval.*\n\n\n)/g) {
         $outstr .= $1;
      }
      push(@ptok, $prog =~ /[().&|^]|'\\\\'|.../g);  # ... is "'"|'.'
   }
   my $iendprog = @ptok;
   my @filler = _make_filler(ref($fillv) ? $fillv : [ '$:', '$~', '$^' ]);
   # Note: 11 is the length of a filler item, for example, $:='.'^'~';
   # And there are 6 tokens in each filler item: $: = '.' ^ '~' ;
   push(@ptok, 'Z', (@filler) x (int($ttlen/(11 * int(@filler / 6))) + 1));
   my $sidx = 0;
   for (my $nshape = 1; 1; ++$nshape, $outstr .= "\n" x $gap) {
      for my $rline (@tnlines) {
         unless ($rline) { $outstr .= "\n"; next }
         for my $it (0 .. $#{$rline}) {
            unless ($it & 1) {$outstr .= ' ' x $rline->[$it]; next }
            (my $tlen = $rline->[$it]) == (my $plen = length($ptok[$sidx]))
               and $outstr .= $ptok[$sidx++], next;
            if ($plen > $tlen) {
               $outstr .= '(' x $tlen;
               splice(@ptok, $sidx+1, 0, (')') x $tlen);
               $iendprog += $tlen if $sidx < $iendprog;
               next;
            }
            my $fcompact = my $fexact = 0;
            my $n = $compact ?
            _guess_compact_ntok(\@ptok, $sidx, $tlen, \$fexact, \$fcompact)
            :       _guess_ntok(\@ptok, $sidx, $tlen, \$fexact);
            if ($fexact) {

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

    BorderGap      Put a border around the shape. Gap between border
                   and the shape.

    BorderGapLeft,BorderGapRight,BorderGapTop,BorderGapBottom
                   You can override BorderGap with one or more from
                   the above.

    BorderWidth    Put a border around the shape. Width of border.

    BorderWidthLeft,BorderWidthRight,BorderWidthTop,BorderWidthBottom
                   You can override BorderWidth with one or more from
                   the above.

    Width          Ignored for .eye file shapes. For built-in shapes,
                   interpreted appropriately for the shape, typically the
                   shape width in characters. If no shape is specified,
                   a rectangular block of Width characters is generated.

    EyeDir         Normally .eye files are got from the EyeDrops
                   directory underneath where EyeDrops.pm is located.
                   You can override that by specifying a directory
                   containing the .eye shape files.

    InformHandler  By default, sightly prints status of what it is
                   doing to STDERR; you can override this by providing
                   a subroutine reference taking a single inform string
                   argument. To shut it up, set to sub {}.

    TrapEvalDie    Boolean.
                   Add closing 'die $@ if $@' to generated program.
                   When an eval code block calls the die function,
                   the program does not die; instead the die string
                   is returned to eval in $@. Using this flag allows
                   you to convert programs that call die.

    TrapWarn       Boolean.
                   Add leading 'local $SIG{__WARN__}=sub{};' to
                   generated program. This shuts up some warnings.
                   Use this option if generated program emits
                   'No such signal: SIGHUP at ...' when run with
                   warnings enabled.

    FillerVar      Reference to a list of 'filler variables'.
                   A filler variable is a Perl variable consisting
                   of two characters: $ and a punctuation character.
                   For example, FillerVar => [ '$:', '$^' ].
                   Do not use $; or $" or $_ as filler variables.
                   Alternatively, you may set this to '' if you don't
                   want any filler, or to a string (e.g. '#' or ';'
                   or ';#') to use instead of filler variables to
                   fill the leftover part of the last shape with.

=back

=head2 Specifying a Shape

When you specify a shape like this:

    sightly( { Shape => 'fred' ...

first a built-in C<fred> shape is looked for, then EyeDrops looks
for the file F<fred.eye> in the F<get_eye_dir> directory.
If you specify a C<'/'> or C<'.'> in the Shape attribute, a file
with that name is looked for instead, for example:

    sightly( { Shape => '/tmp/fred.eye' ...

Finally, you may specify a shape with a string, for example:

    my $shapestr = <<'FLAMING_OSTRICHES';
             #####
    #######################
    FLAMING_OSTRICHES
    sightly ( { ShapeString => $shapestr ...

If you specify a shape without a source file:

    print sightly( { Shape => 'camel' } );

a I<no-op> filler is used to fill the shape.

If you specify a source file without a shape:

    print sightly( { SourceFile => 'helloworld.pl' } );

a shapeless sightly string without any spaces or newlines is
generated. You can break this string into fixed width lines
via the Width attribute:

    print sightly( { SourceFile => 'helloworld.pl',
                     Width      => 40 } );

Generally, you should specify the Width attribute of I<built-in>
shapes. Notice that the Width attribute is ignored for F<.eye>
file shapes.

=head2 Shape Reference

The I<built-in> shapes are:

    banner      Linux banner command (/usr/games/banner -w Width)
                of text in BannerString attribute
    srcbanner   Linux banner command (/usr/games/banner -w Width)
                of source text
    siertri     A Sierpinski triangle (2**Width lines)
    triangle    A triangle (width Width characters)
    all         A shape consisting of all .eye shapes joined together
                (Width blank lines between each shape)

The F<.eye> file shapes distributed with this version of EyeDrops are:

    a             Horizontal banner of "a"
    acme          Perl/Parrot/Ponie Euro-hacker and modern artist who likes
                  the colour orange and enjoys having his bra-strap twanged
    adrianh       Perl qa expert
    alien         An alien (rumoured to be Ton Hospel, from the
                  Roswell archives circa 1974)
    alpaca        Lama pacos, from South America, with long shaggy hair
                  and related to the llama
    autrijus      The father of Pugs
    baghdad       Baghdad Bob aka Comical Ali