Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

Goofy leaping ninja stickmen

by jonadab (Parson)
on Oct 07, 2003 at 15:45 UTC ( #297319=obfuscated: print w/replies, xml ) Need Help??

#!/usr/bin/perl sub r{int rand pop}$|++;@g=map{[map{' '}0..$=]}0..25;my$j=pop||2+r(3); +@f=map{my$ k=my$n=$b++;my$z=1;my$x=r$=;my($q,$v,$e)=my@l=(0,0,0,0);my$h=r(9);$w={ +i=>sub{$k= r($j) while($k==$n or!$f[$k]);my$o=$f[$k];$h+=($e?-1:1);if($h<1){$e=0; +$k=$n}if($ h>6){$e=1}if(!$z){my$u=($x<$$o{x}->()?1:-1);$u*=(($e>1)?-1:1);$q=$e?($ +u*(r(7))): 0;if($e>1){$q||=4}if($e and(r(7)>3)){$v=r(6)}}my$t=($$o{z}->()cmp$z)+1 +;$t=0 if($ x==$$o{x}->());my$s=(($x<$$o{x}->())?1:0);for(0,2){$l[$_+$s]+=($t cmp$ +l[$_+$s])} for(0,2){$l[$_+($s?0:1)]=0}if($z){$v-=2}$x+=$q;$z+=$v;$z=0 if$z<0;if($ +x<2){$x=2; $q*=-1 if $q<0}if($x>$=-2){$x=$=-2;$q*=-1 if $q>0}if ((abs($x-($$o{x}- +>()))+1)*( 1+abs($z+1-($$o{z}->())))<9){r(2)?($$o{c}->($n) or $e=1):${$f[$n]}{c}- +>($k);}},d =>sub{$g[20-$z][$x]="O";$g[21-$z][$x]="+";$g[22-$z][$x]="|";for(0..1){ +my@c=($_?( '/','-',"\\"):("\\",'-','/'));$g[21-$z][$x+($_?1:-1)]=$l[$_]?'-':$c[2] +;$g[22-$z- $l[$_]][$x+($_?2:-2)]=$c[2-$l[$_]];$g[23-$z][$x+($_?1:-1)]=$l[2+$_]>1? +'-':$c[2]; $g[24-$z-($l[2+$_]>1?1:0)][$x+($_?2:-2)]=$c[$l[2+$_]>1?1:2];}},z=>sub{ +$z},x=>sub {$x},n=>sub{$n=pop},c=>sub{$h=0;$e=2;$k=pop;$q=0;if(!r(7)){splice@f,$n +,1;for(@f) {$$_{n}->($h++)}}}}}1..$j;while(1){++$iter;if(@f==1){exit 0}for$m(@f){ +$$m{i}->() ;$$m{d}->()}print$/x$=;for $a(1..25){print$/,"|",@{$g[$a]},"|";@{$g[$a +]}=map{' ' }0..$=;}sleep 1}#Optional command-line argument selects how many ninja + stickmen.

My joke generator got a complaint about getting lost in all the map transforms, so in an effort to make my code easier to follow (ahem) I have limited myself to only four occurrances of map in this little project, instead using the trinary operator, a lot of conditionals and comparisons, and far too many variables for such a short program. Enjoy :-)

Oh, you can take out the sleep 1 for hyper speed, if desired, which is useful if you want to use the command-line argument to specify large numbers of fighters. 500 ninjas take too long to duke it out with the sleep statement in.

$;=sub{$/};@;=map{my($a,$b)=($_,$;);$;=sub{$a.$b->()}} split//,".rekcah lreP rehtona tsuJ";$\=$ ;->();print$/

