#!/usr/bin/env perl

use strict;
use warnings;
use MIME::Base64;

my $gamefile = shift @ARGV;

if(!defined($gamefile) || !-f $gamefile) {
        die("Usage: perl PMAdventures.pl gamefile");
}

# Main game variables
my $location = '';
my $oldlocation = '';
my (%rooms, %objects, %synonyms);
my %mlevels = (
    -100=> 'Pennance required',
    0   => 'Initiate',
    20  => 'Novice',
    50  => 'Acolyte',
    90  => 'Sexton',
    150 => 'Beadle',
);
my $xp = 0;

open(my $ifh, '<', $gamefile) or die($!);
my @lines = <$ifh>;
close $ifh;

my $completefile;
if($lines[0] =~ /B64GAMEFILE/) {
    shift @lines;
    $completefile = decode_base64(join('', @lines));
} else {
    $completefile = join('', @lines);
}

eval($completefile) or die($@);

while(1) {
    #print the room description
    if($location ne $oldlocation) {
        $oldlocation = $location;
        print "\n\n";
        print $rooms{$location}->{name}, "\n";
        print '=' x length($rooms{$location}->{name}), "\n\n";
        if(!defined($rooms{$location}->{visited}) || !$rooms{$location}->{visited}) {
            $rooms{$location}->{visited} = 1;
            print $rooms{$location}->{description}, "\n";
        }
        print "You see:\n";
        foreach my $key (sort keys %objects) {
            if($objects{$key}->{location} eq $location) {
                print "  ", $objects{$key}->{short}, "\n";
            }
        }
        print "There are exits in this direction(s): ", join(',', sort keys %{$rooms{$location}->{exits}}), "\n";
    }
    
    # Ask the player what to do
    print "What next: ";
    my $cmd = <>;
    
    # Primitively clean up the input
    chomp $cmd;
    $cmd = lc $cmd;
    $cmd =~ s/(\s+)/\ /g;
    $cmd =~ s/^\ //;
    $cmd =~ s/\ $//;
    next if($cmd eq '');
    
    # Apply synonyms
    foreach my $key (keys %synonyms) {
        my $repl = $synonyms{$key};
        $cmd =~ s/$key/$repl/;
    }
    print "(DEBUG) I heard '$cmd'\n";
    
    # allow the player to finish
    if($cmd =~ /(quit|exit)/i) {
        print "Goodbye.\n";
        last;
    }
    
    # We don't like nice users. Just state what you want!
    if($cmd =~ /please/i) {
        print "I don't know how to please!\n";
        next;
    }
    
    # Force re-displaying the room description
    if($cmd eq 'look') {
        $oldlocation = '';
        $rooms{$location}->{visited} = 0;
        next;
    }
    
    # Wanna take us to another room?
    if(defined($rooms{$location}->{exits}->{$cmd})) {
        # Check to see if its a code section, else just move
        # the player to that room
        if(ref($rooms{$location}->{exits}->{$cmd}) eq 'CODE') {
            $rooms{$location}->{exits}->{$cmd}->();
        } else {
            $location = $rooms{$location}->{exits}->{$cmd};
        }
        next;
    }
    
    # The inventory command
    if($cmd eq 'inventory') {
        print "Your open pocket reveals:\n";
        foreach my $key (sort keys %objects) {
            if($objects{$key}->{location} eq 'inventory') {
                print "  ", $objects{$key}->{short}, "\n";
            }
        }        
    }
    
    # Look for a simple two-verb command
    if($cmd =~ /(\w+)\ (\w+)/) {
        my ($verb, $thing) = ($1, $2);
        
        # Check if the object exists
        if(!defined($objects{$thing})) {
            print "Sorry, the programmer never invented a $thing!\n";
            next;
        }
        
        # Ok, next, let's see if the object is in reach
        if($objects{$thing}->{location} ne 'inventory' && $objects{$thing}->{location} ne $location) {
            print "You can't see $thing anywhere near you!\n";
            next;
        }
        
        # Allow "describe" action
        if($verb eq "describe") {
            print $objects{$thing}->{long}, "\n";
            next;
        }        
        
        # Check if it is an allowed action for this object
        if(!defined($objects{$thing}->{actions}->{$verb})) {
            print "You can't do that to $thing\n";
            next;
        }
        
        # First of all, if the action is a sub, execute it and be done with it.
        if(ref($objects{$thing}->{actions}->{$verb}) eq 'CODE') {
            $objects{$thing}->{actions}->{$verb}->();
            next;
        }
        
        # Inventory-related actions
        if($verb eq 'take') {
            if($objects{$thing}->{location} eq 'inventory') {
                print "You already have that in your magic pocket!\n";
                next;
            }
            $objects{$thing}->{location} = 'inventory';
            print $objects{$thing}->{actions}->{$verb}, "\n";
            next;
        }
        if($verb eq 'drop') {
            if($objects{$thing}->{location} ne 'inventory') {
                print "You can't find that object anywhere within your vast magic pocket!\n";
                next;
            }
            $objects{$thing}->{location} = $location;
            print $objects{$thing}->{actions}->{$verb}, "\n";
            next;
        }
        
        
        # Uhm, ok, this seems to be a text-printing-only action, like reading a sign
        print $objects{$thing}->{actions}->{$verb}, "\n";
        
        next;
        
    }
    
    # Scratch head and try again
    if(rand(100) > 50) {
        print "Sorry, could you state that more clearly?\n";
    } else {
        print "I'll just stand around scratching my head instead...\n";
    }
}

sub getCurrentMLevel {
    foreach my $key(reverse sort{$a <=> $b} keys %mlevels) {
        if($xp >= $key) {
            return $mlevels{$key};
        }
    }
    return "EE has encountered an internal error.";
}
sub getNextMLevel {
    foreach my $key(sort{$a <=> $b} keys %mlevels) {
        if($xp < $key) {
            return ($key- $xp, $mlevels{$key});
        }
    }
    return "EE has encountered an internal error.";
}

sub showScore {
    print "You have $xp XP (", getCurrentMLevel(), ")\n";
    return;
}

sub gainScore {
    my ($gain) = @_;

    my @x = ('It tastes just like chicken.',
             'You are a unique snowflake.',
             'As if it mattered.',
             'Non-refundable.',
             'Are you shure you want to do this?',
             );
    
    $xp += $gain;
    
    if($gain > 0) {
        print "You gained $gain XP. ", $x[ rand @x ], "\n";
        my ($diff, $nl) = getNextMLevel();
        print "You have $diff points until next level: $nl\n";
    } elsif($gain < 0) {
        print "You LOST $gain XP!\n";
    } else {
        print "Your XP remains unchanged.\n";
    }
    
    return;
}