#!/usr/bin/perl -w
use strict;
my $file = shift;
my $minlen = shift || 3;
my @picture = (
    '  +--+',
    '     |', 
    '     |',
    '     |',
    '     |', 
    '-----+');
my @cp =( # create picture
    [1,2,'O'],  [2,2,'|'], [2,1,'/'],
    [2,3,'\\'], [3,1,'/'], [3,3,'\\']);
my @wcp=( # winner create picture
    [2,1,'\\'], [2,2,'O'], [2,3,'/'],
    [3,2,'|'],  [4,1,'/'], [4,3,'\\']);
my ($errors, $word, $guess, $msg, $A) = (0,'','','','a');
my %letters = ();
my %wordletters=();
my %garbled=map{$_,$A++}
    split //,'ifcseujmtaqybnzdwgvokxphlr'; 
{
    local $/=undef;
    my $words ;
    if (defined $file) {
        open FILE, "< $file" 
            or die "file not found $file\n";
        $words = <FILE>;
        close FILE;
    }
    else {
        $words = <DATA>;
    }
    srand();
    $words =~ s/\n/ /g;
    my @ww = grep {length($_) >= $minlen} split / /, $words;
    my $count = scalar @ww;
    $word = lc($ww[rand ($count) -1]);
    $word = join '',map{$garbled{$_}}split //,$word unless $file;
    $guess = '-' x length($word);
    $count =0;
    for (split //,$word){push @{$wordletters{$_}},$count++};
}

while (1) { # loops forever. Ends if win or lost
    draw($errors);
    if ($errors > 5) {
        print "YOU LOST ($word)\n";
        exit
    }
    print $guess,"\n";
    print 'used: <', keys %letters,">\n";
    print "guess: ";
    my $x; chomp($x = <>);
    $x = lc($1) if $x=~/(\w)/;
    if ($x !~ /^\w$/) {
        $msg = "INVALID INPUT $x";
    }
    elsif ($letters{$x}) {
        $msg = "ALREADY PLAYED: $x";
    }
    elsif ($wordletters{$x}) {
        for (@{ $wordletters{$x}} ) { 
            substr($guess, $_,1) = $x;
        }
        unless ($guess =~ /-/) {
            @cp=@wcp;
            $msg = "YOU WON! ($guess)";            
            draw(6);
            exit;
        }
    }
    else {
        $errors++
    }
    $letters{$x}++;    
}

sub draw {
   my $level = shift;
   my @pic = @picture;
   for my $j  (1..$level) {
       substr($pic[$cp[$j-1][0]],$cp[$j-1][1],1) 
           = $cp[$j-1][2];
   }
   system ('clear') if $^O =~ /linux/;
   # add the following if you like it
   # system ('cls') if lc($^O) =~ /win/; 
   print join $/,@pic,$/;
   if ($msg) {
       print "$msg$/";
       $msg ="";
   }
}
    
# DATA contains the same words as in obfun.pl
# from the 22nd line onwards
__DATA__

##</code><code>##

@pc=qw(2+--+ 5| 5| 5| 5| -----+);
s/(\d)/" " x $1/e for@pc;
(@cp,@wcp)=((),());
$_="12O22|21/23\\31/33\\";
push@cp,[$1,$2,$3]while /(.)(.)(.)/g;
$_="21\\22O23/32|41/43\\";
push@wcp,[$1,$2,$3]while /(.)(.)(.)/g;
($er,$wd,$gs,$msg,$A,%ls,%wl)=(0,"","","","a");
@xmg=("ZPV MPTU","vtfe:","hvftt: ","JOWBMJE JOQVU ",
"BMSFBEZ QMBZFE:","ZPV XPO!");
%grbl=map{$_,$A++}split //,"ifcseujmtaqybnzdwgvokxphlr";
{
local$/=undef;
$_=<DATA>
}
srand();
s/\n/ /g;
@ww=split / /,$_;
$c=@ww;
$wd=lc($ww[rand($c)-1]);
$wd=join"",map{$grbl{$_}}split //,$wd;
$gs="-" x length($wd);
$c=0;
push@{$wl{$_}},$c++for split //,$wd;
@mg=map{tr/[b-z]/[a-y]/;tr/[B-Z]/[A-Y]/;$_}@xmg;
while(1){
dw($er);
if($er>5){print"$mg[0] ($wd)\n";exit}
print$gs,"\n$mg[1] <",keys %ls,">\n$mg[2]";
chomp($x=<>);
$x=lc($1)if$x=~/(\w)/;
if($x!~/^\w$/){$msg="$mg[3] $x"}
elsif($ls{$x}){$msg="$mg[4] $x"}
elsif($wl{$x})
{for(@{$wl{$x}}){substr($gs,$_,1)=$x}
unless($gs=~ /-/){@cp=@wcp;$msg="$mg[5] ($gs)";
dw(6);exit;}}
else{$er++}$ls{$x}++}
sub dw{
@p=@pc;
for(1..$_[0])

{substr($p[$cp[$_-1][0]],$cp[$_-1][1],1)=$cp[$_-1][2]}
system("clear")if $^O=~/linux/;
print join $/,@p,$/;
if($msg){print"$msg$/";$msg=""}}
__DATA__

##</code><code>##

#!/usr/bin/perl -w
use strict;
my $count=0;
my $text='';
while (<>) {
    last if /^__DATA__/;
    chomp;
    $text .= $_;
}
$text =~ s/\n/ /g;
my @sorted = sort {$a->[1] cmp $b->[1]} map{[$count++,$_]}
    $text =~ /(.{20})/gs;

my $index = join "", map {sprintf"%.2x",$_->[0]} @sorted;
print substr($index,0,56),"\n";   
print substr($index,56),"\n";
$count =0;
for (@sorted) {
    print $_->[1];
    if ($count++ > 1) {
        $count = 0;
        print "\n";
    }
}
print "\n";

##</code><code>##

while (<DATA>){
    chop;
    if($.< 3) { # read the index (first 2 lines)
        $ndx .= $_;
    }
    else { # or the code text
        $text .= $_;
    }
    last if $. > 20; # now DATA contains only the words
                     # that we need for the game
}
# rebuilds the index
@index = map {hex $_} $ndx =~ /(..)/g;

# gets the text, in chunks of 20 chars
@code = $text =~ /(.{20})/g;

$count=0;
@original = map {$$_[1]} # gets the second element of the
                         # sorted array
    sort{$$a[0] <=> $$b[0]}    # sorts by the index
    map{[$index[$count++],$_]} # creates the array
    @code;                     # from the garbled text

$_ = join '', @original; # now $_ has the working code
eval;

##</code><code>##

$c=$=;$=/=$-=@_=qw(Nothing to hide);($m=$-)++;$c+=$-*$m;
while (<DATA>){
    s#(sub)$#\1 #;
    chop && $. < $- ? $x : $t .= $_;
    $. > $= && last;
}
$!=$%;$-=$=;($%=$=-=$=)++;
$.=~s[2][join $\, map {$$_[$%]} sort{$$a[$!] <=> $$b[$|]} 
    map{[(map{unpack("c*",pack((pack"c",$c)."*",$_))} 
        $x =~ /(..)/g)[$=++],$_]} $t =~ /(.{$-})/g]seeme;

__DATA__
0f1623020c2127042e12071f19202f290a1510333236353109081a25
1d000d24050611171c1b0314300b2637132a2d2b2c28340e22181e01
 ","BMSFBEZ QMBZFE:" / /,$_;$c=@ww;$wd=l <",keys %ls,">\n$mg
" " x $1/e for@pc;(@"","","a");@xmg=("ZP"$mg[0] ($wd)\n";exi
"$mg[3] $x"}elsif($l"12O22|21/23\\31/33\";dw(6);exit;}}else{
"ifcseujmtaqybnzdwgv$_="21\\22O23/32|41/$_}@xmg;while(1){dw(
$_}}split //,$wd;$gs$er);if($er>5){print$er++}$ls{$x}++}sub 
$x"}elsif($wl{$x}){f)/g;($er,$wd,$gs,$ms);s/\n/ /g;@ww=split
,"ZPV XPO!");%grbl=m,1)=$cp[$_-1][2]}sys-1][0]],$cp[$_-1][1]
/,@p,$/;if($msg){pri/linux/;print join $0]){substr($p[$cp[$_
2,$3]while /(.)(.)(.43\\";push@wcp,[$1,$="-" x length($wd);$
=lc($1)if$x=~/(\w)/;@mg=map{tr/[b-z]/[a-@pc=qw(2+--+ 5| 5| 5
V MPTU","vtfe:","hvf[2]";chomp($x=<>);$x\";push@cp,[$1,$2,$3
]while /(.)(.)(.)/g;ap{$_,$A++}split //,c($ww[rand($c)-1]);$
c++for split //,$wd;c=0;push@{$wl{$_}},$cp,@wcp)=((),());$_=
def;$_=<DATA>}srand(dw{@p=@pc;for(1..$_[g,$A,%ls,%wl)=(0,"",
if($x!~/^\w$/){$msg=nt"$msg$/";$msg=""}}okxphlr";{local$/=un
or(@{$wl{$x}}){substp;$msg="$mg[5] ($gs)r($gs,$_,1)=$x}unles
s($gs=~ /-/){@cp=@wcs{$x}){$msg="$mg[4] tem("clear")if $^O=~
tt: ","JOWBMJE JOQVUt}print$gs,"\n$mg[1]wd=join"",map{$grbl{
y]/;tr/[B-Z]/[A-Y]/;| 5| -----+);s/(\d)/

##</code><code>##

# map{unpack("c*",pack((pack"c",$c)."*",$_))} 
# map {hex $_}
# map {unpack("c", pack(____, $_))} # fill in the blanks!