Re: Text Based Perl Game

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]

Comment on Re: Text Based Perl Game Select or Download Code


Perl-Sensitive Sunglasses
	PerlMonks