comment on

Hi Spoonman2525.

I think a more object oriented approach will help you. My examples below are far from polished and perfect, but should still help you.

For starters, I would abstract a 'player' and a 'room' to a type. This way, you can free them from being locked into a subroutine. This also allows you to setup a central command parser instead of having a set of commands for each room or action.

Listed below is a skeleton of a more object oriented game. It does not contain all of the detail of your storyline, but it does show how to create a player ( it sets a character name, but you can change this behavior ) and load rooms. Within the current framework a player can pickup and drop items. Moving between rooms (so long as the door is not locked) is also allowed.

The main game loop also needs a little work. I tried implement a framework that would allow the game to progress instead of halting on waiting for user input from <STDIN>.

With all that said, I really hope that all of this helps. Best of luck with the game and your learning! I am interested to see what your next version looks like.

Here is a sample player module.

player.pm

package player;

use strict;
use warnings;

use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw
        (new setPlayerStandingStatus getPlayerStandingStatus setPlayer
+Position getPlayerPosition);
        
%EXPORT_TAGS = ( ALL    => 
                      [qw(&new &setPlayerStandingStatus &getPlayerStan
+dingStatus &setPlayerPosition &getPlayerPosition)]);

sub new
{
    my $class = shift;
    my $self  = 
        {
            _NAME => shift,
            _STANDING => shift,
            _POSITION => shift,
            _INVENTORY => shift,
            _HP => shift,
            _MP => shift,
            _EXP => shift
            
        };
    bless $self,$class;
    return $self;
}

sub updatePlayerName
{
    my ($self,$player_name) = @_;
    $self->{_NAME} = $player_name if defined($player_name);
    return $self->{_NAME};
}

sub getPlayerName
{
    my( $self ) = @_;
    return $self->{_NAME};
}

sub updateitemPlayerInventory
{
    my ($self,$item,$quantity) = @_;
    if ($quantity == 0)
    {
        delete $self->{_INVENTORY}{$item};
    }
    else
    {
        $self->{_INVENTORY}{$item} = $quantity if defined ($quantity);
    }
    return $self->{_INVENTORY};
}

sub getPlayerInventory
{
    my( $self ) = @_;
    return ($self->{_INVENTORY});
}

sub setPlayerStandingStatus
{
    my ($self,$standing_status) = @_;
    $self->{_STANDING} = $standing_status if defined($standing_status)
+;
    return $self->{_STANDING};
}

sub getPlayerStandingStatus
{
    my( $self ) = @_;
    return $self->{_STANDING};    
}


sub setPlayerPosition
{
    my ($self,$position) = @_;
    $self->{_POSITION} = $position if defined($position);
    return $self->{_POSITION};
}

sub getPlayerPosition
{
    my( $self ) = @_;
    return $self->{_POSITION};
}


1;
[download]

Here is a sample game room module.

gameroom.pm

package gameroom;

use strict;
use warnings;

use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw
        (updateRoomName getRoomName updateRoomInventoryItems getRoomIn
+ventoryItems updateRoomUseItems getRoomUseItems);
        
%EXPORT_TAGS = ( ALL    => 
                      [qw(&updateRoomName &getRoomName &updateRoomInve
+ntoryItems &getRoomInventoryItems &updateRoomUseItems &getRoomUseItem
+s)]);

sub new
{
    my $class = shift;
    my $self  = 
        {
            _NAME => shift,
            _INVENTORY_ITEMS => shift,
            _ROOM_USE_ITEMS => shift,
            _CONNECTIONS => shift
        };
    bless $self,$class;
    return $self;
}

sub updateRoomName
{
    my ($self,$room_name) = @_;
    $self->{_NAME} = $room_name if defined($room_name);
    return $self->{_NAME};
}
sub getRoomName
{
    my( $self ) = @_;
    return $self->{_NAME};
}

