Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
Hi all, I'm not sure if this is the right place for this, or if people are interested, but below is a cleaned up, commented version of my latest obfu.

I tend to rely on tersness to make my code obfuscated, so, as noted in a reply the obfuscation is quite weak - it's mainly done to shape the code, I could have run it through huffman or something, but, er, didn't.
Looking back through it, there's definitely scope for some golfing, however you have to stop and post at some point!

It is prepared and executed with this:

# s#((?{$a.=$+})\s?(\S*)\s?)*#$a=~s/Z/ /g;$a#see
(append the previous match - which is non whitespace chars - to $a, inside $a replace Z with a space. the second e flag then evaluates the return value of the first pass - so it evaluates the $a which is the code (in a single line).
The easiest way to get the code is to remove the second e and then add a print $a. I prepared the following by doing this and running the result through perltidy.
In all my obfuscations i use single character variable names - these i tend to assign sequentially starting at $a as i write it. All i've done is reformat and name the variables meaningfully, the code below should still work - so the download link will give you code that works exactly the same as the obfuscated version, but there's a good chance i've messed something up in the tidying! (it worked when i tested it briefly though)

Data Generation


Set up the width and height of the maze (in boxes - 1 box = 10px by 10px);
( $width, $height ) = split /x/, shift || "19x20";
Set up the width and height of each frame: size of boxes + 10px white border.
$x_max = 10 + 10 * $width; $y_max = 20 + 10 * $height;

Maze Generation

This code is canibalised from a previous sig here

Set up an array with an initial values for each box in the maze:

@m = ( ( 31, (15) x ( $width - 1 ) ) x $height, (31) x $width );

This next part is a single until statement. it walks the maze, using a depth first search:
  • Start in a square,
  • Pick a valid unvisited square next to it.
    (Valid for solving obviously means that there is no wall between you and the next square)
  • move to one of these at random, knocking down the wall as you go (if in generation mode).
  • If there aren't any unvisited valid squares then go back along your path until there are..

The values in the array determine the properties of that square. This is done by checking which bits are set with that value:
# 8 # 1 2 # 4 # v u d r l # 1 1 1 1 1
So if bit 8 is set then you can't 1 go that way (the inital value of 15 means the following function has to unset the bit.

Set the visited bit - this means the search can't now go back here
$c holds the box number we are currently in (initially 0)

$m[$c] |= 16,
This is the start of a conditional
Find unvisited directions, tests the value of the box above, below etc. against 16 (the visited bit), and in generation mode 16+<the bit check value - second in the input array>.
@a = grep !( $m[ $c + $$_[0] ] & 16 + $| * $$_[1] ), #left [ -1, 8 ], #right [ 1, 1 ], # up [ $width, 4 ], # down [ -$width, 2 ] )
If there isn't a valid direction (ie @a is empty) go back to where we last were:
? $c = pop @p :
  • Pick one at random:
    ${ ( $i, $j ) = @{ $a[ rand @a ] };
  • Unset the bit for that direction (knock down the wall)
    $m[$c] &= ~ (8 / $j);
  • Add our current position to the path we've travelled (@p)
    push @p, $c;
  • Move to the next place, and say we can go back the other way.
    $m[ $c += $i ] &= ~$j;
  • When $counter shows we have visited every box in the maze we start the second run (building @p to be the quickest solution from the top left to the bottom right corner).
    • The visited bits are all turned off
    • @p is deleted
    • position is set to 1
    • $| is set as a signal that we're in generation mode

    ++$counter - $height * $width + $height || map $_ &= 15, @m, splice(@p), $c = $| = 1 }
(In the original version the drawing routine was here, and in solving mode printed the cursor where it was, so it also drew the trackbacks),
this can be left in to draw the output as it solves it (although this is just ripped out without the proper values in, or the whole thing could be moved around to draw a point moving round to the solution (but the num_frames etc isn't known in time to draw the header, requiring a large buffer holding all the frames).
#print"\ec", # map$_%9?($_-$c?$m[$_]&2?_:$":o).($m[$_]&8?"|":_):$/,1..72
This stops the loop when the maze is drawn and the cursor is back in the bottom right:
until $| & $c + 2 > $width * $height;

Image Preparation

Bmp's (which are the format used in the data stream for the video), require that each line of pixels is padded until the length of the data for each row is divisible by 4 bytes, this does that:
$space = $x_max - 4 * int $x_max / 4;
This is the size of each frame's data:
$image_size = ( $x_max + $space ) * $y_max;
$image is the image data and is initialised to be the correct length of all null bytes
$image = pack "x" x ( ( $x_max + $space ) * $y_max );
In eight bit per pixel bmp's 1 byte represents 1 pixel, set to a value which points to the position in the colour table.
This function draws a line, it takes $x, <length of line>, y1, y2, colour:
sub line { my ( $x1, $x_len, $y1, $y2, $e ) = @_;
Set up to draw a vertical line - get the lowest to do range from y1 to y2. There is significan scope for golfing here.
@a = sort { "000$a" <=> "000$b" } $y1, $y2 || $y1; for ( $a[0] .. $a[1] ) {
Then from the top (ie the end of the file), set each bit to the correct colour (or 2 = black by default)
$s = ( $y_max - $_ ) * ( $x_max + $space ) + $x1; vec( $image, $_, 8 ) = $e || 2 for $s .. $s + $x_len - 1; } }
This function converts a number in the @m maze to a pixel x/y
sub t { $a = shift; $x = 10 * ( $a % $width ); $y = 10 * ( 2 + int $a / $width ) }
Draw the borders:
# top line 9, $x_max - 20, 10; # bottom line 9, $x_max - 20, $y_max - 10; # left line 9, 1, 10, $y_max - 10; # right line $x_max- 11, 1, 10, $y_max - 10;
Now draw the maze onto $image
map {
Get x/y pixel for this point in the maze:
t $_;
If it's not the last point in a row (which is used to define the edge and is initialised to stop access)
if ( $_ % $width ) {
Check if we can go down - draw horizontal line if we can't
$m[$_] & 2 ? line $x - 1, 11, $y : "";
And the same for the top
$m[$_] & 8 ? line $x + 9, 1, $y - 10, $y : ""; }
Repeat this for all the boxes in the maze
} 0 .. -1 + $width * $height;

So now we have a string ($image) with each byte set correctly to draw out an empty maze.

Output the AVI

I'm tidying this up and turning it into a CPAN module, as it could be useful, maybe.
open( FH, ">al.avi" ); binmode FH; select FH; # a space saver $LIST = "LIST";

Draw the header

The following takes a list of headers and values and packs them in the correct format:
print pack "V*", /\d/ ? $_ : unpack "V*", $_ for
The header format can be found here, it's reasonably complicated2, but most of the values here are defaults (so header lengths, scaling etc), and this header will work with most data (in $image, with heights and widths etc set).
"RIFF", # length of file (header length + data length + index length) ( 1256 + ( $image_size + 24 ) * ( $num_frames = 3 + scalar @p ) +), "AVI $LIST", 1216, "hdrl", "avih", 56, 500000, 32, 0, # avi flags (hasindex etc) 2064, $num_frames, 0, 1, $image_size, # movie width $x_max, # movie height $y_max, (0) x 4, $LIST, 1140, "strl", "strh", 56, "vids", (0) x 4, 1, 10, 0, $num_frames, $image_size, -1, (0) x 3, "strf", # length of avi header: # (40) + length of color table (1024) 1064,
The following is the data stream format header, it's format is that of a BMP data header, which is explained here3.
40, $x_max, $y_max, # 8 is the bits per pixel pack( "vv", 1, 8 ), 0, $image_size, (0) x 4,
And now draw the colour table4- 0th entry white, 1st entry blue , the last 254 black
pack( ( "H" x 1024 ), "f", "f", "f", 0, "a" ),
There is an "optional" JUNK header that goes here, used (i think) to bring the header and image stream data boundary at a point i left it out, but i think that might why it doesn't work in winamp (or some WMP or macs etc etc!), perhaps, maybe
# "JUNK", # <length of junk to boundary>, # <null bytes to boundry>
Now we get to draw the data.
First the data header:
This is the length of the data in the file (image size + image header size ) for each frame + "movi"
( 4 + ( $image_size + 8 ) * $num_frames ), "movi";

Draw the Image data

The following block travels along the path of @p (which is the shortest route from the top left to the bottom right), drawing a line (ie updating $image) as it goes. Each pass draws 1 frame of the clip.
map {
Print to STDOUT the frame number (we gotta have some kind of feedback!)
print STDOUT ++$G, $/;
Find the position of the previous position
t $previous|| 1;
Set left edge of block to be drawn
$left = $x;
And the top
$top = $y;
Find the x/y of current position
t $_; $right = $x;
Get the actual right and left (i should have just square and sqrt'd the length part)
if ( $left > $x ) { $right = $left; $left = $x }
Draw a line for the depth of the block to be drawn
line $left+ 2, 5 + $right - $left, ( $top < $y ? $top : $y ) - 7, ( $top < $y ? $y : $top ) - 3,
In blue
1; $previous = $_;
Actually print out the data (and header) - $image_size is the length of $image (or should be!)
print "00db" . pack( "V", $image_size ) . $image } @p, ( -1 + $width * $height ) x 3;
And now the index, simply a header,
print "idx1" . pack "V", 16 * $num_frames; $o = 4;
And an entry for each frame telling the offset within the data chunk of the image for each frame
for ( 1 .. $num_frames ) { print "00db" . pack "VVV", 16, $o, $image_s +ize; $o += $image_size + 8 }

And we're done.


  1. I can't remember why i did it this way round, but there was a reason!
  2. Basically the header is a nested tree of chunks, where each chunk has a label, followed by the size of the chunk, followed by the data itself (which can be more chunks).
  3. I initally used tachyon's post here as a starting point for exploring bmp headers, then wrote a version that outputed a bmp for each frame and used BmpSeq to pack them into an avi file, and use the headers from that as a guide to find values for the generated one.
  4. the color table is a RGBQUAD, 4 bytes, signifying blue,green,red values (and a null byte).


There are others, which were reached either by searching, or linked from the above.

Considered by teamster_jr: I've put this in meditations, but could be reparented under Let's go to the movies, up to you guys. al
Unconsidered by planetscape: keep votes prevailed (keep:16 edit:11 reap:0)

update: fixed typo - second line call is for right side of box rather than left again (obv)
(and fix endianness - use V and v rather than L and S)

In reply to From terminal output to avi - "let's go to the movies" explained by teamster_jr

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
    [karlgoethebier]: Lady_Aleena: ++ for "The Man Crusher Everyday"
    [karlgoethebier]: this mad my day
    [karlgoethebier]: no typo
    [marioroy]: At the Fransiscan monastery, got stuck up high in a tree from pruning and the chainsaw with large branch fell and broke the latter, but not me fortunately. Was stuck there for a while until a firetruck came by.
    [Corion]: marioroy: So you live dangerously ...
    [Lady_Aleena]: s/latter/ladder/; # ? marioroy
    [karlgoethebier]: marioroy: Praise the Lord
    [marioroy]: Well, that's why there must be angels around, invisible or not.
    [marioroy]: Lady_Aleena yes, ladder.
    [marioroy]: Corion, no not intentionally. not at all.

    How do I use this? | Other CB clients
    Other Users?
    Others meditating upon the Monastery: (9)
    As of 2017-05-29 08:36 GMT
    Find Nodes?
      Voting Booth?