Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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...

#!/usr/bin/perl sub r{int rand pop} # Random integer generator, used quite a bit... $|++; # Causes output autoflush, but also $| is used below for its new + value, 1 @g=map{[map{' '}0..$=]}0..25; # sets $g[z][x] to a space for all x and + all z, so we're starting with a blank grid. my$j=pop||2+r(3); # Number of stickmen: user-specified or +else at least two but not more than five. @f=map{ # Each element of @f holds one stickman. # Each stickman has some private variables: my$k=my$n=$b++; # $n is the number of this stickman. $k is the numb +er of his current "opponent". my$z=1; # $z is his height off the ground. my$x=r$=; # $x is the stickman's horizontal position. # $= is used for its default value (60) and is the w +idth of the field. my($q,$v,$e)=my@l=(0,0,0,0); # @l holds numbers corresponding to the positions of the stickman's +four limbs. # (leftarm, rightarm, leftleg, rightleg). # 0 means the limb is down, 1 means out, 2 means up. # $q and $v are velocities (horizontal and vertical respectively). # $e is this stickman's "state": 0 = resting, 1 = attacking, 2 = fl +eeing. my$h=r(9); # $h is "health", a.k.a. "breath", i.e., how long before +the dude needs a breather. $w= {# The variable $w is a decoy; what matters is that this assignm +ent is the # last thing in the sub and therefore this has reference is the + value that # is returned from the map. i.e., @f is an array of hashrefs, +each one # containing the closures that make the stickman work. i=>sub { # i stands for "iteration". This stuff happens once per "tur +n", for each stickman. $k=r($j) while($k==$n or!$f[$k]); # Make sure stickman has a +valid "opponent". my$o=$f[$k]; # Prefetch the opponent has +href, for easy access. $h+=($e?-1:1); # Resting regains breath; a +ttacking and fleeing exhaust it. if($h<1){$e=0;$k=$n} # If exhausted, rest, and c +hoose a new opponent next iteration. if($h>6){$e=1} # If we have enough breath, + attack. if(!$z){ # If we're at ground level, + we can make decisions about movement... my$u=($x<$$o{x}->()?1:-1); # Sets $u to the directi +on toward our opponent. $u*=(($e>1)?-1:1); # Reverse that direction + if we're fleeing. $q=$e?($u*(r(7))):0; # Set horizontal velocit +y (0 if resting). if($e>1){$q||=4} # If we're fleeing, we c +an't have a 0 horiz. velocity. if($e and(r(7)>3)){$v=r(6)} # If not resting, there' +s a chance we might leap. } my$t=($$o{z}->()cmp$z)+1; # Target limb position. Up + if opponent is up, down if down, out if neither. $t=0 if($x==$$o{x}->()); # But if we're at the same +horizontal position as opponent, put limbs down. my$s=(($x<$$o{x}->())?1:0); # Selects left or right lim +bs, depending on opponent's relative position. for(0,2){ # 0 is the base index into +@l for arms; 2 is the base index for legs. $l[$_+$s]+=($t cmp$l[$_+$s])} # Sets limb positions based + on target position ($t) and side ($s). for(0,2){ $l[$_+($s?0:1)]=0} # Put down the limbs on the + other side. if($z){$v-=2} # Gravity. $x+=$q;$z+=$v; # Moves horiz. and vert. po +sition based on the velocities. $z=0 if$z<0; # Nobody falls below the gr +ound. if($x<2){$x=2;$q*=-1 if $q<0} # Nobody goes past the left + edge... if($x>$=-2){$x=$=-2;$q*=-1 if $q>0} # ... or the right edge. if ((abs($x-($$o{x}->()))+1)* (1+abs($z+1-($$o{z}->())))<9) # If we're "pretty close" t +o our opponent... { r(2)?($$o{c}->($n) or $e=1):${$f[$n]}{c}->($k); # This triggers a conflict. Who "wins" is randomized. # In the first case, we win and the opponent's collision # routine is called with our number, and our state is set # to attack. In the other case, our own collision # routine is called with our opponent's number. } }, d=>sub { # Draw routine. Places chars on the grid representing this s +tickman. $g[20-$z][$x]="O"; # Head $g[21-$z][$x]="+"; # Torso $g[22-$z][$x]="|"; # Abdomen for(0..1){ # 0 and 1 represent the two sides (left and right) +. my@c=($_?('/','-',"\\"):("\\",'-','/')); # On the left, / is down, - out, \ up. On the right it's t +he reverse. $g[21-$z][$x+($_?1:-1)] # Upper arm: =$l[$_]?'-':$c[2]; # - if arm is not at rest; down p +osition otherwise. $g[22-$z-$l[$_]][$x+($_?2:-2)] # Lower arm: =$c[2-$l[$_]]; # up, out, or down if arm is + up, out, or down. $g[23-$z][$x+($_?1:-1)] # Upper leg: =$l[2+$_]>1?'-':$c[2]; # - if limb is up, down v +iew otherwise. $g[24-$z-($l[2+$_]>1?1:0)][$x+($_?2:-2)] # Lower leg: =$c[$l[2+$_]>1?1:2]; # - if up, down + view otherwise. } }, z=>sub{$z}, # the z and x accessors are so that x=>sub{$x}, # stickmen can get their opponents' positions. n=>sub{$n=pop}, # Renumbers this stickman; used in cases of col +lision. c=>sub { # Collision-recovery routine. $h=0;$e=2; # Exhausted and fleeing... $k=pop; # ... from the stickman who just collided with +us. $q=0; # No horizontal motion (initially). if(!r(7)){ # But there's a small chance the stickman will no +longer fight... splice@f,$n,1; # In which case he's removed from the list +, for(@f){$$_{n}->($h++)} # and the list is renumbered. } } } }1..$j; # We put one of these stickmen in @f for each number from 1 to + $j while(1){ # Then we loop... ++$iter;# This was a holdover from debugging that I forgot to rem +ove. if(@f==1){exit 0} # If there's only one stickman left, he wins and w +e're done. for$m(@f){ # Each stickman must $$m{i}->();# do his once-per-loop stuff (an iteration) $$m{d}->() # and then draw himself onto the grid. } print$/x$=; # This is a crude way of clearing the screen. for $a(1..25){ # We're going to print 25 lines of the grid, startin +g at the top. print$/,"|",@{$g[$a]},"|"; # The vertical bars are the left and r +ight edges. # The array in $g[$a] holds whatever characters the d routines of +the stickmen have drawn there. @{$g[$a]}=map{' '}0..$=; # This resets the line to blank for next # time around, so the stickmen don't # leave trails. } sleep 1 # I like [diotalevi]'s [select] much better, as the 1-second + delay is really too long. }#Optional command-line argument selects how many ninja stickmen.

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

In reply to Explanation of Goofy leaping ninja stickmen by jonadab
in thread Goofy leaping ninja stickmen by jonadab

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (7)
    As of 2018-06-23 18:05 GMT
    Find Nodes?
      Voting Booth?
      Should cpanminus be part of the standard Perl release?

      Results (125 votes). Check out past polls.