sub updateRoomInventoryItems
{
    my ($self,$item,$quantity) = @_;
    if ($quantity == 0)
    {
        delete($self->{_INVENTORY_ITEMS}{$item});
    }
    else
    {
        $self->{_INVENTORY_ITEMS}{$item} = $quantity if defined($quant
+ity);
    }
    return $self->{_INVENTORY_ITEMS};
}

sub getRoomInventoryItems
{
    my( $self ) = @_;
    return ($self->{_INVENTORY_ITEMS});
}

sub updateRoomUseItems
{
    my ($self,$item,$quantity) = @_;
    if ($quantity == 0)
    {
        delete($self->{_ROOM_USE_ITEMS}{$item});
    }
    else
    {
        $self->{_ROOM_USE_ITEMS}{$item} = $quantity if defined($quanti
+ty);
    }
    return $self->{_ROOM_USE_ITEMS};
}
sub getRoomUseItems
{
    my( $self ) = @_;
    return ($self->{_ROOM_USE_ITEMS});
}


sub updateRoomConnections
{
    my ($self,$room,$locked_state,$key_item) = @_;
    $self->{_CONNECTIONS}{$room}[0] = $locked_state if defined($locked
+_state);
    $self->{_CONNECTIONS}{$room}[1] = $key_item if defined($key_item);
+        
    return $self->{_CONNECTIONS};
}

sub getRoomConnections
{
    my( $self ) = @_;
    return ($self->{_CONNECTIONS});
}

1;
[download]

Here is a sample game room loadfile. You can play with the Bedroom door by changing 'LOCKED' to 'UNLOCKED'

__game_rooms.txt

ROOMNAME#INVENTORY_ITEMS~qty,...INVENTORY_ITEMS#ROOMUSEITEMS~qty....RO
+OMUSEITEMS#CONNECTIONS[name~locked_state~key_item,]...CONNECTIONS
BEDROOM#UNIFORM~1,KEYCARD~1,LIGHTER~1#LIGHTSWITCH~1#HALLWAY~LOCKED~KEY
+CARD
HALLWAY###BEDROOM~UNLOCKED,LABORATORY~LOCKED~KEYCARD
LABORATORY#
CONTROL_ROOM#
[download]

Here is a sample commands helpfile.

__commands.txt

    WHEREAMI    : Player Position
    USE [] ON []    : USE [item] ON [item]
    MOVETO         : Moveto [room]
    INV             : Player Inventory
    RINV        : Room Inventory
    QUIT        : Exit game
    ? or HELP    : Help Commands
[download]

Here is the main game script.

#!/usr/bin/perl
use 5.14.1;
use strict;
use warnings;
use Data::Dumper;
use Class::Struct;
use threads;
use threads::shared;
use Time::HiRes qw( time );

use player qw(:ALL);
use gameroom qw(:ALL);

$|=1;

use constant
{
    ## ROOMS ##
        MAIN_MENU => 0,
        BEDROOM_MENU => 1,
        HALLWAY_MENU => 2,
        LAB_MENU => 3,
        CONTROL_ROOM_MENU => 4,
    
    ## DATA ##
        DATAFILE => 'savegamefile.txt',
        STORYLINE => '__storyline.txt',        
        GAMEROOMS => '__game_rooms.txt',
        COMMANDS =>  '__commands.txt'        ## need error checking on
+ file 
};

my $__CURRENT_PLAYER = undef;

my $__USER_INPUT_LINE = undef;

my %__ROOMS_hash; ##Store room name with class ref as value.

my %__MENUS_hash = 
(
MAIN_MENU => <<'END_MAIN',
    ###########################################################
                         MARTIAN MYSTERY
                          VERSION 1.0
                      FRAMEWORK CREATOR: VINCENT K
                      STORYLINE BY : TYLER BURROWS
    ###########################################################
                            MAIN MENU
    1:.................................................NEW GAME
    2:................................................LOAD GAME
    3:................................................QUIT GAME
    
    ###########################################################
                    PLEASE CHOOSE FROM THE MENU
END_MAIN
LAB_MENU => <<'END_LAB',
    ###########################################################
                           SAMPLE MENU
    ###########################################################
                            LAB MENU
    1:.................................................NEW GAME
    2:................................................LOAD GAME
    3:................................................QUIT GAME
    
    ###########################################################
                    PLEASE CHOOSE FROM THE MENU
END_LAB



);

