Okay, let's pull this one apart. First of all, there is a big
assignment to $_ (as in $_='....') which is then eval'ed. Cutting
this bit out, and leaving just the code, and cutting all the blanks
out gives us some perl code that can be fed to B::Deparse (this can be done with perl -MO=Deparse find-a-func >find-a-func.deparsed. Depending on your version of Perl a slew of warnings may be emitted. You can run the deparsed code to ensure the script still works correctly. In this case we strike it lucky -- it does). We
can then start to look at the code.
$; = 'perl';
map {
map {
s/^\s+//;
$_{$_}++ unless /[^a-z]/
}
split(/[\s,]+/, $_, 0) if /alpha.*$;/i .. /wait/
} `$;doc $;toc`;
@[ = keys %_;
Here we grab the output of the backticked command "perldoc perltoc". The flip-flop operator
is used to isolate the section of interest from the line that contains
alpha (actually Alphabetical in the text) and the word Perl (what $; is currently)
down to the line that contains the word 'wait'. The %_ hash is
used to store all the Perl keywords (anything that is in lowercase).
Once we've done that we can transfer the hash keys to the @[ array.
$; = 20;
$: = 15;
foreach $_ (0 .. $; * $: - 1) {
$;[$_] = '_';
}
A 20 x 15 grid is created. Each cell is set to an underscore. System
variables are used where possible to avoid the needless creation of lexicals (we
are running under strict, remember). The grid is unfolded out into a linear
string such that grid point (x,y) is mapped to (x*ylen)+y.
until ($%++ > 3 * $; or @] > 2 * $: - 3) {
We loop through a number of times, 3 times the number of rows, or until we
have placed a bit less than half the Perl keywords in the grid. Hmm, not quite. As my inbox puts it Erudil says the line until ($%++ > 3 * $; or @] > 2 * $: - 3) { is used to keep the list from being longer than the grid.
@_ = split(//, splice(@[, rand @[, 1), 0);
if (3 > @_) {
next;
}
Take a random Perl keyword, remove it from the array, and chop it up
into letters. If it's a less than three letter keyword, throw it away
and try again.
$~ = int rand $;;
$^ = int rand $:;
$- = $~ + $^ * $;;
Find a random (x,y) spot on the grid, and also convert that spot to the linear form.
my $Erudil = 0;
Create a dead man switch for use in the following scope.
{
if ($Erudil++ > 2 * $:) {
next;
}
Open a scope. Increment the dead man, and if we have come through here too many times (via the redos, below), then
give up trying to place this word, and go and get another one.</blockquute>
$a = (-1, 0, 1)[rand 3];
$b = (-1, 0, 1)[rand 3];
Generate a point somewhere in the Conway (à la game of Life, not Damian)
neighbourhood.
unless ($a || $b
and $~ + $a * @_ <= $;
and $~ + $a * @_ >= 0
and $^ + $b * @_ <= $:
and $^ + $b * @_ >= 0) {
redo;
}
Ensure that we haven't fallen off the end of the grid.
my $llama = 0;
foreach $_ (0 .. $#_) {
unless ($;[$- + $a * $_ + $b * $; * $_] eq $_[$_]
or $;[$- + $a * $_ + $b * $; * $_] eq '_') {
++$llama;
last;
}
}
Now try and place the word, letter by letter, walking away in the direction we started with. If the grid point being inspected is an
underscore, that means we haven't placed any letter there yet, which is cool, on the
other hand if it is a letter, and it is the same as the letter we want to place,
that's cool too (in fact, it's a big win for it means we've managed to position two (or more) words sharing a common position on the grid). Otherwise, if we collide, raise a llama flag and get out -- we are blocked by a word that has laid a prior claim to this grid point.
if ($llama) {
redo;
}
It wasn't ok, so let's try placing it somewhere else. Ha, the joys of brute force. It's stuff like this that explains why the script takes a second or three to generate its output.
push @], join('', @_);
foreach $_ (0 .. $#_) {
$;[$- + $a * $_ + $b * $; * $_] = $_[$_];
}
Join the letters back up into the word. Push that word onto the list
of words we have to find. Then, mark up the grid with the definitive letters that have
been used.
}
}
@_ = sort(@]);
unshift @_, 'Find:', '-' x 5;
Sort the words into alphabetical order, and add two elements to the beginning of the
array, which will become the header.
foreach $a (0 .. $: - 1) {
For each row...
foreach $b (0 .. $; - 1) {
... and for each column...
$~ = ('a'..'z')[rand 26];
$_ = "$;[$a * $; + $b]" . $";
s/_/$~/;
print $_;
}
Choose a random letter. Get the current point in the grid. If it's a _ then
there's no placed letter, so use the random letter instead. Print that.
$_ = shift @_ || $";
print $", $", $_, $/;
$_ = shift @_ || $";
print $" x $;, $" x $;, $", $", $_, $/;
}
Print out the next word in the list of words to find. Then print a new line,
a raft of spaces ($" is just a space (by default), after all), and the next word after that. In this manner we get a nice airy layout.
update: Erudil pointed out a small B::Deparse artifact in my deconstruction. Corrected.
--g r i n d e r
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.