Tested on both Linux and Windows, and requires the Tk module to be installed.
There's a lot more I could add to the basic program, but the obfuscated version was already getting fairly large.
Without giving too much away (and perhaps you've already guessed what it does), the arrow keys work the same as the keys 'h', 'j', 'k' and 'l'. Use ^C to quit, and try the <space> and 'n' keys too.
Visually, there's a nice surprise when it runs (see if you can figure out the trick). I had a lot of fun getting the format "just right", and was pleased to see that "perl -MO=Deparse japh.pl" didn't give anything away :-)
Enjoy!
s''$a=[];$ b=[];$c={} ;$d={};$e=
[];$f={};$ g=[];use`T k;$W=MainW
indow->new ;$W->iconi fy;$W->geo
metry("1x1 -1-1");$W- >repeat(50
=>sub{$h`o r$W->deico nify;$i#0;
if($o){#1i f$h++%5}el sif(!$j){#
1if$h++%20
}if($o){#3 Y=21;$Y>1;
$Y--){my$J =$a#6Y];#3
X=0;$X<@$J ;$X++){my$ V=$J#6X]|| 0;(#7$o->{
$V})#2my$T =#5f->{$Y} ->{$X};my$ Z=$Y+1;$a#
6Y]#6X]=0; $a#6Z]#6X] =$V;$f->{$ Z}->{$X}=$
T;J($T,$X, $Z)}}$o=&M
}my$N=0;#3 Y=2;$Y<22; $Y++){my$J
=$a#6Y];my $K=1;#3X=0 ;$X<@$J;$X
++){(2==$J
#6X])or$K= 0}if($K){+ +$N;$J->[0
]=3}}if($N ){#3Y=2;$Y <22;$Y++){
my$J=$a#6Y ];(3==$J-> [0])#2#3X=
0;$X<@$J;$ X++){$a#6Y ]#6X]=0;(#
5f->{$Y}-> {$X})#4}my $L=5;#3Y=2 ;$Y<22;$Y+ +){my$J=$a
#6Y];#3X=0 ;$X<@$J;$X ++){L($X,$ Y,2,$L++)i f(2==$a#6Y
]#6X])}}$o =&M;$o#0}@ $b`or`do{m
y$M=$n||&I ;@$g`and`D ($g);$n=&I ;my$v=$d-> {$n}->[0];
for(@$v){m y($X,$Y)=@ $_;my$x0=4 24+14*$X;m y$y0=32+14
*$Y;my$G=[ $x0,$y0,14 ,14];my$T= B($c->{$n}
,$G);#8@$g ,[$x0,$y0,
$T];}$m=$M ;my$Q=$d->
{$M}->[0]; $k=0;$b=[]
;for`my$w( @$Q){my($X
,$Y)=@$w;i f($a#6Y]#6
X+3]){for` my$R(keys%
$f){my$x=$ f->{$R};ma
p{$_->conf igure(-bg=
>"gray")}v alues%$x}&
F;$h=0;$b= [];#1$i=1} }my$I=0;fo
r(@$Q){my( $X,$Y)=@$_ ;$X+=3;$I+
+or$l=$X;m y$T=B($c-> {$M},0);#8
@$b,[$X,$Y ,$T];J($T, $X,$Y);$a#
6Y]#6X]=1} #1&N};for( @$b){my($x
1,$Z)=($_- >[0],1+$_- >[1]);($Z<
22)or`goto `N;my$V=$a
#6Z]#6x1]| |0;($V>1)a
nd`goto`N} for(@$b){m
y($X,$Y)=@ $_;$a#6Y]#
6X]=0;}for (@$b){++$_
->[1];my($ X,$Y,$T)=@
$_;J($T,$X ,$Y);$a#6Y ]#6X]=1}#1
;N:$j=0;wh ile(@$b){m y$w=shift@
$b;my($X,$ Y,$T)=@$w; $a#6Y]#6X]
=2;$f->{$Y }->{$X}=$T }$b=[];&N;
});$W->bin d("<Contro l-c>"=>sub {exit});$W
->bind("<K eyPress>"= >sub{my$E= shift;my$F
=lc($E->XE
vent->K);( $F`eq"n")#
0&E;@$b#0( $F=~/\Ah|l
eft/)?G(-1 ):($F=~/\A
l|right/)?
G(1):($F=~ /\Aj|down/
)?H(-1):($ F=~/\Ak|up
/)?H(1):("
space"eq$F )?$j=1:0})
;&A;for`my $P([qw[I`1
59d`89ab`e a62`7654`c
yan]],[qw[
J`159`8456 `a951`2654
`blue]],[q w[L`1598`4
56a`9512`6
540`orange
]],[qw[O`4 589`4589`4 589`4589`y
ellow]],[q w[S`4158`4 59a`9562`6
510`green] ],[qw[T`14
59`4956`96 51`6154`pl um]],[qw[Z
`459`8956` a651`2154` red]],){my
$R=shift@$ P;my$O=$d- >{$R}=[];$
c->{$R}=po
p@$P;map{m y$Q=[];my$ V=hex($_);
for(1..4){ my$Y=$V&0x 03;$V>>=2;
my$X=$V&0x 03;$V>>=2;
unshift@$Q ,[$X,$Y]}# 8@$O,$Q}@$
P}map{B("b lack",$_)} ([128,648, 280,8],[12 0,620,8,36
],[408,620 ,8,36]);Tk ::MainLoop ;^A{#9Y=0; $Y<22;$Y++
){map{$a#6 Y]#6_]=0}( 0..9)}}^B{
my($B,$G)= @_;my$T=$W ->Toplevel ;$T->overr ideredirec
t(1);$T->c onfigure(- highlightt =>1,-highl ightb=>"bl
ack",-back ground=>$B );#1$G?K($ T,@$G):$T}
^C{my($X,$ Y)=@_;#1($
X<0or$X>9o r$Y<0or$Y> 21)?0:1}^D {my$t=pop;
while(my$P =shift@$t) {$P->[2]#4 }^E{&A;D($
b);D($g);$ b=[];for(k
eys%$f){my $S=#5f->{$ _};map{(#5 S->{$_})#4
keys%$S}&F ;$i=$j=$h= 0}^F{map{$ _->[0]#4@$
e;$e=[]}^G {my$D=pop; for`my$u(@ $b){my($X,
$Y)=@$u;($ a#6Y]#6X+$
D]>1)#0;C( $X+$D,$Y)o
r#1}my$I=0 ;for(@$b){
my($X,$Y,$ T)=@$_;--$
a#6Y]#6X]; ++$a#6Y]#6
X+=$D];J($ T,$X,$Y);$
I++or$l=$X ;$_->[0]=$
X}&N}^H{my $p=pop;($m
`eq"O")#0; my$N1=($k+
$p)%4;my$A r=$d->{$m} ;my$As=$Ar #6k];my$At
=$Ar#6N1]; my$O=[];my $N=[];#9I= 0;$I<@$b;$
I++){my$u= $b#6I];my( $X,$Y,$T)= @$u;my($x0
,$y0)=@{$A s#6I]};my( $x1,$Z)=@{ $At#6I]};m
y$D=$x1-$x 0;my$s=$Z- $y0;#8@$O, [$X,$Y];C(
$X+=$D,$Y+ =$s)or#1;# 8@$N,[$X,$ Y,$T];}$b=
$N;$k=$N1; #9I=0;$I<@
$O;$I++){m y($x0,$y0) =@{$O#6I]}
;my($x1,$Z ,$T)=@{$N# 6I]};--$a#
6y0]#6x0]; ++$a#6Z]#6 x1];J($T,$
x1,$Z);$I` or$l=$x1}& N}^I{@r=ke
ys%$c;$r[r and@r]}^J{ my($T,$X,$
Y)=@_;K($T
,128+28*$X ,32+28*$Y) }^K{my($T,
$X,$Y,$W,$ H)=@_;$W|| =28;$H||=2
8;$T->geom etry("${W} x$H+$X+$Y"
);$T}^L{my ($X,$Y,$U, $V)=@_;#1i
f$X<0or$X> 9or$Y<0or$ Y>21;if($U
!=$V){($U= =$a#6Y]#6X ])or#1;$a#
6Y]#6X]=$V ;L($X-1,$Y ,$U,$V);L( $X+1,$Y,$U
,$V);L($X, $Y-1,$U,$V );L($X,$Y+ 1,$U,$V)}}
^M{my$E={} ;my$F={};# 9Y=2;$Y<22 ;$Y++){my$
J=$a#6Y];# 9X=0;$X<@$ J;$X++){my $V=$J#6X]|
|0;($V>4)# 2++$F->{$V };next`if( #7$E->{$V}
);my$Z=$Y+ 1;my$G=($Z >21)?4:$a# 6Z]#6X];($
G>0and$G!= $V)and++$E
->{$V}}}#9 Y=2;$Y<22;
$Y++){my$J =$a#6Y];#9
X=0;$X<@$J ;$X++){my$
V=$J#6X]|| 0;(#7$E->{
$V})#2#5F- >{$V};$J#6
X]=2}}(key s%$F)?$F:0
}^N{&F;for `my$u(@$b)
{my$X=128+ 28*$u->[0]
;my$G=[$X, 664,28,14]
;my$T=B("p urple",$G)
;push@$e,[ $T,$G]}}';
s+\s*++g;$o=0;for$l(' and return ',' return ',' or next;',###########
' for(my$','->destroy}','delete$','->[$','exists','push',# by golux #
'for(my$'){s&#$o&$l&g&&++$o}eval if s&\^&sub &g&&s&`&$"&g#2015-10-12#
say
substr+lc crypt(qw $i3 SI$),4,5
|
sub'r{$==rand pop}$|=print"\e[2J";r$l=`tput lines`-2,s/^$/"\e[$=;".r($
+c
=`tput cols`-2).f.' Oo*... '=~s!\S\K!\e[B\b !gr/e/s/\d++\B/($a=$&-1)+(
+$
==!$a+r$a%$c?3:2)/e/s/(?<=(.)...B.)./$1/g/s/f\K./chr 32>>$=/e/s/\d+/($
+&
||$l)-1/e,select$,,$,,$,,.009*print$&?$_:"\e[f"."\e[K\n"x6while*_=r.r+
+9
EDIT: golfed it down a bit, also fixed some literal edge cases (the sprites where behaving strangely when they hit the edges of the screen).
sub'v{$==!$-+rand pop}[s/\d+/$|--?($-=$&-1)+v$-%$c?3:2:$&-print||`stty
+ size`-
print$&?"\e[?25l\e[2J":y!Oo*.! !r/ge?s/(?<=f|(.))...B.\K./$1||chr 32>>
+$=/ge..
4E4:s/|/o*... //s//\e[B\b /g/s//\e[1;${\v$c=`tput cols`-2}fO/]while*_=
+_.v-42#
The number at the beginning of the last line determines the speed (smaller = faster). The number at the end of the last line is the maximum number of sprites that can be on screen simultaneously.
|
Been a while since I posted anything new, had some fun with this. This uses xterm-256 but tested well with putty and comes out fine on cygwin as well.
#!/usr/bin/perl -w
use strict;
my
@d;
my$__ #
= ':'; my #
$___ =18 ;for( 'a'
..'d' ){ push #
@d,$_ .$__. $___;$___
++;}$___ +=5;for('e'..'i'){push
@d,$_.$__ .$___ ;$___+=6;}$___='';
for(1..3) { $___.=$_}push@d,'j'.$__.$___
;$___=''; for( 1..9){$___.=$_ unless(($_-1)%4
); }push@d,'k'.$__.$___;$___=''; for('a'..
'am'){$___.=$_;}push@d,'l'.$__. length($___
);$___=length($___)+36;push @d,'m' .
$__.$___;$___*=2;$___-=16;push @d,'n' .
$__.$___;$___+=36;for('o'.. 's'){push
@d,$_.$__.$___;$___+=7;}push @d,'W'.
$__ .$___;my@__;$___=''; while(
<DATA>){chomp;s/\s//g; $___.=$_;
}push@d,split/\//, $___;my$m;
foreach(@d){if( m/^(\w):(.*)$/
){$m->{$1}="\033". '[48;5;'.
$2."m \033[0m";} else{
s/S/ /g;my$_oO_;
while((s/^(\d+)(.)//))
{$_oO_ .=$2
x$1}$_oO_ .=$_;$_=
$_oO_;$_.= #########
reverse$_; s/(\w)/$m->{$1}/g;
print;print "\n";}}####
__DATA__
22S18 a/18S22b/16S24c
/14a2S21d3S/ 14b2S13e11S/14c
3S17f6S/1S13d 3S17g6S/1S13e3S2
1h2S/1S6f3S5f5 S20i/2S5g5S6g6S1
6j/2S7h5S7h5S1 4k/2S9i5S8i5S11W/3
S4j2S5j4S10j4S8 W/3S4k4S5k4S9k6S5W/
3S4W6S5W5S6W9S2W /3S6W6S5W5S4W3S2W6S/
4S7W6S5W5S3W2S4W4S /4S9W7S4W3S3W3S5W2S/
4S 12W6S8W3S6W1S/6S 12W7S6W2S7W/8S13W6S4
W3S6W/3S3W6S1W10l5S2 l1W3S1W5l/3S1W2l 2W
5S2W16l1W2S1W5l/3S2 W3l2W5S3W13l1W3S
1W4l/4S1W5m2W6S14W3S 1W4m/4S1W7m2W21S1W
4m/4S1W8m1W21S1W4m/ 5S1W7n1W21S1W4n/6S1W
6n1W16S3W3S1W3n/6S1 W7n4W10S2W2n1W3S1W3n/
6S1W11o4W3S3W4o1W3S1W 3o/6S1W14o1W2S1W7o1W3
S1W3o/6S1W14o1W2S1W7o1 W3S1W3o/6S1W14p1W2S1W7
p1W3S1W3p/7S1W13p1W2S1W 7p1W3S1W3p/7S1W13p1W2
S1W7p1W3S1W3p/7S1W13q1W2S 1W7q1W3S4W/7S1W13q1W2
S1W7q1W7S/7S1W13q1W2S1W7q 8W/7S2W12q1W2S1W15q/9
S1W11r1W2S1W15r/10S1W10r 1W2S1W8r7W/11S1W9r1W2
S1W7r1W7S/12S4W5s1W2S1W5s2W 2S6W/16S2W3s1W2S1W4s1
W3S1W6q/18S4W2S1W4s1W2S1W7r /24S5W2S1W8s/24S5W2S9W
/26S2W3S9W/
|
Hello dearest Monks,
i'm looking for the wisdom of shorthening my code:
use LWP::Simple;
@a = <>;
getprint("http://LeWebsite.com?a=".($a[0])."&b=".($a[2]));
As You have noticed, i'm not interested in the second line, but it is required that the program takes 3 lines of input:
-a digit
-some bollox that You can skip in the program execution, but it will have to bypass/workaround/skip this line
-some more or less random characters, that have to be passed as argument.
I'm just a peasant in PERL, but I heard it's the best language to write shortest code, so i'm trying my luck with It. Thank You in advance guys.
Update:
-I've checked the codes, and I've been able to use only the choroba's first code and at this place I'm really sorry that I didn't mention the STDIN input and chomp.
I found a workaround for chomp- I do it "serverside", my script on the site checks for newline symbols and replaces them
Anyway, thanks to You, dear Monks, my code is 14 chars shorter, and that's great progress, thank You!
|