sub start_screen();            # Display game splash screen.
sub init();                # Initialize starting game values          
+        

sub display_menu($);            # Display a menu
sub display_rooms_for_testing($);    # Testing sub for displaying cont
+ents of loaded rooms
sub display_room_connections($);    # Testing sub for dispalying rooms
+ and their connections
                    #     to other rooms.

sub create_new_player();        # Create a new player object
sub load_game_rooms();            # Load game rooms from a data file

sub main_game_loop();            # Main game loop. This will loop unil
+ the script is exited
                    #     This is set to allow procssing of data while
+ waiting
                    #    on user input from <STDIN>
sub read_stdin();            # Read <STDIN> from game_loop

sub load_game_storyline();        # Load game storyline dialog

sub display_cursor($);            # Dislay main cursor
sub display_game_output($);        # Main sub for outputting print fro
+m various sub's
sub process_user_command($);        # Process user command and execute
+ appropriate sub's
sub apply_game_rules();            # Apply game rules. Part of main_ga
+me_loop. On each cycle
                    #    game rules are evaluated to see what the play
+er status
                    #    in the game is

sub display_player_inventory();        # Display player inventory
sub display_room_inventory();        # Display room inventory - more o
+f a testing function

sub display_player_position();        # Display player room position

sub drop_item($);            # Player drops an item
sub pickup_item($);            # Player picks an item up
sub use_item($);            # Player uses an item
sub look($);                # Player looks around or reads something
sub move($);                # Player moves

######################################################################
+######
###########################       MAIN        ########################
+######
######################################################################
+######

my $user_choice = start_screen();

if ($user_choice == 1)
{
    ## New game
        init();
}
elsif ($user_choice == 2)
{
    ## Load saved game
        init();
        #load_saved_player_data_file();
}
else
{
    ## Quit game.
        print "\n\n";
        exit(0);
}

## uncomment next lines for testing
##display_rooms_for_testing(\%__ROOMS_hash);
##display_room_connections(\%__ROOMS_hash);

## main game loop, will run until exited.. 
main_game_loop();

print "\n\n";
exit(0);

######################################################################
+######
###########################    SUBROUTINES    ########################
+######
######################################################################
+######
sub load_game_storyline()
{
    print "\n\n\t ** Loading Storyline **\n";
    open( my $STORYLINE_FH, "<", STORYLINE ) || die "Can't open STORYL
+INE: $!";
        <$STORYLINE_FH>; # skip file header
        while(<$STORYLINE_FH>)
        {
            chomp;
        }
    close($STORYLINE_FH);
}

sub display_cursor($)
{    
    my $mode = shift;
    my ($user, $system, $child_user, $child_system) = times;
    printf("%s\t<Clock %.2f type 'help' for commands>:", $mode,$user);
}

sub print_storyline_dialog()
{

}

sub start_screen()
{
    my $user_choice;
    do
    {    
        # Clear the screen for the next menu
        system(($^O eq 'MSWin32') ? 'cls' : 'clear');
    
        display_menu('MAIN_MENU');
        print "\n\n";
        display_cursor("\n");
        chomp( $user_choice = <> );
    } until ($user_choice eq '1' || $user_choice eq '2' || $user_choic
+e eq '3');

    return $user_choice;
}

sub init()
{
    # Clear the screen for the next menu
        system(($^O eq 'MSWin32') ? 'cls' : 'clear');    
    # Load game rooms
        load_game_rooms();    
    # Load game storyline
        load_game_storyline();
    # Create new game player
        return create_new_player();
}

sub display_menu($)
{
    my $menu_no = shift;
    print $__MENUS_hash{$menu_no};
}

