#!/usr/bin/env perl

use strict;
use warnings;


# Current location of player and a helper variable
my $location = 'lounge';
my $oldlocation = '';

# define some rooms to have, uh, room to run around
my %rooms = (
    lounge  => {
        name    => 'The Lounge',
        description => 'You are in the lounge, a rather gloomy place.',
        exits   => {
            'west'  => 'cavern1',
            'east'  => 'monastery',
        },
    },
    'cavern1'  => {
        name    => 'Dark cavern',
        description => 'You are in a dark cavern. Bloodstains mare the walls',
        exits   => {
            east    => 'lounge',
            west    => 'cavern2',
        },
    },
    'cavern2'  => {
        name    => 'Completly dark cavern',
        description => 'You are in a very dark cavern. You hear strange noises, but the only thing you can see is a glimmer from the eastern entrance.',
        exits   => {
            east    => 'cavern1',
            west    => sub {die "You get eaten by a grue!";},
            north    => sub {
                    print "A hyperdimensional field wraps you in colored lights.\n";
                    sleep(10);
                    print "You feel like you are beeing pulled into a randomly selected room...\n";
                    sleep(10);
                    if(rand(100) > 50) {
                        $location = 'cavern1';
                    } else {
                        $location = 'lounge';
                    }
                    print "You materialize in...\n";
                    sleep(10);
                },
            south   => sub {die "NO-COFFEE-ERROR: Unimplemented room!";},
        },
    },
    'monastery' => {
        name    => 'The Monastery',
        description    => 'You are in the monastery. All around you, geeks are writing Perl code.',
        exits  => {
            west    => 'lounge',
        },
    },
);

# Put some stuff in that room
my %objects = (    
    'table'  => {
        location => 'lounge',
        short   => 'a small wooden table',
        long    => 'It\'s a small, wooden table. It looks cheap.',
        actions => {
            take    => 'You put the wooden table in your magic pocket.',
            drop    => 'You carefully put down the table.',
        },
    },
    'monk'  => {
        location    => 'monastery',
        short   => 'a Perl monk',
        long    => 'A scruffy guy with long hair and a T-Shirt that reads "touch() && die()"\n',
        actions => {
            touch    => sub{
                print "You touch the monk. He instantly send SIGNAL 11 back to you\n";
                die;
            },
        },
    },
    'book'  => {
        location    => 'inventory',
        short   => 'a pocket book',
        long    => 'It\'s the Perl regular expression reference guide pocket book.',
        actions => {
            take    => 'You jump up and down in joy!',
            drop    => 'Your mood suddenly changes for the worse :-(',
            read    => 'You suddenly feel much smarter.',
        },
    },
    'sign'  => {
        location    => 'monastery',
        short   => 'a sign',
        long    => 'A big warning sign with big red letters!',
        actions => {
            read    => 'It says: "TYE BROKE THE MONASTERY!"',
        },
    },
);


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 '');
    
    # 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";
    }
}