Replies are listed 'Best First'.
Re: Goofy leaping ninja stickmen
by davido (Archbishop) on Oct 07, 2003 at 21:18 UTC
    Great obfu. Funky!

    Just as a matter of curiosity I tore into it and made a few modifications:

    • Pushed everything that is to be printed into an array so that the script could get away with only one print, with less processing inside the print function, for a little better (maybe?) output efficiency.
    • Changed sleep 1 to select, with a timeout of .2 sec., for smoother action without loss of synchronization.
    • Golfed it down as much as I could without changing logic, flow, or behavior. Saved 82 keystrokes.
    • Reformatted script for seventeen full lines and one partial, plus the shebang.

    Here's the result:

    #!/usr/bin/perl sub r{int rand pop}++$|;@g=map{[map{' '}0..$=]}0..25;my$j=pop||2+r 3; @f=map{my$k=my$n=$b++;my$z=1;my$x=r$=;;my($q,$v,$e)=my@l=(0x4);my$h=r 9;$w={i=>sub{$k=r$j while$k==$n or!$f[$k];my$o=$f[$k];$h+=$e?-1:1;if( $h<1){$e=0;$k=$n}$e=$h>6?1:$e;if(!$z){my$u=$x<$$o{x}()?1:-1;$u*=$e>1? -1:1;$q=$e?$u*r 7:0;$q||=4if$e>1;$v=r 6 if($e&&r(7)>3)}my$t=($$o{z}() cmp$z)+1;$t=0if$x==$$o{x}();my$s=$x<$$o{x}()?1:0;for(0,2){$l[$_+$s]+= $t cmp$l[$_+$s]}for(0,2){$l[$_+($s?0:1)]=0}$v-=2if$z;$x+=$q;$z+=$v;$z =0if$z<0;if($x<2){$x=2;$q*=-1if$q<0}if($x>$=-2){$x=$=-2;$q*=-1if$q>0} if((abs($x-$$o{x}())+1)*(1+abs($z+1-$$o{z}()))<9){r 2?$$o{c}($n)||($e =1):${$f[$n]}{c}($k)}},d=>sub{$g[20-$z][$x]='O';$g[21-$z][$x]='+';$g[ 22-$z][$x]='|';for(0,1){my@c=$_?qw!/ - \\!:qw!\\ - /!;$g[21-$z][$x+($ _?1:-1)]=$l[$_]?'-':$c[2];$g[22-$z-$l[$_]][$x+($_?2:-2)]=$c[2-$l[$_]] ;$g[23-$z][$x+($_?1:-1)]=$l[2+$_]>1?'-':$c[2];$g[24-$z-($l[2+$_]>1?1: 0)][$x+($_?2:-2)]=$c[$l[2+$_]>1?1:2]}},z=>sub{$z},x=>sub{$x},n=>sub{$ n=pop},c=>sub{$h=0;$e=2;$k=pop;$q=0;if(!r(7)){splice@f,$n,1;$$_{n}($h ++)for@f;}}}}1..$j;while(1){exit if@f==1;for$m(@f){$$m{i}();$$m{d}()} my@n;for$a(1..25){push@n,join'',"$/|",@{$g[$a]},'|';@{$g[$a]}=map{' ' }0..$=}print$/x$=,@n;select$c,$c,$c,.2}
    Loved the obfu. Good job! Wading through the maps and logic was quite a challenge. Especially the outtermost map, with a hashtable of subs inside.... ugg, what a mess! That's not a bad thing, in the context of a fantastic obfu. Keep it up!


    "If I had my life to do over again, I'd be a plumber." -- Albert Einstein

      ++ for pointing out that select can be used this way; I had thought it had to do with filehandles, and had not realised this use for it.

      As for the rest of your improvements... well, I'll have to look at those when I have more time.

      update: I've looked at them now, and they all seem pretty straightforward; you just did a more thorough job of golfing than I.

      $;=sub{$/};@;=map{my($a,$b)=($_,$;);$;=sub{$a.$b->()}} split//,".rekcah lreP rehtona tsuJ";$\=$ ;->();print$/
Explanation of Goofy leaping ninja stickmen
by jonadab (Parson) on Oct 14, 2003 at 16:37 UTC

    Well, I figured someone else would deobfuscate this, but since nobody else has, here's an explantion for posterity. First off, there are really very few clever or sneaky "tricks" in this one to hide what's going on, other than removing the comments and renaming the variables tersely; most of it's just straightforward dense logic and a little golf...

    $;=sub{$/};@;=map{my($a,$b)=($_,$;);$;=sub{$a.$b->()}} split//,".rekcah lreP rehtona tsuJ";$\=$ ;->();print$/
      tell me how to create stickmen and print them out
Re: Goofy leaping ninja stickmen
by Notromda (Pilgrim) on Oct 14, 2003 at 14:58 UTC
    Ouch. Not going to fall for it this time... I have too much work to do.... must resist....

    Another amazing obfu. ++

Re: Goofy leaping ninja stickmen
by princepawn (Parson) on Oct 07, 2003 at 16:54 UTC
    I cant copy and paste this because the line-wrapping is putting a plus at the beginning of lines that are too long.

    Carter's compass: I know I'm on the right track when by deleting something, I'm adding functionality.

      You could either change the wrap width in your prefs, or use the download the code link as bart suggests. Or you could use an editor macro or function to undo the plus-wrapping. In Emacs, this should do it...

      (defun unplusify-buffer () (interactive) (save-excursion (goto-char (point-min)) (while (re-search-forward "^[+]") (backward-delete-char 2))))

      The corresponding unplusify-region function is left as an exercise for the reader. Also note that I didn't worry about lines that legitimately start with +, because my obfu doesn't have any. A more general case would be a couple extra lines, as it would have to check whether the previous line is the same length as your wrap width.

      update: like this:

      (defvar perlmonks-wrap-width 60) (defun perlmonks-unplusify-buffer () (interactive) (save-excursion (goto-char (point-min)) (while (re-search-forward "^[+]" (point-max) nil) (if (= perlmonks-wrap-width (save-excursion (previous-line 1) (end-of-line) (current- +column))) (backward-delete-char 2)))))

      $;=sub{$/};@;=map{my($a,$b)=($_,$;);$;=sub{$a.$b->()}} split//,".rekcah lreP rehtona tsuJ";$\=$ ;->();print$/
        Hey! This isn't!! ;)
        perl -pe 'next unless $n++;/^\+/ ? s/^\+// : s/\n$//'


        (the triplet paradiddle with high-hat)
      Just how long have you been around here? Over 3 years, and you still succeeded in having missed the Download Code link, available with every node, near the "Comment On..." link in the bar underneath the post, just above the replies?

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: obfuscated [id://297319]
Front-paged by gmax
and cookies bake in the oven...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2018-07-23 04:26 GMT
Find Nodes?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?

    Results (459 votes). Check out past polls.