sub display_rooms_for_testing($)
{
    my $hashref = shift;
    my %ROOMS_hash = %{$hashref};
    
    print "\n\n\t ** TEST DISPLAY OF ROOM CONTENTS ** \n";
    foreach my $key (sort keys %ROOMS_hash)
    {
        print "\n\tRoom is : $key\n";
        print "\t",'#'x30,"\n";
        
        my $curr_room_ref = $ROOMS_hash{$key};
        my $curr_rm_items = $curr_room_ref->getRoomInventoryItems;
        
        while( my( $key, $value ) = each %{$curr_rm_items} )
        {
            print "\t\t$key: qty $value\n";
        }
        
        print "\t\t",'-'x30,"\n";
        
        my $curr_rm_use_items = $curr_room_ref->getRoomUseItems;
        
        while( my( $key, $value ) = each %{$curr_rm_use_items} )
        {
            print "\t\t$key: qty $value\n";
        }                
    }
}

sub display_room_connections($)
{
    my $hashref = shift;
    my %ROOMS_hash = %{$hashref};
    
    print "\n\n\t ** TEST DISPLAY OF ROOM CONNECTIONS ** \n";
    foreach my $key (sort keys %ROOMS_hash)
    {
        print "\n\tRoom is : $key\n";
        print "\t",'#'x30,"\n";
        
        my $curr_room_ref = $ROOMS_hash{$key};
        my $curr_rm_connections = $curr_room_ref->getRoomConnections;
        
        while( my( $key, $value ) = each %{$curr_rm_connections} )
        {
            print "\t\tRoom: $key: State :@{$value}[0] Key: @{$value}[
+1]\n";
        }
        
        print "\t\t",'-'x30,"\n";    
            
    }    

}


sub create_new_player()
{
    $__CURRENT_PLAYER = player->new();
    $__CURRENT_PLAYER->updatePlayerName("CRISPIN");
    $__CURRENT_PLAYER->updateitemPlayerInventory("EMPTY",0);
    $__CURRENT_PLAYER->setPlayerPosition("BEDROOM");
}

