Very nice. I especially like the way pos() was used as an lvalue, and assigning a regexp match to the array slice @;[0,1]. Clever!
Here's my deconstruction, split apart, unusual variables replaced, and commented:
#!/usr/bin/perl -w
use strict;
my $source='Just another Perl hacker.'; # previously ($_{_})
my $reversed=''; # previously ($_{__})
my @split_source = $source =~ /./g; # previously (@_)
$" = $/; # arrays assigned to strings are separated by newlines
# only thing this does is add the final newline
while(@split_source){ # for each character in the array
$reversed .= pop @split_source; # concat it to the reversed strin
+g
}
my @stages = ($reversed);
my %E; # previously (%;)
my @F; # previously (@;)
my $G; # previously ($/)
# while $G isn't eq source, find two random incorrect characters
# and swap them, pushing the result onto @stages
while(($G = $stages[-1]) ne $source) {
@E{0..24} = map{pos $source = pos $G = $_; # start searching at $
+_
($a) = $G =~/./g; # find characters at t
+hat point
($b) = $source =~ /./g; # and compare them
"$a" eq $b # expr same as substr(
+$source,$_,1) eq substr($G,$_,1)
} (0..24); # so $E{n} is true if
+nth letter of G is correct
@F = grep{!$E{$_}} keys(%E); # @F is list of incorr
+ect character positions
$a = $F[rand @F]; # pick random characte
+r position from f
do { $b = $F[rand @F] } while ($b == $a); # pick another random
+character pos from f
pos $G = $a; # start search pos for
+ $G at $a
$| ||= 1; # set autoflush, this
+ need not be in the loop
@F[0,1] = $G =~ /./g; # effect: $F[0] = subs
+tr($G,$a,1)
pos $G = $b; # start search pos for
+ $G at $b
@F[1,2] = $G =~ /./g; # effect: $F[1] = subs
+tr($G,$b,1)
$G =~ s/(.{$a})./$1$F[1]/; # replaces a'th char o
+f $G with $F[1]
$G =~ s/(.{$b})./$1$F[0]/x; # replaces b'th char o
+f $G with $F[0]
@stages = (@stages => $G); # adds a new record to
+ @stages
}
# do the print out!
for(@stages){ # for each stage
s/^/\r/; # add a carriage return at the beginning
print $_; # print it
select undef,undef,undef,0.1; # wait .1 seconds
}
print" :-)";
sleep 1;
print "@{['','']}"; # because $" set to $/, this just prints a newline
Update: Typo |