Acme-EyeDrops
view release on metacpan or search on metacpan
lib/Acme/EyeDrops.pm view on Meta::CPAN
# Return ref to property hash.
sub _get_properties {
my $f = shift;
open my $fh, '<', $f or die "open '$f': $!";
my $l; my %h;
while (defined($l = <$fh>)) {
chomp($l);
if ($l =~ s/\\$//) {
my $n = <$fh>; $n =~ s/^\s+//; $l .= $n;
redo unless eof($fh);
}
$l =~ s/^\s+//; $l =~ s/\s+$//;
next unless length($l);
next if $l =~ /^#/;
my ($k, $v) = split(/\s*:\s*/, $l, 2);
$h{$k} = $v;
}
close($fh);
return \%h;
}
sub _def_ihandler { print STDERR $_[0] }
# Return largest no. of tokens with total length less than $slen ($slen > 0).
sub _guess_ntok {
my ($rtok, $sidx, $slen, $rexact) = @_; my $tlen = 0;
for my $i ($sidx .. $sidx + $slen) {
($tlen += length($rtok->[$i])) < $slen or
return $i - $sidx + (${$rexact} = $tlen == $slen);
}
# should never get here
}
sub _guess_compact_ntok {
my ($rtok, $sidx, $slen, $rexact, $fcompact) = @_; my $tlen = 0;
for my $i ($sidx .. $sidx + $slen + $slen) {
($tlen += length($rtok->[$i]) - ($i > $sidx+1 && $rtok->[$i-1] eq '.'
&& substr($rtok->[$i], 0, 1) eq "'" && substr($rtok->[$i-2], 0, 1)
eq "'" ? (${$fcompact} = 3) : 0)) < $slen or
return $i - $sidx + ($tlen > $slen ? 0 : (${$rexact} = 1) +
($i > $sidx && $rtok->[$i] eq '.' && substr($rtok->[$i-1], 0, 1)
eq "'" && $rtok->[$i+1] =~ /^'..$/ ? (${$fcompact} = 1) : 0));
}
# should never get here
}
sub _compact_join {
my ($rtok, $sidx, $n) = @_; my $s = "";
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 "'") {
substr($s, -2) = substr($rtok->[$i], 1); # 'a'.'b' to 'ab'
} else {
$s .= $rtok->[$i];
}
}
$s;
}
# Pour $n tokens from @{$rtok} (starting at index $sidx) into string
# of length $slen. Return string or undef if unsuccessful.
sub _pour_chunk {
my ($rtok, $sidx, $n, $slen) = @_;
my $eidx = $sidx + $n - 1; my $tlen = 0;
my $idot = my $iquote = my $i3quote = my $iparen = my $idollar = -1;
for my $i ($sidx .. $eidx) {
$tlen += length($rtok->[$i]);
if ($rtok->[$i] eq '.') { $idot = $i }
elsif ($rtok->[$i] eq '(') { $iparen = $i }
elsif (substr($rtok->[$i], 0, 1) eq '$') { $idollar = $i }
elsif ($rtok->[$i] =~ /^['"]/) {
$iquote = $i; $i3quote = $i if length($rtok->[$i]) == 3;
}
}
die "oops" if $tlen >= $slen;
my $i2 = (my $d = $slen - $tlen) >> 1;
$idot >= 0 && !($d%3) and return join("", @{$rtok}[$sidx .. $idot-1],
".''" x int($d/3), @{$rtok}[$idot .. $eidx]);
if (!($d&1) and $iquote >= 0 || $idollar >= 0) {
$iquote = $idollar if $iquote < 0;
return join("", @{$rtok}[$sidx .. $iquote-1], '(' x $i2 .
$rtok->[$iquote] . ')' x $i2, @{$rtok}[$iquote+1 .. $eidx]);
}
$i3quote >= 0 and return join("", @{$rtok}[$sidx .. $i3quote-1],
$d == 1 ? '"\\' . substr($rtok->[$i3quote], 1, 1) . '"' :
'(' x $i2 . '"\\' . substr($rtok->[$i3quote], 1, 1) . '"' .
')' x $i2, @{$rtok}[$i3quote+1 .. $eidx]);
return unless $d == 1;
$iparen >= 0 and return join("", @{$rtok}[$sidx .. $iparen-1],
'+' . $rtok->[$iparen], @{$rtok}[$iparen+1 .. $eidx]);
# ouch, can't test for eq '(' in case next chunk also adds '+'
$rtok->[$eidx] ne '=' && $rtok->[$sidx+$n] =~ /^['"]/ ?
join("", @{$rtok}[$sidx .. $eidx], '+') : undef;
}
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) {
$outstr .= $fcompact ? _compact_join(\@ptok, $sidx, $n) :
join("", @ptok[$sidx .. $sidx+$n-1]);
$sidx += $n; next;
}
my $str;
--$n while $n > 0 && !defined($str = $fcompact ?
_pour_compact_chunk(\@ptok, $sidx, $n, $tlen) :
_pour_chunk(\@ptok, $sidx, $n, $tlen));
if ($n) { $outstr .= $str; $sidx += $n; next }
++$n while $n < $tlen && length($ptok[$sidx+$n]) < 2;
die "oops ($n >= $tlen)" if $n >= $tlen;
$outstr .= join("", @ptok[$sidx .. $sidx+$n-1]);
$sidx += $n;
$outstr .= '(' x (my $nleft = $tlen - $n);
splice(@ptok, $sidx+1, 0, (')') x $nleft);
$iendprog += $nleft if $sidx < $iendprog;
}
$outstr .= "\n";
}
$ihandler->("$nshape shapes completed.\n");
last if $sidx >= $iendprog;
}
lib/Acme/EyeDrops.pm view on Meta::CPAN
}
sub make_triangle {
my $w = shift; $w & 1 or ++$w; $w < 9 and $w = 9;
my $n = $w >> 1; my $s;
for (my $i=1;$i<=$w;$i+=2) { $s .= ' ' x $n-- . '#' x $i . "\n" }
$s;
}
sub make_siertri {
my $w = shift; $w < 3 and $w = 5; my $n = 2 ** $w; my $s;
for my $i (0 .. $n-1) {
--$n; $s .= ' ' x $n .
join('', map($n & $_ ? ' ' : '##', 0 .. $i)) . "\n";
} $s;
}
sub make_banner {
my ($w, $src) = @_;
# Linux /usr/games/banner can be used.
# CPAN Text::Banner will hopefully be enhanced so it can be used too.
my $b_exe = '/usr/games/banner';
-x $b_exe or die "'$b_exe' not available on this platform.";
my $f = $w ? "-w $w" : ""; $src =~ s/\s+/ /g; $src =~ s/ $//;
# Following characters not in /usr/games/banner character set:
# \ [ ] { } < > ^ _ | ~
# Also must escape ' from the shell.
$src =~ tr#_\\[]{}<>^|~'`#-/()()()H!T""#;
my $s = ""; my $len = length($src);
for (my $i = 0; $i < $len; $i += 512) {
my $cmd = "$b_exe $f '" . substr($src, $i, 512) . "'";
$s .= `$cmd`; my $rc = $? >> 8; $rc and die "<$cmd>: rc=$rc";
}
$s =~ s/\s+$/\n/; $s =~ s/ +$//mg;
# Remove as many leading spaces as possible.
my $m = 32000; # regex /^ {$m}/ blows up if $m > 32766
while ($s =~ /^( *)\S/mg) { $m = length($1) if length($1) < $m }
$s =~ s/^ {$m}//mg if $m; $s;
}
# -------------------------------------------------------------------------
sub _bi_all {
join "\n" x $_[0]->{Width},
map(_get_eye_string($_[0]->{EyeDir}, $_), _get_eye_shapes($_[0]->{EyeDir}))
}
sub _bi_triangle { make_triangle($_[0]->{Width}) }
sub _bi_siertri { make_siertri($_[0]->{Width}) }
sub _bi_banner { make_banner($_[0]->{Width}, $_[0]->{BannerString}) }
sub _bi_srcbanner { make_banner($_[0]->{Width}, $_[0]->{SourceString}) }
{
my %builtin_shapes = (
'all' => \&_bi_all,
'triangle' => \&_bi_triangle,
'siertri' => \&_bi_siertri,
'banner' => \&_bi_banner,
'srcbanner' => \&_bi_srcbanner
);
sub get_builtin_shapes { sort keys %builtin_shapes }
# Return built-in shape string or undef if invalid shape.
sub _get_builtin_string {
my $shape = shift;
return unless exists($builtin_shapes{$shape});
$builtin_shapes{$shape}->(shift);
}
}
sub sightly {
my $ruarg = shift; my %arg = (
Shape => "", ShapeString => "",
SourceFile => "", SourceString => "",
SourceHandle => undef, InformHandler => undef,
Width => 0, BannerString => "",
Text => 0, TextFiller => "",
Regex => 0, Compact => 0,
Print => 0, Binary => 0,
Gap => 0, Rotate => 0,
RotateType => 0, RotateFlip => 0,
Reflect => 0, Reduce => 0,
Expand => 0, Invert => 0,
TrailingSpaces => 0, RemoveNewlines => 0,
Indent => 0, BorderGap => 0,
BorderGapLeft => 0, BorderGapRight => 0,
BorderGapTop => 0, BorderGapBottom => 0,
BorderWidth => 0, BorderWidthLeft => 0,
BorderWidthRight => 0, BorderWidthTop => 0,
BorderWidthBottom => 0, TrapEvalDie => 0,
TrapWarn => 0, FillerVar => [],
EyeDir => get_eye_dir()
);
for my $k (keys %{$ruarg}) {
exists($arg{$k}) or die "invalid parameter '$k'";
$arg{$k} = $ruarg->{$k};
}
length($arg{SourceFile}) && $arg{SourceHandle} and
die "cannot specify both SourceFile and SourceHandle";
length($arg{SourceFile}) && length($arg{SourceString}) and
die "cannot specify both SourceFile and SourceString";
length($arg{SourceString}) && $arg{SourceHandle} and
die "cannot specify both SourceString and SourceHandle";
$arg{Shape} && $arg{ShapeString} and
die "cannot specify both Shape and ShapeString";
if (length($arg{SourceFile})) {
$arg{SourceString} = _slurp_tfile($arg{SourceFile}, $arg{Binary});
} elsif ($arg{SourceHandle}) {
local $/; $arg{SourceString} = readline($arg{SourceHandle});
}
my $fill = $arg{FillerVar};
if (ref($fill) && !$arg{Text}) {
# Non-rigourous check for module (package) or END block.
@{$fill} or $fill = ($arg{SourceString} =~ /^\s*END\b/m or
$arg{SourceString} =~ /^\s*package\b/m) ?
[ '$:', '$~', '$^' ] :
[ '$:', '$~', '$^', '$/', '$,', '$\\' ];
}
$arg{RemoveNewlines} and $arg{SourceString} =~ tr/\n//d;
my $shape = my $sightly = "";
length($arg{SourceString}) && !$arg{Text} and $sightly = $arg{Print} ?
( $arg{Regex} ? ( $arg{Binary} ?
regex_binmode_print_sightly($arg{SourceString}) :
regex_print_sightly($arg{SourceString}) ) :
( $arg{Binary} ?
clean_binmode_print_sightly($arg{SourceString}) :
clean_print_sightly($arg{SourceString}) ) ) :
( $arg{Regex} ? regex_eval_sightly($arg{SourceString}) :
clean_eval_sightly($arg{SourceString}) );
if ($arg{ShapeString}) {
$shape = $arg{ShapeString};
} elsif ($arg{Shape}) {
$shape = join("\n" x $arg{Gap},
map(_get_builtin_string($_, \%arg) ||
(m#[./]# ? _slurp_tfile($_) : _get_eye_string($arg{EyeDir}, $_)),
lib/Acme/EyeDrops.pm view on Meta::CPAN
$~='*'| '`';$^='+'
^'_';$/= ('&')|
'@';$,=
'['&'~'
;$\=','
^('|');$:=
'.'^'~' ;$~='@'|'(';$^
=')'^'['; $/='`'|'.';$,='('
^'}';$\='`' |'!';$:=')'^'}';$~=
'*'|"\`";$^= '+'^'_';$/='&'|"\@";
$,='['&'~';$\ =','^'|';$:='.'^"\~";
$~='@'|'('; $^=')'^'[';$/="\`"|
('.');$,= '('^'}';$\='`'|'!'
;$:="\)"^ '}';$~='*'|'`';$^
='+'^'_' ;$/='&'|'@';$,="\["&
"\~";$\= ','^'|';$:='.'^"\~";$~=
'@'|'('; $^=')'^'[';$/='`'|'.';$,=
'('^'}'; $\='`'|'!';$:=')'^'}' ;$~='*'|'`'
;($^)= '+'^'_';$/='&'|'@' ;$,='['&"\~";
($\)= ','^'|';$:="\."^ '~';$~='@'|"\(";
$^=')' ^'[';$/='`'|'.' ;$,='('^('}');$\=
('`')| '!';$:=')'^'}' ;$~="\*"| "\`";$^=
('+')^ ( '_');$/=('&')| "\@"; $,='['
&"\~"; ( ( $\)) =',' ^+ "\|";
$:='.' ^(( '~') );($~)
="\@"| '(';$^ =( ')') ^'['; $/='`'
|"\."; $,="\("^ (( '}') );$\='`'|('!');$:=
(')')^ '}' ;$~= '*'|'`';$^='+'^'_';$/
="\&"| '@'; ($,) ='['&'~';$\=','^'|';$:
="\."^ '~';$~='@'|'(' ;$^=')'^ "\[";$/=
('`')| '.';$,='('^'}' ;($\) ='`'|'!';
$:=')' ^(( '}'));$~='*'|'`'
;($^) =( '+')^'_';$/=('&')|
'@';$, = ( '[')& '~';$\=','^
'|';$: = ( ( ( '.' )))^'~';$~
="\@"| (( (( '('))));$^
=(')')^ (( ( "\[")));$/=
'`'|'.'; $, =( ( (( '('))))^'}'
;$\='`'| '!';$:=')' ^+ '}';$~=('*')|
"\`";$^= ( "\+")^ ( '_') ;$/='&'|('@');$,=
'['&"\~"; ($\) =','^'|';$:="\."^
'~';$~='@' | ( '('); $^=')'^('[');$/=
'`'|'.';$, = ('(')^ '}';$\='`'|'!';
$:=')'^'}'; ( ( ( ( $~))))= '*'|'`';$^='+'^
'_';$/='&' |'@';$, ='['&'~';$\=','
^"\|";$:= '.'^'~' ;$~='@'|'(';$^=
')'^'['; $/='`'| '.';$,='('^'}';
$\='`'| '!';$:= ')'^'}';$~='*'|
'`';$^ ="\+"^ '_';$/='&'|'@';
($,) ='[' &'~';$\=','^'|'
=head2 Just another Perl hacker
Let's get more ambitious and create a big self-printing I<JAPH>.
my $src = <<'FLAMING_OSTRICHES';
open 0;
$/ = undef;
$x = <0>;
close 0;
$x =~ tr/!-~/#/;
print $x;
FLAMING_OSTRICHES
print sightly( { Shape => 'japh',
SourceString => $src,
Regex => 1 } );
This works. However, if we change:
$x =~ tr/!-~/#/;
to:
$x =~ s/\S/#/g;
the generated program malfunctions in strange ways because
it is running inside a regular expression and Perl's regex engine
is not reentrant. In this case, we must resort to:
print sightly( { Shape => 'japh',
SourceString => $src,
Regex => 0 } );
which runs the generated sightly program via C<eval> instead.
If you want to use Regex => 1 (to eliminate I<all> alphanumerics),
ensure the program to be converted is careful with its use of
regular expressions and C<$_>.
To produce a I<JAPH> that resembles the original
I<Just another Perl hacker,> aka I<Randal L Schwartz>, try this:
print sightly( { Shape => 'merlyn',
SourceString => 'Just another Perl hacker,',
Regex => 1,
Print => 1 } );
producing:
''=~('('.'?'.'{'.('['
^'+').('['^')').('`'|')').(
'`'|'.').('['^'/').'"'.('`'^'*')
.('[' ^'.')
.('[' ^'(')
.('[' ^'/')
.('{'^ '[').(
"\`"| '!').(
'`'| '.').(
'`'| ( ( '/'))).
('[' ^ ( ( '/'))).(
'`'| ( ( ( ( '('))))).
('`'| ( ( ( ( '%'))))).
('['^ ( ( ( ( ')'))))).
('{'^ '[') .( ( (( ('{'))))^
'+'). ( '`'|'%' ).("\["^ ')').('`'
|',').('{'^ '[').('`'
|'(').('`' |"\!").(
'`'|'#').( ('`')| '+').( '`'|'%')
.('['^')') .(( ',' )). '"' .('}').
lib/Acme/EyeDrops.pm view on Meta::CPAN
Given a Perl program in ascii string STRING, returns an
equivalent sightly-encoded Perl program using an eval
statement executed via eval.
=item regex_binmode_print_sightly STRING
Given an ascii string STRING, returns a sightly-encoded Perl
program with a binmode(STDOUT) and a print statement embedded
in a regular expression. When run, the program will print STRING.
Note that STRING may contain any character in the range 0-255.
This function is used to sightly-encode binary files.
This function is dodgy because regexs don't seem to like
binary zeros; use C<clean_binmode_print_sightly> instead.
=item clean_binmode_print_sightly STRING
Given an ascii string STRING, returns a sightly-encoded Perl
program with a binmode(STDOUT) and a print statement executed
via eval. When run, the program will print STRING.
Note that STRING may contain any character in the range 0-255.
This function is used to sightly-encode binary files.
=item get_builtin_shapes
Returns a list of the built-in shape names.
=item get_eye_dir
Returns the directory containing the F<.eye> file shapes.
This is the F<EyeDrops> sub-directory underneath
where F<EyeDrops.pm> is located.
=item get_eye_shapes
Returns a list of the I<eye> shapes in ascii-betical order.
An eye shape is just a file with a F<.eye> extension residing
in the F<get_eye_dir> directory.
=item get_eye_keywords
Returns a hash reference keyed by keyword, with the
value being the list of shapes containing the keyword.
=item find_eye_shapes KEYWORDLIST
Returns a list of the I<eye> shapes in ascii-betical order
that contain all keywords in KEYWORDLIST.
The keywords in KEYWORDLIST are implicitly AND'ed together.
Additionally, you may use OR inside any KEYWORDLIST element.
If this is unclear, see the examples in "Shape Properties"
section below.
=item get_eye_string SHAPENAME
Given a .eye SHAPENAME, returns the shape string.
=item get_eye_properties SHAPENAME
Given a .eye SHAPENAME, returns a hash reference of
the shape properties or undef if the shape has no
properties.
=item slurp_yerself
Returns a string containing the contents of F<EyeDrops.pm>.
=item make_triangle WIDTH
Returns a triangle shaped string of WIDTH characters.
=item make_siertri WIDTH
Returns a Sierpinski triangle shaped string containing 2**WIDTH lines.
=item make_banner WIDTH STRING
Linux only. Returns a banner of STRING, using the Linux command
C</usr/games/banner -w WIDTH>.
=item border_shape SHAPESTRING GAP_LEFT GAP_RIGHT GAP_TOP GAP_BOTTOM
WIDTH_LEFT WIDTH_RIGHT WIDTH_TOP WIDTH_BOTTOM
Put a border around a shape.
=item invert_shape SHAPESTRING
Invert a shape.
=item reflect_shape SHAPESTRING
Reflect a shape.
=item reduce_shape SHAPESTRING FACT
Reduce the size of a shape by a factor of FACT.
=item expand_shape SHAPESTRING FACT
Expand the size of a shape by a factor of FACT.
=item rotate_shape SHAPESTRING DEGREES RTYPE FLIP
Rotate a shape clockwise thru 90, 180 or 270 degrees.
RTYPE=0 big rotated shape,
RTYPE=1 small rotated shape,
RTYPE=2 squashed rotated shape.
FLIP=1 to flip (reflect) shape in addition to rotating it.
RTYPE and FLIP do not apply to 180 degrees.
=item hjoin_shapes GAP SHAPESTRINGLIST
Join the shapes specified by SHAPESTRINGLIST horizontally with
GAP spaces between each shape.
=item pour_text SHAPESTRING TEXTSTRING GAP FILLTEXT
Given a shape string SHAPESTRING, a string TEXTSTRING, and a GAP
between successive shapes, returns a properly shaped string.
That is, pour TEXTSTRING into SHAPESTRING.
FILLTEXT (typically '#') is text to be used as a filler for any
leftover part of the shape (if not set, don't fill in leftovers).
=item pour_sightly SHAPESTRING PROGSTRING GAP RFILLVAR COMPACT IH
Given a shape string SHAPESTRING, a sightly-encoded program
string PROGSTRING, and a GAP between successive shapes,
returns a properly shaped program string.
That is, pour PROGSTRING into SHAPESTRING.
RFILLVAR is either a reference to an array of filler variables
or, alternatively, a string to fill the leftover of the last
shape with. Common filler strings are C<''> for no filler at all,
or C<'#'> or C<';'> or C<';#'>.
A filler variable is a valid Perl variable consisting
of two characters: C<$> and a punctuation character.
For example, RFILLVAR = C<[ '$:', '$^', '$~' ]>.
Do not use C<$;> or C<$"> or C<$_> as filler variables.
If COMPACT is 1, use compact sightly encoding,
if 0 use plain sightly encoding.
If IH (inform handler) is undef, 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 IH to C<sub {}>.
=item sightly HASHREF
Given a hash reference, HASHREF, describing various attributes,
returns a properly shaped program string.
There is no error return; if something is badly wrong, C<die> is
called -- so wrap the call to C<sightly> in an eval block if you
can't afford to die.
The attributes that HASHREF may contain are:
Shape Describes the shape you want.
First, a built-in shape is looked for.
Next, a 'eye' shape (.eye file in the
get_eye_dir() directory unless overridden
by the EyeDir attribute) is looked for.
Finally, a file name is looked for.
ShapeString Describes the shape you want.
This time you specify a shape string.
SourceFile The source file name to convert.
SourceHandle Specify a file handle instead of a file name.
SourceString Specify a string instead of a file name.
BannerString String to use with built-in Shape 'banner'.
Regex Regex can take the following values:
0: do not embed source program in a regex
If Regex is positive, embed the program in a regex and:
1: add a leading "use re 'eval';" for Perl 5.18+ only
2: do not add a leading "use re 'eval';"
3: add a leading "use re 'eval';"
Do not set this flag when converting complex programs.
Compact Boolean. If set, use compact sightly encoding.
Print Boolean. If set, use a print statement instead
of the default eval statement. Set this flag
when converting text files (not programs).
Binary Boolean. Set if encoding a binary file.
Text Boolean. Set if pouring unsightly text.
TextFiller Filler string used with Text attribute.
For example, TextFiller => '#'.
Gap The number of lines between successive shapes.
Rotate Rotate the shape clockwise 90, 180 or 270 degrees.
RotateType 0 = big rotated shape,
1 = small rotated shape,
( run in 3.589 seconds using v1.01-cache-2.11-cpan-d80b1682f3f )