sub load_game_rooms()
{
    print "\t ** Loading Rooms **\n";
    open( my $GAMEROOM_FH, "<", GAMEROOMS ) || die "Can't open GAMEROO
+MS: $!";
        <$GAMEROOM_FH>; # skip file header
        while(<$GAMEROOM_FH>)
        {
            chomp;
            next if ($_ eq "" || $_ !~ /\S+/);
            my @roomline = split(/\#/,$_) if ($_ =~ m/\#/) || die "Mal
+formed room line at ".GAMEROOMS."$!";
            my @room_inventory_items = split(/\,/,$roomline[1]) if ($#
+roomline > 0);
            my @room_use_items = split(/\,/,$roomline[2]) if ($#roomli
+ne > 1);
            my @room_connections = split(/\,/,$roomline[3]) if ($#room
+line > 2);

            die "Duplicate Room name at ".GAMEROOMS."$!" if (exists $_
+_ROOMS_hash{$roomline[0]});

            my $new_room = gameroom->new();

            $new_room->updateRoomName($roomline[0]);
            
            ## Load room items
                if ($#room_inventory_items > -1)
                {
                    foreach my $item (@room_inventory_items)
                    {
                        die "Quantity of item missing from item at".GA
+MEROOMS."$!" if ($item !~ m/\~/);
                        my @temp = split(/\~/,$item);
                                             # item  , qty
                        $new_room->updateRoomInventoryItems($temp[0],$
+temp[1]);
                    }
                }
                else
                {
                    $new_room->updateRoomInventoryItems("EMPTY",0);
                }
            ## Load room use items    
                if ($#room_use_items > -1)
                {
                    foreach my $item (@room_use_items)
                    {
                        die "Quantity of item missing from item at".GA
+MEROOMS."$!" if ($item !~ m/\~/);
                        my @temp = split(/\~/,$item);
                                             # item  , qty            
+            
                        $new_room->updateRoomUseItems($temp[0],$temp[1
+]);
                    }
                }    
                else
                {
                    $new_room->updateRoomUseItems("EMPTY",0);
                }
            ## Load room connections
                if ($#room_connections > -1)
                {            
                    foreach my $item (@room_connections)
                    {
                        die "Connections missing from item at".GAMEROO
+MS."$!" if ($item !~ m/\~/);
                        my @room_connections = split(/\,/,$item);
                        
                        foreach my $current_conn (@room_connections)
                        {
                            my @room_conn_items = split(/\~/,$current_
+conn);
                            
                            my $room_name = "NONE";
                            my $room_locked_state = "NONE";
                            my $room_key_item = "NONE";
                            
                            die "BAD room connection" unless defined($
+room_conn_items[0]);
                            
                            $room_name = $room_conn_items[0];
                            $room_locked_state = $room_conn_items[1] i
+f defined($room_conn_items[1]);
                            $room_key_item = $room_conn_items[2] if de
+fined($room_conn_items[2]);

                            $new_room->updateRoomConnections($room_nam
+e,$room_locked_state,$room_key_item);
                        }                        
                    }                    
                }
                else
                {
                    $new_room->updateRoomConnections("NONE","NONE","NO
+NE");
                }
            ## Store room in its entirety
                $__ROOMS_hash{$roomline[0]} = $new_room;

            print "\t\tRoom ".lc($roomline[0]),'.'x10;
            sleep 1;
            print "Loaded\n";
        }
    close($GAMEROOM_FH);
}

sub main_game_loop()
{
    no warnings;
    share($__USER_INPUT_LINE);

    my $thr = threads->create(\&read_stdin);
    
    display_cursor("\n");

    while(1)
    {
        if ($__USER_INPUT_LINE ne "")
        {
            lock($__USER_INPUT_LINE);
            chomp $__USER_INPUT_LINE;
            
            ##print "parent process $__USER_INPUT_LINE\n";
                    
            last if ($__USER_INPUT_LINE eq "quit");

            
                ## process command ##
                
                process_user_command($__USER_INPUT_LINE);
                ##$__USER_INPUT_LINE = apply_game_rules();
                
                $__USER_INPUT_LINE = "";
                display_cursor("\n");
            
        }
        else
        {
            ## While waiting for input, process game rules.
                ## Example ##
                last if (apply_game_rules() eq "win")

        }
    }
    my $res = $thr->join();
}

sub read_stdin()
{
    while (<STDIN>)
    {
        lock($__USER_INPUT_LINE);
        $__USER_INPUT_LINE = $_;
        chomp $__USER_INPUT_LINE;
        display_cursor("\n");
        ##print "child read in: $_\n";
        return if ( $__USER_INPUT_LINE eq "quit");
    }
}

sub process_user_command($)
{
    my @commands = split(/\ /,$_[0]);

    if (uc($commands[0]) eq "DROP")
    {
        ## drop item
            drop_item(uc($commands[1]));
    }
    elsif ( uc($commands[0]) eq "WHEREAMI" )
    {
        ## print room in which player resides
            display_player_position();
    }
    elsif ( uc($commands[0]) eq "PICKUP" )
    {
        ## pick up item 
            pickup_item(uc($commands[1])); 
    }
    elsif ( uc($commands[0]) eq "MOVETO" )
    {
        ## move player to another room
        move(uc($commands[1]));
    }
    elsif ( uc($commands[0]) eq "LOOK" )
    {
        ## look around the room or at an object 
        if ( defined $commands[1] ) 
        {
            look(uc($commands[1]));
        }
        else
        {
            look("");
        }
    }    
    elsif ( uc($commands[0]) eq "INV" )
    {
        ## print user inventory
            display_player_inventory();    
    }
    elsif ( uc($commands[0]) eq "RINV-TESTING" )
    {
        ## print room inventory
            display_room_inventory();
    }
    elsif ( uc($commands[0]) eq "USE" )
    {
        ## use item ,format use [item] on [item]
            use_item($_[0]);
    }
    elsif ( uc($commands[0]) eq "?" || uc($commands[0]) eq "HELP")
    {
        ## display commands for player
        
        print "\n\n\t ** COMMANDS ** \n";
        print "\t",'#'x30,"\n";
        system("type ".COMMANDS);        ## Need a check here
        
    }
    else
    {
        display_game_output("\n\t\tWhat?");    
    }
}

sub apply_game_rules()
{
    my $curr_items = $__CURRENT_PLAYER->getPlayerInventory;
    my %items = %{$curr_items};    

    if ( exists $items{"KEYCARD"} && $items{"KEYCARD"} == 2 )
    {
        # say win
        display_game_output("\n\t\t ** You win!! **");
        return "win";
    }
}

sub display_player_inventory()
{
    my $curr_items = $__CURRENT_PLAYER->getPlayerInventory;
    my %items = %{$curr_items};

    print "\n\n\t == Player [".$__CURRENT_PLAYER->getPlayerName."] Inv
+entory ==\n";
    print "\t",'#'x30,"\n";
    
    if (keys %items == 0)
    {
        print "\t\t** YOU DO NOT HAVE ANY ITEMS **\n";
    }
    else
    {
        while( my( $key, $value ) = each %items )
        {        
            print "\t\t$key: qty $value\n";##if ($value > 0 && $key ne
+ "EMPTY");
        }
    }
    print "\t\t",'-'x30,"\n";
}

sub display_room_inventory()
{
    my $current_room = $__CURRENT_PLAYER->getPlayerPosition();

    my $curr_room_ref = $__ROOMS_hash{$current_room};
    my $curr_rm_items = $curr_room_ref->getRoomInventoryItems;
    my %room_items = %{$curr_rm_items};

    print "\n\n\t == Room [$current_room] Inventory ==\n";
    print "\t",'#'x30,"\n";
    
    if (keys %room_items == 0)
    {
        print "\t\t ** ROOM IS EMPTY ** \n";
    }
    else
    {
        while( my( $key, $value ) = each %room_items )
        {
            print "\t\t$key: qty $value\n";## if ($value > 0 && $key n
+e "EMPTY");
        }
    }
    print "\t\t",'-'x30,"\n";
}

sub drop_item($)
{
    my $_DROP_ITEM = uc(shift);
    
    my $curr_items = $__CURRENT_PLAYER->getPlayerInventory;

    my %items = %{$curr_items};

    if ( exists $items{uc($_DROP_ITEM)} && $items{uc($_DROP_ITEM)} > 0
+ )
    {
        my $count = $items{uc($_DROP_ITEM)};
        display_game_output("Dropped item : $_DROP_ITEM");

        ## Remove item from player inventory
            $__CURRENT_PLAYER->updateitemPlayerInventory(uc($_DROP_ITE
+M),$count-1);

        ## Add item to current room inventory
            my $current_room = $__CURRENT_PLAYER->getPlayerPosition();

            my $curr_room_ref = $__ROOMS_hash{$current_room};
            my $curr_rm_items = $curr_room_ref->getRoomInventoryItems;
            my %room_items = %{$curr_rm_items};
            my $curr_rm_item_count = 1;

            if (exists $room_items{uc($_DROP_ITEM )} )
            {
                $curr_rm_item_count = $room_items{uc($_DROP_ITEM )} + 
+1;
            }
            $curr_room_ref->updateRoomInventoryItems(uc($_DROP_ITEM),$
+curr_rm_item_count);
    }
    else
    {
        display_game_output("You do not have item : $_DROP_ITEM");
    }
}

sub pickup_item($)
{
    my $_PICKUP_ITEM = uc(shift);
    
    my $current_room = $__CURRENT_PLAYER->getPlayerPosition();

    my $curr_room_ref = $__ROOMS_hash{$current_room};
    my $curr_rm_items = $curr_room_ref->getRoomInventoryItems;
    my %room_items = %{$curr_rm_items};

    if ( exists $room_items{uc($_PICKUP_ITEM)} && $room_items{uc($_PIC
+KUP_ITEM)} > 0 )
    {
        my $count = $room_items{uc($_PICKUP_ITEM)};
        display_game_output("Picked up item : $_PICKUP_ITEM");
        
        ## Remove item from room inventory
            $curr_room_ref->updateRoomInventoryItems(uc($_PICKUP_ITEM)
+,$count-1);
        
        ## Add item to player inventory
            my $curr_player_item_count = 1;
            
            my $curr_items = $__CURRENT_PLAYER->getPlayerInventory;
            my %items = %{$curr_items};            
            
            if (exists $items{uc($_PICKUP_ITEM)} )
            {
                $curr_player_item_count = $items{uc($_PICKUP_ITEM)} + 
+1;
            }
        
            $__CURRENT_PLAYER->updateitemPlayerInventory(uc($_PICKUP_I
+TEM),$curr_player_item_count);
        
    }
    else
    {
        display_game_output("Room does not contain item : $_PICKUP_ITE
+M");    
    }
}

sub look($)
{
    display_game_output("Cannot yet look");
}

sub move($)
{
    my $_ROOM_DIRECTION = uc(shift);
    
    # Get exits for current room
    my $current_room = $__CURRENT_PLAYER->getPlayerPosition();    
    
    my $curr_room_ref = $__ROOMS_hash{$current_room};
    my $curr_rm_connections = $curr_room_ref->getRoomConnections;
    my %room_connections = %{$curr_rm_connections};
    
    
    if ( exists $room_connections{uc($_ROOM_DIRECTION)}  )
    {
        my $exit_state   = $room_connections{uc($_ROOM_DIRECTION)};
        my $locked_state = @{$exit_state}[0];
        my $key_item     = @{$exit_state}[1];
        
        ## Is exit locked
        if (uc($locked_state) eq "LOCKED")
        {
            display_game_output("Cannot move to : $_ROOM_DIRECTION");
            display_game_output("The door is locked.");
        }
        ## If not move to new room
        else
        {
            $__CURRENT_PLAYER->setPlayerPosition("$_ROOM_DIRECTION");
            display_game_output("Moved to : $_ROOM_DIRECTION");
        }
    }
    else
    {
        display_game_output("Cannot move to : $_ROOM_DIRECTION");
    }
    
    
}

sub display_player_position()
{
    display_game_output("You are in the ". $__CURRENT_PLAYER->getPlaye
+rPosition() );
}

sub use_item($)
{
    my @use_line = split(/\ /,$_[0]);
    my $_USE_ITEM = undef;
    my $_USE_ITEM_ON =undef;
    
    ## format use [item] on [item]
    
    ## validate use commmand
    if (uc($use_line[0]) eq "USE" && uc($use_line[2]) eq "ON")
    {
        $_USE_ITEM    = $use_line[1] if defined($use_line[1]);
        $_USE_ITEM_ON = $use_line[3] if defined($use_line[3]);
        
        if ( defined($_USE_ITEM) && defined($_USE_ITEM_ON) )
        {
            ## make sure player has item
                my $curr_items = $__CURRENT_PLAYER->getPlayerInventory
+;
                my %items = %{$curr_items};

                if ( exists $items{uc($_USE_ITEM)} && $items{uc($_USE_
+ITEM)} > 0 )
                {
                    ## make sure item can be used in correct context
                    
                    display_game_output(" ** NEED TO Flesh this out **
+ ");
                    
                }
                else
                {
                    display_game_output("You do not have item : $_USE_
+ITEM");
                }            
        }
        else
        {
            display_game_output("Cannot use that item in the given con
+text");
        }
    }
    else
    {
        display_game_output("Cannot use that item in the given context
+");
    }

}

sub display_game_output($)
{
    my $text = shift;
    print "\n\t\t".$text."\n";
}
[download]

In reply to Re: Text Based Perl Game by VincentK
in thread Text Based Perl Game by spoonman2525

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.


Syntactic Confectionery Delight
	PerlMonks