Acme-EyeDrops
view release on metacpan or search on metacpan
- Build.PL: fixed for Module::Build v0.19
1.40 Sun June 29 11:19:33 2003
- There were getting to be too many .eye files cluttering the
vitally important Acme root directory, so I moved them from
Acme directory to Acme/EyeDrops directory (if you have installed
a previous version of Acme::EyeDrops, suggest you delete old
.eye files in the Acme root directory)
- new shape: flag_canada (to mark Canada day, thanks `/anick)
- new shape: map_australia
- new shape: hipowls
- new built-in shape: all
- minor change to shape: rose
- removed demo/helloworld.pl from distribution
- removed demo/hellotest.pl from distribution
- removed demo/examples.pl from distribution
- updated test programs to not rely on demo directory
1.41 Sun July 27 18:22:04 2003
it by never using $_ as a filler variable
- sightly.t: run generated test programs in taint mode
- tests: renamed to more appropriate names
- tests: new long running test 13_to.t
- documentation: added "Getting Started" section
- documentation: fixed program in "Naked Arm Wrestling" section
- documentation: updated 'Abbreviated History of Perl 6' section
1.43 Sun Aug 31 17:12:55 2003
- new shapes: alpaca, bighorn, map_italy
- removed functions set_eye_dir, add_builtin_shape, del_builtin_shape
which were mistakenly added to version 1.41 (these are not really
necessary and change module state, which is a Bad Thing)
- documentation: added 'twang bra-strap' to acme shape description
- tests: merged old 13_to.t, old 12_Beer.t to new 19_surrounds.t
new Test::Pod test, 18_sky.t
11_bold.t now tested in taint mode (no banner test)
12_Beer.t now banner test only (not taint safe)
1.44 Sun Apr 25 19:07:41 2004
- Bug fix release for Perl 5.8.4: some of the tests broke because
they were naughtily exploiting a Perl bug re use strict inside
(?{...}) constructions in regexps (see 01_mug.t/05_Parrot.t)
- new shapes: map_world1, map_world2, map_world3, map_japan, map_uk
- new shapes: music, dan, bottle3
- Build.PL: fixed for Module::Build v0.24 (_find_file_by_type changed)
- new attribute: SourceHandle
- new test: 14_gulp.t tests SourceHandle (and other invalid attributes)
- minor code improvements (removed $this_dir, check for invalid
attrs in sightly(), allow SourceFile/SourceString of '0')
- documentation: updated stale URL links
1.45 Mon Dec 27 17:15:04 2004
lib/Acme/EyeDrops/koaladile.eye
lib/Acme/EyeDrops/koaladile.eyp
lib/Acme/EyeDrops/larry.eye
lib/Acme/EyeDrops/larry.eyp
lib/Acme/EyeDrops/larry2.eye
lib/Acme/EyeDrops/larry2.eyp
lib/Acme/EyeDrops/llama.eye
lib/Acme/EyeDrops/llama.eyp
lib/Acme/EyeDrops/london.eye
lib/Acme/EyeDrops/london.eyp
lib/Acme/EyeDrops/map_australia.eye
lib/Acme/EyeDrops/map_australia.eyp
lib/Acme/EyeDrops/map_italy.eye
lib/Acme/EyeDrops/map_italy.eyp
lib/Acme/EyeDrops/map_japan.eye
lib/Acme/EyeDrops/map_japan.eyp
lib/Acme/EyeDrops/map_uk.eye
lib/Acme/EyeDrops/map_uk.eyp
lib/Acme/EyeDrops/map_world1.eye
lib/Acme/EyeDrops/map_world1.eyp
lib/Acme/EyeDrops/map_world2.eye
lib/Acme/EyeDrops/map_world2.eyp
lib/Acme/EyeDrops/map_world3.eye
lib/Acme/EyeDrops/map_world3.eyp
lib/Acme/EyeDrops/merlyn.eye
lib/Acme/EyeDrops/merlyn.eyp
lib/Acme/EyeDrops/mongers.eye
lib/Acme/EyeDrops/mongers.eyp
lib/Acme/EyeDrops/moose.eye
lib/Acme/EyeDrops/moose.eyp
lib/Acme/EyeDrops/moosecamel.eye
lib/Acme/EyeDrops/moosecamel.eyp
lib/Acme/EyeDrops/mosquito.eye
lib/Acme/EyeDrops/mosquito.eyp
demo/gentable.pl view on Meta::CPAN
# gentable.pl.
# Generate table used by EyeDrops.pm
use strict;
my @C = map {"'" . chr() . "'"} 0..255;
$C[39] = q#"'"#;
my $q;
# 'a'..'o' (97..111)
for (33..47) {
$C[$_+64] = q#('`'|#.($q=$_==39?'"':"'").chr()."$q)";
}
# 'p'..'z' (112..122)
my $c=112;
for (43,42,41,40,47,46,45,44,35,34,33) {
demo/gentable.pl view on Meta::CPAN
$C[92] = q#'\\\\'.'\\\\'#;
$C[34] = q#'\\\\'.'"'#;
$C[36] = q#'\\\\'.'$'#;
$C[64] = q#'\\\\'.'@'#;
$C[123] = q#'\\\\'.'{'#;
$C[125] = q#'\\\\'.'}'#;
# 128..255
# for my $i (128..255) {
# $C[$i] = join('.', q#'\\\\'#,
# $C[120], map($C[$_], unpack('C*', sprintf('%x', $i))));
# }
print " # This table was generated by demo/gentable.pl.\n";
print " my \@C = (";
for my $i (0..127) { $C[$i] =~ s/\\/\\\\/g }
for my $i (0..47) {
my $l = $i%4==0 ? "\n " : "";
print "${l}q Z$C[$i]Z,";
}
for my $i (48..57) {
lib/Acme/EyeDrops.pm view on Meta::CPAN
q Z'\\\\'.'\\\\'Z,q Z']'Z,q Z'^'Z,q Z'_'Z,
q Z'`'Z,q Z('`'|'!')Z,q Z('`'|'"')Z,q Z('`'|'#')Z,
q Z('`'|'$')Z,q Z('`'|'%')Z,q Z('`'|'&')Z,q Z('`'|"'")Z,
q Z('`'|'(')Z,q Z('`'|')')Z,q Z('`'|'*')Z,q Z('`'|'+')Z,
q Z('`'|',')Z,q Z('`'|'-')Z,q Z('`'|'.')Z,q Z('`'|'/')Z,
q Z('['^'+')Z,q Z('['^'*')Z,q Z('['^')')Z,q Z('['^'(')Z,
q Z('['^'/')Z,q Z('['^'.')Z,q Z('['^'-')Z,q Z('['^',')Z,
q Z('['^'#')Z,q Z('['^'"')Z,q Z('['^'!')Z,q Z'\\\\'.'{'Z,
q Z'|'Z,q Z'\\\\'.'}'Z,q Z'~'Z,q Z('!'^'^')Z
);
push @C, map(join('.', q#'\\\\'#, $C[120],
map($C[$_], unpack('C*', sprintf('%x', $_)))), 128..255);
sub ascii_to_sightly { join '.', map($C[$_], unpack('C*', $_[0])) }
}
sub sightly_to_ascii { eval eval q#'"'.# . $_[0] . q#.'"'# }
sub regex_print_sightly {
q#''=~('('.'?'.'{'.# . ascii_to_sightly('print') . q#.'"'.# .
&ascii_to_sightly . q#.'"'.'}'.')')#;
}
sub regex_binmode_print_sightly {
q#''=~('('.'?'.'{'.# . ascii_to_sightly('binmode(STDOUT);print')
lib/Acme/EyeDrops.pm view on Meta::CPAN
}
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);
}
lib/Acme/EyeDrops.pm view on Meta::CPAN
[ 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) {
lib/Acme/EyeDrops.pm view on Meta::CPAN
for my $l (@a) { $m = length($l) if length($l) > $m }
for my $l (@a) { $l .= ' ' x ($m - length($l)) }
my $s = join("\n", @a, ""); $s =~ tr/ #/# /;
$s =~ s/ +$//mg; $s;
}
sub reflect_shape {
my $tlines = shift;
my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
for my $l (@a) { $m = length($l) if length($l) > $m }
my $s = join("\n", map(scalar reverse($_ . ' ' x ($m - length)), @a), "");
$s =~ s/ +$//mg; $s;
}
sub hjoin_shapes {
my ($g, @shapes) = @_;
my $ml = 0; my @lines;
for my $s (@shapes) { my $n = $s =~ tr/\n//; $ml = $n if $n > $ml }
for my $tlines (@shapes) {
my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
for my $l (@a) { $m = length($l) if length($l) > $m }
lib/Acme/EyeDrops.pm view on Meta::CPAN
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/ $//;
lib/Acme/EyeDrops.pm view on Meta::CPAN
# 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,
lib/Acme/EyeDrops.pm view on Meta::CPAN
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}, $_)),
split(/,/, $arg{Shape})));
} elsif ($arg{Width}) {
die "invalid width $arg{Width} (must be > 3)"
if !$arg{Text} && $arg{Width} < 4;
$shape = '#' x $arg{Width};
}
$shape or return "use re 'eval';\n" x ($arg{Regex} == 3 || ($arg{Regex} == 1 && $] >= 5.017)) . $sightly;
$arg{Rotate} and $shape = rotate_shape($shape, $arg{Rotate},
$arg{RotateType}, $arg{RotateFlip});
lib/Acme/EyeDrops.pm view on Meta::CPAN
'local $SIG{__WARN__}=sub{};' x $arg{TrapWarn} .
pour_sightly($shape, $sightly, $arg{Gap}, $fill, $arg{Compact},
$arg{InformHandler}) . "\n\n\n;die \$\@ if \$\@\n" x $arg{TrapEvalDie};
}
# -------------------------------------------------------------------------
sub _get_eye_shapes {
my $d = shift;
opendir my $dh, $d or die "opendir '$d': $!";
my @e = sort map(/(.+)\.eye$/, readdir($dh));
closedir($dh); @e;
}
sub _get_eye_string { _slurp_tfile($_[0] . '/' . $_[1] . '.eye') }
sub _get_eye_properties {
my $f = $_[0] . '/' . $_[1] . '.eyp';
-f $f or return;
_get_properties($f);
}
lib/Acme/EyeDrops.pm view on Meta::CPAN
exists($p->{keywords}) or next SHAPE; # no keywords property
my @k = split(" ", $p->{keywords}) or next SHAPE; # no keywords
for my $k (@k) { push(@{$h{$k}}, $s) }
}
return \%h;
}
sub _find_eye_shapes {
my $d = shift;
@_ or die "oops, no keywords given";
my @skey = map([split/\s+OR\s+/], @_);
my @ret;
SHAPE: for my $s (_get_eye_shapes($d)) {
my $p = _get_eye_properties($d, $s) or next SHAPE; # no properties
exists($p->{keywords}) or next SHAPE; # no keywords property
my @k = split(" ", $p->{keywords}) or next SHAPE; # no keywords
my %h; @h{@k} = ();
for my $k (@skey) {
# XXX: short-circuiting List::Util::first() better than grep here.
grep(exists($h{$_}), @{$k}) or next SHAPE; # AND, all must be true
}
lib/Acme/EyeDrops.pm view on Meta::CPAN
find the plain sightly encoding more pleasing to the eye.
Showing the face upside down, rather than reflected, is more
easily solved with:
open$%;print+reverse<0>
and easier still for a self-printing shape:
open$%;print<0> # self printing
open$%;print+map{y;!-~;#;;$_}<0> # replace sightly with '#'
=head2 A Somersaulting Camel
Let's extend the Buffy example of the previous section to produce
a camel-shaped program capable of somersaulting across the screen
when run.
We start with a generator program, F<gencamel.pl>:
print sightly( { Regex => 1,
Compact => 1,
RemoveNewlines => 1,
Indent => 1,
BorderGapRight => 1,
Shape => 'camel',
SourceString => <<'END_SRC_STR' } );
$~=pop||'';open$%;
y,!-~,#,,s,(.).,$+,gs,$~&&($_=reverse)for@~=grep$|--,('')x18,<0>;
@;=map~~reverse,reverse@~;
map{system$^O=~Win?CLS:'clear';
($-=$_%3)||(--$|,map$_=reverse,@~,@;);
print$"x($=/3*abs$|*2-$-),$_,$/for$-&1?@;:@~;
sleep!$%}$%..11
END_SRC_STR
Note the use of the Compact and RemoveNewlines attributes,
necessary here to squeeze the above program into a single
camel shape.
Running this program:
lib/Acme/EyeDrops.pm view on Meta::CPAN
As usual, we start with a generator program, F<gencamel.pl>:
print sightly( { Regex => 1,
Compact => 1,
RemoveNewlines => 1,
BorderGap => 1,
Shape => 'camel',
SourceString => <<'END_SRC_STR' } );
$~=uc shift;$:=pop||'#';open$%;chop(@~=<0>);$~=~R&&
(@~=map{$-=$_+$_;join'',map/.{$-}(.)/,@~}$%..33);
$|--&$~=~H&&next,$~!~Q&&eval"y, ,\Q$:\E,c",$~=~I&&
eval"y, \Q$:\E,\Q$:\E ,",$~=~M&&($_=reverse),
print$~=~V?/(.).?/g:$_,$/for$~=~U?reverse@~:@~
END_SRC_STR
Running this program:
perl gencamel.pl >camel.pl
produces F<camel.pl>, which you can run like this:
lib/Acme/EyeDrops.pm view on Meta::CPAN
The final auction at Y::E 2002 in Munich featured an epic athletic
contest which you can remember with:
use Acme::EyeDrops qw(sightly);
my $s = sightly( { Regex => 1,
Shape => 'naw',
Indent => 1,
SourceString => <<'NAKED_ARM_WRESTLING' } );
$/='';open$%;$x=<0>;$y=<0>;
substr($y,428,$%)=' AAAAARRRGGGHHH!!!';
map{system$^O=~Win?CLS:'clear';
print$_&1?$y:$x;sleep!$%+($_&1)}$%..9
NAKED_ARM_WRESTLING
$s =~ s/ +$//m;
print $s;
=head2 Baghdad Bob
Running this program:
print sightly( { Shape => 'baghdad',
lib/Acme/EyeDrops.pm view on Meta::CPAN
print sightly( { Regex => 1,
ShapeString => join("\n", (hjoin_shapes(3,
(get_eye_string('bottle2'))x3))x33),
SourceString => $ninety_nine } );
=head2 Sierpinski Triangles
A simple and concise Sierpinski triangle generator, F<siertri.pl>, is:
#!perl -l
$x=2**pop;print$"x--$x,map$x&$_?$"x2:"/\\",0..$y++while$x
which was posted by Mtv Europe to golf@perl.org on 14-sep-2002
as a one stroke improvement on Adam Antonik's original program.
Running:
perl siertri.pl 4
displays a Sierpinski triangle with 2**4 lines.
Proclaiming Mtv's program as the shortest (in Acme::EyeDrops 1.13)
only served to provoke Adam Antonik and Eugene van der Pijll into
shortening it by exploiting a hard C<$^F>, as shown in some of the
examples below:
-l print$"x--$x,map$x&$_?$"x2:"/\\",0..$_-1for 1..($x=2**pop)
-l $x=2**pop;print$"x--$x,map$x&$_?$"x2:"/\\",0..$y++while$x
-l $^F**=pop;print$"x--$^F,map$^F&$_?$"x2:"/\\",0..$y++while$^F
-lX061 print$"x--$/,map$/&$_?$"x2:"/\\",0..$y++while$/<<=pop
-l print$"x--$^F,map$^F&$_?$"x2:"/\\",0..$y++while$^F*=2**pop
-l $_=$"x2**pop;$_="$'/\\",print,s/(?<=\\)../$&^KI^D5/egwhile/^ /
An interesting obfuscated Sierpinski triangle generator is:
#!/usr/bin/perl -l
s--@{[(gE^Ge)=~/[^g^e]/g]}[g^e]x((!!+~~g^e^g^e)<<pop).!gE-ge,
s-[^ge^ge]-s,,,,s,@{[(g^';').(e^'?')]},(G^'/').(E^'|')^Ge,ge,
print,s,(?<=/[^g^e])[^g^e][^g^e],$&^(G^'/').(E^'|')^gE,ge-ge
As an alternative obfu, you can produce a Sierpinski triangle-shaped
lib/Acme/EyeDrops.pm view on Meta::CPAN
RemoveNewlines => 1,
Indent => 1,
BorderGap => 1,
BorderWidth => 2,
# For 'siertri' built-in shape, Width=>5 means:
# height is 2**5 lines
# width is 2 * 2**5 characters
Width => 5,
Shape => 'siertri',
SourceString => <<'END_SRC_STR' } );
$-=!$%<<(pop||4);print$"x$-,map($-&$_?' ':'/\\',$%..$.++),$/while$---
END_SRC_STR
producing:
''=~('(?{'.('`'|'%').('['^'-').('`'|'!').('`'|"\,").'"\\$-=!\\$%<<('.(
'['^'+').('`'|'/').('['^'+').'||'.('^'^('`'|'*')).');'.('['^'+').('['^
(( ((
(( (( ((
(( ')') ))
)) )) )) ))
lib/Acme/EyeDrops.pm view on Meta::CPAN
To illustrate, consider an entry in the I<Cam.pm> 2002 Christmas
programming contest, F<snowing.pl>:
$_=q~vZvZ&%('$&"'"&(&"&$&"'"&$Z$#$$$#$%$&"'"&(&#
%$&"'"&#Z#$$$#%#%$%$%$%(%%%#%$%$%#Z"%*#$%$%$%$%(%%%#%$%$
%#Z"%,($%$%$%(%%%#%$%$%#Z"%*%"%$%$%$%(%%%#%$%$%#Z#%%"#%#%
$%$%$%$##&#%$%$%$%#Z$&""$%"&$%$%$%#%"%"&%%$%$%#Z%&%&#
%"'"'"'###%*'"'"'"ZT%?ZT%?ZS'>Zv~;
s;\s;;g;
$;='@,=map{$.=$";join"",map((($.^=O)x(-33+ord)),/./g),$/}split+Z;
s/./(rand)<.2?"o":$"/egfor@;=((5x84).$/)x30;map{
system$^O=~W?CLS:"clear";print@;;splice@;,-$_,2,pop@,;
@;=($/,@;);sleep!$%}2..17';
$;=~s;\s;;g;eval$;
The rules of this contest state that the program source code must fit
precisely into the provided snowflake shape. To comply, you can pour
the above program into the required shape with:
sightly.pl -s snow -f snowing.pl -t -u# -n1 >snowflake.pl
lib/Acme/EyeDrops.pm view on Meta::CPAN
$_= q~v
ZvZ&%(' $&"'"&(
&"& $&"' "&$Z$#$$$#$%$& "'"& (&#
%$&"'"&#Z#$$ $#%# %$%$%$%(%%%#
%$%$%#Z"%*#$ %$%$ %$%(%%%#%$%$
%# Z"%, ($% $% $%( %%%# %$
%$% #Z" %*%" %$ %$%$ %(% %%#
%$%$%# Z#%%"#%#%$ %$ %$%$##&#%$ %$%$%#
Z$ &""$%"&$%$%$%#%"%"&%%$%$%#Z%&% &#
%"'"'"'###%*'"'"'"ZT%?ZT%?ZS'>Zv~;s;\s;;g;$;='@,=map
{$.= $";join"" ,map((($ .^=O)x(- 33+ord)), /./g
),$ /}split +Z;s/. /(rand )<.2?"o ":$
"/eg for@;=((5 x84).$/) x30;map{ system$^O =~W?
CLS:"clear";print@;;splice@;,-$_,2,pop@,;@;=($/,@;);
sl eep!$%}2..17';$;=~s;\s;;g;eval $;
###### ########## ## ########## ######
### ### #### ## #### ### ###
## #### ### ## ### #### ##
############ #### ############
############ #### ############
### #### ############## #### ###
####### #######
### ###
lib/Acme/EyeDrops.pm view on Meta::CPAN
&"& $&"' "&$Z$#$$$#$%$& "'"& (&#
%$&"'"&#Z#$$ $#%# %$%$%$%(%%%#
%$%$%#Z"%*#$ %$%$ %$%(%%%#%$%$
%# Z"%, ($% $% $%( %%%# %$
%$% #Z" %*%" %$ %$%$ %(% %%#
%$%$%# Z#%%"#%#%$ %$ %$%$##&#%$ %$%$%#
Z$ &""$%"&$%$%$%#%"%"&%%$%$%#Z%&% &#
%"'"'"'###%*'"'"'"ZT%?ZT%?ZS'>Zv~;s;\s;;g;$~=q~ZZZJ_
#_ZH /'\\ZG|#o #o#|ZG|$ <%|ZH\\" \\!_!_!/" /ZG/
)\\ ZF/+\\Z E|-|ZE |-|ZE| -|ZF\\+ /ZG
\\)/ ~;;@x=@,= +map{$.= $";;join "",map((( $.^=
O)x(-33+ord)),/./g)}split+Z;$~=~s~\s~~g;;s;.;(rand)<
.2 ?"o":$";egxfor@;=(5x84)x30;map {#
system $^O=~W?CLS :+ "clear";;; ;print
$_. $/, ,for $_ -18? @;: ###
(( map{ $|= 1; ;;; join ""
,map($|--?$" x(-3 *11+ord):$_,
/./g)}split+ Z,$~ ),@x);splice
@;, -$_, 2,pop@,;@;=("" ,@;) ;;;
;sleep! $%}+2..
18# /-\
=head1 REFERENCE
=head2 Sightly Encoding
There are 32 characters in the sightly character set:
lib/Acme/EyeDrops.pm view on Meta::CPAN
kansai_pm Kansai.pm's mascot (Tiger with Perl characters)
contributed by Takanori KAWAI (Japanese)
kermit Kermit the frog
koaladile A cross between a koala and a crocodile
larry Wall, Larry (as opposed to Russell Wall who is
Wall, Russ)
larry2 Caricature of Larry contributed by Ryan King
llama Llamas are so closely related to camels they can
breed with them (their progeny are called camas)
london Haiku "A Day in The Life of a London Perl Monger"
map_australia Map of Australia
map_italy Map of Italy
map_japan Map of Japan
map_uk Map of United Kingdom and Ireland
map_world1 World globe, Asian view
map_world2 World globe, African view
map_world3 World globe, American view
merlyn Just another Perl hacker, aka Randal L Schwartz
mongers Perl Mongers logo
moose A moose
moosecamel A moose and a camel (modelled after http://irclog.perlgeek.de)
mosquito A mosquito
music A musical symbol
naw Naked Arm Wrestling (Y::E 2002, Munich)
opera Opera browser logo (contributed by Cosimo)
panda A panda designed by Yanni Ellen Liu
parrot Originally an April fool's joke, the joke was that
lib/Acme/EyeDrops.pm view on Meta::CPAN
keywords
where valid keywords are:
face
person
perlhacker
animal
object
planet
map
flag
sport
underwear
hbanner
vbanner
logo
debian
opera
To give an example of how shape properties might be used,
lib/Acme/EyeDrops/map_australia.eyp view on Meta::CPAN
description : Map of Australia
keywords : map
lib/Acme/EyeDrops/map_italy.eyp view on Meta::CPAN
description : Map of Italy
keywords : map
lib/Acme/EyeDrops/map_japan.eyp view on Meta::CPAN
description : Map of Japan
keywords : map
lib/Acme/EyeDrops/map_uk.eyp view on Meta::CPAN
description : Map of United Kingdom and Ireland
keywords : map
lib/Acme/EyeDrops/map_world1.eyp view on Meta::CPAN
description : World globe, Asian view
keywords : map planet
lib/Acme/EyeDrops/map_world2.eyp view on Meta::CPAN
description : World globe, African view
keywords : map planet
lib/Acme/EyeDrops/map_world3.eyp view on Meta::CPAN
description : World globe, American view
keywords : map planet
t/00_Coffee.t view on Meta::CPAN
$t1 = "\n";
$f1 = ascii_to_sightly($t1);
$f1 =~ /[^!"#\$%&'()*+,\-.\/:;<=>?\@\[\\\]^_`\{|\}~]/ and print "not ";
print "ok 7\n";
$t1a = sightly_to_ascii($f1);
$t1 eq $t1a or print "not ";
print "ok 8\n";
$t1 = join("", map(chr, 0..255));
$f1 = ascii_to_sightly($t1);
$f1 =~ /[^!"#\$%&'()*+,\-.\/:;<=>?\@\[\\\]^_`\{|\}~]/ and print "not ";
print "ok 9\n";
$t1a = sightly_to_ascii($f1);
$t1 eq $t1a or print "not ";
print "ok 10\n";
# Test 12032 camels example.
$prog = sightly( { Regex => 1,
Compact => 1,
RemoveNewlines => 1,
BorderGap => 1,
Shape => 'camel',
InformHandler => sub {},
SourceString => <<'END_SRC_STR' } );
$~=uc shift;$:=pop||'#';open$%;chop(@~=<0>);$~=~R&&
(@~=map{$-=$_+$_;join'',map/.{$-}(.)/,@~}$%..33);
$|--&$~=~H&&next,$~!~Q&&eval"y, ,\Q$:\E,c",$~=~I&&
eval"y, \Q$:\E,\Q$:\E ,",$~=~M&&($_=reverse),
print$~=~V?/(.).?/g:$_,$/for$~=~U?reverse@~:@~
END_SRC_STR
build_file($tmpf, $prog);
my $camelprog = my $camelprogstr = $prog;
$camelprogstr =~ tr/!-~/#/;
# -------------------------------------------------
t/05_Parrot.t view on Meta::CPAN
Regex => 0,
InformHandler => sub {},
Print => 1 } );
test_one('Bill Gates is a pest!', $srcstr, $windowstr);
# Binary encode/decode -----------------------------
my $encodestr = qq#binmode(STDOUT);print eval '"'.\n\n\n#;
$encodestr =~ tr/!-~/#/;
$encodestr .= $camelstr x 5;
$srcstr = join("", map(chr(), 0..255));
$prog = sightly({ Shape => 'camel',
SourceString => $srcstr,
Binary => 1,
Regex => 0,
InformHandler => sub {},
Print => 1 } );
build_file($tmpf, $prog);
# This seems to stop on CTRL-Z on Windows!
# Something to do with binmode ??
# $outstr = `$^X -w -Mstrict $tmpf`;
t/10_Ponie.t view on Meta::CPAN
my $snow = get_eye_string('snow');
my $src = <<'SNOWING';
$_=q~vZvZ&%('$&"'"&(&"&$&"'"&$Z$#$$$#$%$&"'"&(&#
%$&"'"&#Z#$$$#%#%$%$%$%(%%%#%$%$%#Z"%*#$%$%$%$%(%%%#%$%$
%#Z"%,($%$%$%(%%%#%$%$%#Z"%*%"%$%$%$%(%%%#%$%$%#Z#%%"#%#%
$%$%$%$##&#%$%$%$%#Z$&""$%"&$%$%$%#%"%"&%%$%$%#Z%&%&#
%"'"'"'###%*'"'"'"ZT%?ZT%?ZS'>Zv~;
s;\s;;g;
$;='@,=map{$.=$";join"",map((($.^=O)x(-33+ord)),/./g),$/}split+Z;
s/./(rand)<.2?"o":$"/egfor@;=((5x84).$/)x30;map{
system$^O=~W?CLS:"clear";print@;;splice@;,-$_,2,pop@,;
@;=($/,@;);sleep!$%}2..17';
$;=~s;\s;;g;eval$;
SNOWING
# -------------------------------------------------
my $itest = 0;
my $snowflake = pour_text($snow, "", 1, '#');
my @k = keys(%{$p}) or next;
for my $k (@k) { push(@{$h{$k}}, $s) }
}
return \%h;
}
# Hacked from _get_eye_shapes().
sub _get_eyp_shapes {
my $d = shift; local *D;
opendir(D, $d) or die "opendir '$d': $!";
my @e = sort map(/(.+)\.eyp$/, readdir(D)); closedir(D); @e;
}
# -----------------------------------------------------------------------
# slurp_yerself() tests (primitive)
my $eyedrops_pm = Acme::EyeDrops::slurp_yerself();
my $elen = length($eyedrops_pm);
$elen > 50000 or print "not ";
++$itest; print "ok $itest - slurp_yerself length is $elen\n";
my $nlines = $eyedrops_pm =~ tr/\n//;
++$itest; print "ok $itest - get_eye_keywords, hash ref\n";
my @skey = sort keys %{$h};
@skey == 15 or print "not ";
++$itest; print "ok $itest - get_eye_keywords, number\n";
for my $k ('animal',
'debian',
'face',
'flag',
'hbanner',
'logo',
'map',
'object',
'opera',
'perlhacker',
'person',
'planet',
'sport',
'underwear',
'vbanner') {
shift(@skey) eq $k or print "not ";
++$itest; print "ok $itest - get_eye_keywords, '$k'\n";
t/15_Buffy.t view on Meta::CPAN
print "1..6\n";
my $last_bit = <<'LAST_CAMEL';
############
###### ###############
########## ##################
########## ###### ###################
LAST_CAMEL
my $camelstr = get_eye_string('camel');
my $t1 = join("", map(chr, 0..255));
my $f1 = ascii_to_sightly($t1);
my $shape = pour_sightly($camelstr, $f1, 0, "", 0, sub {});
my $t1a = sightly_to_ascii($shape);
$t1 eq $t1a or print "not ";
print "ok 1\n";
$shape =~ tr/!-~/#/;
$shape eq $camelstr x 4 . $last_bit or print "not ";
print "ok 2\n";
t/16_astride.t view on Meta::CPAN
my $N_Iter = 10;
# plan tests => $Num_Threads * ($N_Iter * 2) + $Num_Threads;
plan tests => $Num_Threads;
sub do_one_thread {
my $kid = shift;
my $rc = 0;
print "# kid $kid start\n";
for my $j (1 .. $N_Iter) {
my $t1 = join("", map(chr, 0..255));
my $f1 = ascii_to_sightly($t1);
# unlike( $f1, qr/[^!"#\$%&'()*+,\-.\/:;<=>?\@\[\\\]^_`\{|\}~]/, 'ascii_to_sightly' );
if ($f1 =~ /[^!"#\$%&'()*+,\-.\/:;<=>?\@\[\\\]^_`\{|\}~]/) {
print STDERR "# $kid, $j: oops 1: $f1 contains unsightly chars\n";
++$rc;
}
my $t1a = sightly_to_ascii($f1);
# is( $t1, $t1a, 'sightly_to_ascii' );
if ($t1 ne $t1a) {
print STDERR "# $kid, $j: oops 2: $t1 ne $t1a\n";
t/19_surrounds.t view on Meta::CPAN
'10_Ponie.t',
'11_bold.t',
'12_Beer.t',
'13_to.t',
'14_gulp.t',
'15_Buffy.t',
'16_astride.t',
'17_Orange.t',
'18_sky.t',
);
my @tests = map("$base/$_", @unames);
my @ztests = map("$base/z$_", @unames);
# Generate sightly-encoded versions of test programs (see also gen.t).
for my $i (0..$#unames) {
$attrs{SourceFile} = $tests[$i];
# Assume first line is #!/usr/bin/perl (needed for taint mode tests).
my $s_new = get_first_line($attrs{SourceFile}) . "# This program was generated by $0\n";
$s_new .= sightly(\%attrs);
build_file($ztests[$i], $s_new);
}
( run in 1.160 second using v1.01-cache-2.11-cpan-49f99fa48dc )