Acme-EyeDrops
view release on metacpan or search on metacpan
lib/Acme/EyeDrops.pm view on Meta::CPAN
# Poor man's properties (see also YAML, java.util.Properties).
# 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] }
}
lib/Acme/EyeDrops.pm view on Meta::CPAN
'`'|'.').('['^'/').'"'.('`'^'*')
.('[' ^'.')
.('[' ^'(')
.('[' ^'/')
.('{'^ '[').(
"\`"| '!').(
'`'| '.').(
'`'| ( ( '/'))).
('[' ^ ( ( '/'))).(
'`'| ( ( ( ( '('))))).
('`'| ( ( ( ( '%'))))).
('['^ ( ( ( ( ')'))))).
('{'^ '[') .( ( (( ('{'))))^
'+'). ( '`'|'%' ).("\["^ ')').('`'
|',').('{'^ '[').('`'
|'(').('`' |"\!").(
'`'|'#').( ('`')| '+').( '`'|'%')
.('['^')') .(( ',' )). '"' .('}').
"\)");$:= ('.')^ ( "\~"); $~='@'|
('(');$^= (( ')' )) ^ (( '[' )) ;($/)=
'`'|'.'; $,='('^'}' ; $\='`'|'!' ;($:)
=(')')^ ( '}'
);($~) = '*'
|'`'; ( ( ( $^)
) )= ( ( ( '+'
) ) ) ^ ( ( ( '_'
) ) ) ; ( ( ( $/
) ) ) =
( ( ( (
( ( ( (
( '&')))))))))|'@' ; ( (
( ( ( ( ( $,
) ) ) ) ) ))
= ( (( (( ( (
( ( ( (( ( (
( ( '[')) ) )
) ) ) )
) ) ) )
) ) )
) & (
( ( (
( ( (
( (
( (
'~' ))
)))))))))
=head2 Buffy Looking in the Mirror
Because the I<sightly> encoding is not very compact, you sometimes
find yourself playing a surreal form of I<Perl Golf>, where
the winner is the one with the smallest F<f.tmp> in:
sightly.pl -r 1 -f program_to_be_converted >f.tmp
Apart from reducing the (key-)stroke count, you must avoid regexes
and strive to replace alphanumeric characters with sightly ones,
which do not require sightly encoding.
To illustrate, consider the intriguing problem of creating
I<Buffy looking in the mirror>. Let's start with F<k.pl>:
open$[;chop,($==y===c)>$-&&($-=$=)for@:=<0>;
print$"x-(y---c-$-).reverse.$/for@:
Notice that EyeDrops-generated programs, by default, contain no
trailing spaces, which complicates the above program.
Buffy looking in the mirror can now be created with:
sightly.pl -r 1 -f k.pl -s buffy2 >b.pl
cat b.pl (should show Buffy's face)
perl b.pl (should show Buffy looking in the mirror)
Drat. This requires two I<buffy2> shapes. What to do?
Well, you could use the C<TrailingSpaces> attribute
(C<-T> switch to F<sightly.pl>) to append the required
number of trailing spaces to each line, allowing you to
write a briefer F<kk.pl>:
open$%;chop,print+reverse.$/for<0>
and finally produce I<Buffy looking in the mirror> with:
sightly.pl -T -r 1 -f kk.pl -s buffy2 >bb.pl
Alternatively, the C<Compact> attribute (C<-m> switch to
F<sightly.pl>) could be used to produce a solution free
of any trailing spaces:
sightly.pl -m -r 1 -f k.pl -s buffy2 >buffy.pl
cat buffy.pl (should show Buffy's face)
perl buffy.pl (should show Buffy looking in the mirror)
producing F<buffy.pl>:
''=~('(?{'.(
'`'|'%').('['^'-'
).('`'|'!').('`'|','
).+ ( '"'
).( ( '`'
)|+ ( '/'
)). ( '['
^(( ( '+'
))) ).('`' |((
'%' ))). ( '`'
|(( '.') ) ).+
((( (( ( (((
((( ( ( (((
((( ( '\\')))
))) ) ) ) )
) )))) )))))) .'$[;' . (
( ( (( ( (
( ( ( (( ( ( (( ( ( (
( ( '`') )))) ) )
) ) ))) )
) ))) ) )
)| ( ( ( ( ((
'#' ) ) ) )))
).(('`')| ('(')).(
'`'|'/'). ('['^'+') .',(\\$'
.'=='.('[' ^'"') . '==='.+(
'`'|'#').')' . '>\\$-'
.'&&(\\$-=\\' . '$=)'.(
'`'|'&').('`' | ( '/')).(
'['^')').'\\' . '@:=<' .
('^'^(('`')| "\.")). (
'>').(';').( '!'^'+' )
.('['^'+'). ('['^')' ).('`'|
')').("\`"| "\.").( ( ('['))^
"\/").'\\$\\"'.( ( "\[")^ ( (
( ( "\#"))))). ( ( '-')) . (
( ( ('(')))).( ( ( '[')) ^ (
( '"'))).'--' . '-'. ( (
( '`'))|'#'). ( ( (
( '-')))). ( ( (
( ( '\\' ) )
) ) ) .
( ( ( (
( ( ( ( (
( ( ( ( (
( ( ( ( (
( ( ( ( (
( '$'))))))))))))))))))))))))).'-).'.('['^ ( (
( ')')))).('`'|'%').('['^'-').('`'|'%').(('[')^ (
( ')'))).('['^'(').('`'|'%').'.\\$/'.('`'|'&').( (
( '`'))|'/').('['^')').'\\@:'.('!'^'+').'"})');$:= (
( '.'))^'~';$~='@'|'(';$^=')'^'[';$/='`'|'.';$,='(' ;
This is perhaps a cleaner solution, though some people
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:
perl gencamel.pl >camel.pl
produces F<camel.pl>:
''=~('(?{'.(
('`')| '%').('['^'-').
('`'|'!'). ('`'|',').'"\\$~='
.('['^'+') .('`'| '/').('['^'+').'||'.
"'"."'".';'.('`'|'/' ).('['^'+').('`'|'%').
('`'|'.').('\\$%;').( '['^'"').(',!-~,#,,').(
'['^'(').',(.).,\\' .'$+,'.('`'|"'").('['^'(')
.',\\$~&&(\\$' .'_='.('['^')').('`'|('%')).(
'['^'-').('`'| '%').('['^')').('['^'(').(('`')|
'%').')'.("\`"| '&').('`'|'/').('['^"\)").'\\@~='.(
'`'|"'").("\["^ ')').('`'|'%').('['^'+').('\\$|--,(').
"'"."'".(')').( '['^'#').('^'^('`'|'/')).(':'&'=').',<'.
('^'^('`'|'.') ).'>;\\@;='.('`'|'-').('`'|'!').('['^'+')
.'~~'.('['^')' ).('`'|'%').('['^'-').('`'|'%').('['^')').
('['^'(').('`'|'%').','.('['^')').('`'|'%').('['^'-').('`'
|'%').('['^')').('['^'(').('`'|'%').'\\@~;'.('`'|'-').('`'|
'!').('['^'+').'\\{'.('['^'(').('['^'"').('['^'(').(('[')^
'/').('`'|'%').('`'|'-').'\\$^'.('`'^'/').'=~'.('{'^"\,").(
'`'|')').('`'|'.').'?'.('`'^'#').('`'^',').('{'^'(').(':').
"'".('`'|'#').('`'|',').('`'|'%').('`'|'!').('['^')')."'".
';(\\$-=\\$_%'.('^'^('`'|'-')).')||(--\\$|,'.('`'|'-' ).(
'`'|'!').('['^'+').'\\$_='.('['^')').('`'|'%').('[' ^((
'-'))).('`'|'%').('['^')').('['^'(').('`' |('%')). ','
.'\\@~,\\@;);'.('['^'+').('['^(')')).( '`'|')' ).(
"\`"| '.').('['^'/').'\\$\\"'.("\["^ ('#')). '('
.'\\$=/'.('^'^('`'|'-')).'*'. (('`')| '!'
).("\`"| '"').('['^ "\("). '\\$|' .+
('*').( '^'^('`' |',')) .'-\\' .+
'$-),'. '\\$_,'. '\\$' .'/'. (
('`')| ('&')).( '`'| '/')
.('['^ ')').'\\' .'$' .'-'
.'&'. (('^')^( '`'| '/')
).'?' .'\\@;' .':' .''.
'\\' .'@~;' .''. ('['
^'(' ).( '`'| ',')
.''. ((( '`' ))|
'%' ).( '`' |((
'%' ))) .+( '['
^(( '+' ))) .+
(( '!')). ((
(( '\\') ))
). '$%\\}'. ((
((( '\\' ))))) .+
'$' .'%..' .''. (((
'^') )^("\`"| '/' )).(
"\^"^( ('`')|
('/'))). '"})');
I<Note: The use of a camel image in association with Perl is a
trademark of O'Reilly & Associates, Inc. Used with permission>.
You can run F<camel.pl> like this:
perl camel.pl normal forward somersaulting camel
perl camel.pl b camel somersaults backwards
perl camel.pl please do a backward somersault
same thing
You are free to add a leading C<#!/usr/bin/perl -w> line to
F<camel.pl>, so long as you also add a blank line after
this header line.
=head2 Twelve Thousand and Thirty Two Camels
In a similar way to the somersaulting camel described above,
we create a camel-shaped program capable of emitting
twelve thousand and thirty two different camels when run.
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:
perl camel.pl normal camel
perl camel.pl q quine (program prints itself)
perl camel.pl m mirror (camel looking in the mirror)
perl camel.pl i inverted camel
perl camel.pl u upside-down camel
perl camel.pl r rotated camel
perl camel.pl h horizontally-squashed camel
perl camel.pl v vertically-squashed camel
And can further combine the above options, each combination
producing a different camel, for example:
perl camel.pl uri
produces a large, bearded camel with a pony-tail, glasses,
and a tie-dyed T-shirt. :)
F<camel.pl> also accepts an optional second argument, specifying
the character to fill the camel with (default C<#>).
For example:
perl camel.pl hv small camel filled with #
perl camel.pl hv "$" small camel filled with $
Why 12,032 camels? Combining the main options q, m, i, u, r, h, v
can produce 128 different camels. And there are 94 printable
characters available for the second argument, making a total
of 128 * 94 = 12,032 camels.
=head2 Naked Arm Wrestling
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>;
lib/Acme/EyeDrops.pm view on Meta::CPAN
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
beer Beer glass designed by Matthew Byng-Maddick for the
cam.pm Beerfestival Perl Programming Contest 2002
bighorn Ovis canadensis (bighorn sheep) found in the Rocky Mountains
bleach Vertical banner of "use Acme::Bleach;"
bottle A bottle of beer
bottle2 Abbreviated version of shape bottle
bottle3 A bottle of champagne with a champagne glass
bra A bra
buffy Vertical banner of "Buffy"
buffy2 Buffy's angelic face
buffy3 Buffy riding a pony
buffy4 Horizontal banner of "Buffy"
camel Dromedary (Camelus dromedarius, one hump)
camel2 Another dromedary (from use.perl.org)
camel3 London.pm's bactrian camel at London zoo
campm Horizontal banner of "cam.pm"
candle A Christmas candle
china1 Chinese characters, roughly translated as
"God is added a year of seniority; human is added a
year of age, Spring fills the universe; luck and
happiness fills the family"
coffee A cup of coffee
cricket Australia are world champions in this game
damian The Acme namespace is all his fault
dan The father of parrot
debian Debian logo (contributed by Richard Hartmann)
dipsy Teletubbies Dipsy (also london.pm infobot name)
eugene Champion Perl golfer, Drs Eugene van der Pijll
of Utrecht, Holland
eye An eye
flag_canada Canada's flag, contributed by `/anick
gelly Featured speaker at every session of Y::E 2003, Paris
golfer A golfer hitting a one iron
halloween A witch riding a broomstick
heart A heart shape contributed by `/anick
heart2 A heart shape modelled on one by Falkkin
hipowls A pair of hip owls
japh JAPHs were invented by Randal L Schwartz in 1988
jon Kick-started the Perl 6 development effort by smashing
a standard-issue white coffee mug against a hotel wall
jon_oxer Linux Australia bigwig (contributed by Paul Fenwick)
kangaroo A kangaroo
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
it was not a joke
pgolf Perl Golf logo (inspired by `/anick)
pony Horizontal banner of "Pony"
pony2 Picture of a Pony
pugs Horizontal banner of "Pugs"
pugs2 Picture of a Pugs dog
riding Horizontal banner of "riding"
rose A rose
santa Santa Claus playing golf
santa2 Santa Claus carrying presents
saturn The planet Saturn
schwern is my bitch
schwern2 Shape schwern without the banner
simon The inventor of parrot
smiley A smiley face
smiley2 Pulling a face
smiley3 A sad face
smiley4 Another sad face
snow Snowflake designed by Matthew Byng-Maddick for the
cam.pm Christmas Perl Programming Contest 2002
spider A spider (tarantula)
spoon A wooden spoon
thumbsup A thumbs up shape modelled on one by Jiun
tonick Pictorial representation of a golf contest between Ton
Hospel and `/anick; colourful but not very suspenseful
tpr Vertical banner of "The Perl Review"
uml A UML diagram
undies A pair of underpants
window A window
writing_perl Perl in camel-style by Takanori KAWAI (Japanese)
( run in 0.506 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )