Games-Axmud

 view release on metacpan or  search on metacpan

lib/Games/Axmud/Session.pm  view on Meta::CPAN

            # ...where 'keycode' is an Axmud standard keycode (or keycode string)
            macroHash                   => {},
            # Registry hash of active macro interface objects which are in a cooldown period
            #   (contains a subset of $self->triggerHash). Hash in the form
            #   $macroCooldownHash{number} = cooldown expiry time (matches $self->sessionTime)
            macroCooldownHash           => {},
            # Registry list of active macro interface numbers. Contains all the keys in
            #   ->macroHash, but in order of creation, e.g. (2, 3, 5, 10, 19)
            # This makes sure that macros fire in a predictable order
            macroOrderList              => [],
            # Registry hash of active timer interface objects which have a numeric stimulus, e.g.
            #   60 for a timer that fires every 60 seconds
            # Hash in the form
            #   $timerNumHash{number} = next_fire_time
            # ...where next_fire_time matches $self->sessionTime
            timerNumHash                => {},
            # Registry hash of active timer interface objects which have a clock time stimulus in
            #   the form HH::MM (timers that fire once a day) or 99:MM (timers that fire at the same
            #   time every hour)
            # Hash in the form
            #   $timerClockHash{number} = clock_time
            timerClockHash              => {},
            # Timers with clock time stimuluses are checked once a minute. This IV records the time
            #   of the last check (and is set to a value in the form HH:MM)
            timerLastClock              => undef,
            # Registry list of active timer interface numbers. Contains all the keys in
            #   ->timerNumHash and ->timerClockHash, but in order of creation, e.g. (2, 3, 10, 19)
            # This makes sure that timers fire in a predictable order
            timerOrderList              => [],
            # Registry hash of active hook interface objects, in the form
            #   $hookHash{number} = hook_event
            hookHash                    => {},
            # Registry hash of active hook interface objects which are in a cooldown period
            #   (contains a subset of $self->hookHash). Hash in the form
            #   $hookCooldownHash{number} = cooldown expiry time (matches $self->sessionTime)
            hookCooldownHash            => {},
            # Registry list of active hook interface numbers. Contains all the keys in
            #   ->hookHash, but in order of creation, e.g. (2, 3, 5, 10, 19)
            # This makes sure that hooks fire in a predictable order
            hookOrderList               => [],

            # Interface responses that are instructions (world commands, forced world commands
            #   beginning with ',,', client commands beginning ';', echo commands beginning '"',
            #   Perl commands beginning '/', script commands beginning '&' and multi commands
            #   beginning ':') may need to access information about the event that caused the
            #   interface to fire
            # When an interface fires, the information is stored in this hash. When the response
            #   has been completed, the information is removed
            # The keys of the hash are a variable available to the programmes executed by Perl
            #   commands (those starting with '/'); e.g. the value of the key '_hookVar' is
            #   available to those programes as the variable $_hookVar
            perlCmdDataHash             => {
                # All interfaces
                '_interface'            => undef,
                # Trigger interfaces
                '_line'                 => undef,
                '_stripLine'            => undef,
                '_modLine'              => undef,
                # Alias interfaces
                '_originalCmd'          => undef,
                # Macro response
                '_keycode'              => undef,
                # Timer response
                '_timerExpect'          => undef,
                '_timerTime'            => undef,
                # Hook response
                '_hookEvent'            => undef,
                '_hookVar'              => undef,
                '_hookVal'              => undef,
            },
            # Parallel hash used by trigger interfaces which stores escape sequences (converted into
            #   Axmud colour/style tags) and their positions in a line of received text (see the
            #   comments in $self->checkAliases)
            perlCmdTagHash              => {},
            # Parallel list used by trigger interfaces which stores the portions of a line of
            #   received text which match the group substrings of the regex used as the trigger's
            #   ->stimulus (see the comments in $self->checkAliases)
            perlCmdGrpStringList        => [],

            # Tasks
            # -----

            # Tasks are mini-scripts which interact with the world, and with the data Axmud stores
            #   about the world. Axmud comes with several built-in tasks - some of which are more
            #   useful than others - and provides the possibility of the user writing new ones. (It
            #   is usually quicker to write scripts in Axmud's own scripting language, Axbasic;
            #   writing your own tasks allows you to customise Axmud's behaviour, but it's not
            #   possible to modify them which Axmud is running.)
            #
            # Actually, there are two categories of task - 'process' tasks and 'activity' tasks
            # 'Process' tasks are usually called once per task loop. They are good for performing
            #   actions in small chunks. called 'stages'. A process task might have the following
            #   chunks: (1) Go e;e;e;s;e to the bank (2) Wait for the character to arrive (3)
            #   Withdraw money (4) Check the inventory, to see if your character has enough (5) Go
            #   w;n;w;w;w to the town centre (6) Wait for the arrival (7) End the task
            # 'Activity' tasks are event-driven: after initial setup, nothing happens until they
            #   are prompted, usually as the result of a trigger, alias, macro, timer or hook
            # All tasks - both activities and processes - should inherit from GA::Generic::Task
            # Axmud maintains several tasklists. The most important one is the 'current tasklist',
            #   containing all the tasks that are running now.
            # There is also a 'global initial tasklist'. containing tasks which start as soon as the
            #   user connects to any world. Each profile also has its own initial tasklist,
            #   containing tasks which start when the user connects to a particular world, or with a
            #   particular character, and so on
            # Finally, there is also a 'custom tasklist', which wait in the background until the
            #   user starts them. These tasks are usually customised by the user to perform a
            #   particular function.
            #
            # Some tasks are 'jealous' - only one copy of them can be run at any time.
            # In any case, when a new task is created, it's given a unique name (the task object's
            #   name followed by a number)
            #
            # Task name IVs have size limits. If they are breached, the task can't initialise:
            #   ->name          16  e.g. 'status_task'
            #   ->prettyName    32  e.g. 'Status Task'
            #   ->uniqueName    24  e.g. 'status_task_15'
            #   ->stage         5   e.g. '1'
            #
            # Registry hash of tasks - the 'current tasklist'
            #   ->currentTaskHash{unique_task_name} = blessed_reference_to_task_object
            #       e.g. ->currentTaskHash{'status_task_57'}

lib/Games/Axmud/Session.pm  view on Meta::CPAN

                            'aliasCooldownHash',
                            $obj->number,
                            $self->sessionTime + $obj->ivShow('attribHash', 'cooldown'),
                        );
                    }

                    # Call the specified function
                    $class = $obj->callClass;
                    $method = $obj->callMethod;
                    $class->$method($self, $number, $originalCmd, @grpStringList);

                    # Should we continue checking other aliases?
                    if ($obj->ivShow('attribHash', 'keep_checking')) {

                        # Don't check any more aliases
                        last OUTER;
                    }
                }
            }
        }

        # Any temporary aliases which fired can now be deleted
        foreach my $obj (@deleteList) {

            $self->removeInterface($obj);
        }

        # If at least one alias fired, and the last alias to fire was a dependent alias, we return
        #   'undef' to show that there's no command to be sent to the world
        if ($depFireFlag) {

            return undef;

        # Otherwise, if the modified $cmd begins with a forward slash, evaluate it like a Perl
        #   command and use the return value as a world command
        # (However, if the original command began with a forward slash, it's because the user
        #   typed something like ',,/create', meaning 'send everything after the ,, as a literal
        #   world command' - so don't try to execute a Perl command
        } elsif (substr ($cmd, 0, 1) eq '/' && substr($originalCmd, 0, 1) ne '/') {

            # Store data so that it's available to the Perl mini-programme
            $self->ivAdd('perlCmdDataHash', '_originalCmd', $originalCmd);
            # (Also store the interface which fired)
            $self->ivAdd('perlCmdDataHash', '_interface', undef);

            $returnValue = $self->perlCmd($cmd);

            # The stored data is no longer needed
            $self->ivAdd('perlCmdDataHash', '_originalCmd', undef);
            $self->ivAdd('perlCmdDataHash', '_interface', undef);

            return $returnValue;        # If 'undef', no command is sent to the world

        } else {

            # Return the original command (or the modified instruction, if any alias has fired)
            return $cmd;
        }
    }

    sub checkMacros {

        # Called by ->signal_connect in GA::Win::Internal->setKeyPressEvent
        # Checks every active macro interface. Fires every macro that should be fired in response to
        #   a keypress
        #
        # Expected arguments
        #   $keycode    - The standard keycode, e.g. 'f5' (or keycode string, e.g. 'ctrl shift f5')
        #                   representing the keypress
        #
        # Return values
        #   'undef' on improper arguments
        #   Otherwise, returns FALSE if no macros fire and TRUE if any macros fire

        my ($self, $keycode, $check) = @_;

        # Local variables
        my (
            $fireFlag,
            @deleteList,
            %hash,
        );

        # Check for improper arguments
        if (! defined $keycode || defined $check) {

            return $axmud::CLIENT->writeImproper($self->_objClass . '->checkMacros', @_);
        }

        # Import the active macro registry for quick lookup
        %hash = $self->macroHash;

        # Check every active macro interface, in the correct order, to see if it is due to fire
        $fireFlag = FALSE;
        OUTER: foreach my $number ($self->macroOrderList) {

            my ($obj, $class, $method);

            if ($hash{$number} eq $keycode) {

                # The macro keycode matches. Check the interface number is valid
                if (! $self->ivExists('interfaceNumHash', $number)) {

                    $self->writeError(
                        'Invalid active macro interface #' . $number,
                        $self->_objClass . '->checkMacros',
                    );

                    # Avoid multiple error messages by stopping checking macros now
                    last OUTER;

                } else {

                    $obj = $self->ivShow('interfaceNumHash', $number);
                }

                # If the macro is disabled, don't fire it
                # If the macro is in the middle of its cooldown period, don't fire it
                if ($obj->enabledFlag && ! $self->ivExists('macroCooldownHash', $number)) {

                    $fireFlag = TRUE;

                    # Store the keycode so that it's available to a macro response that starts with
                    #   '/' (meaning it's a Perl mini-programme)
                    $self->ivAdd('perlCmdDataHash', '_keycode', $keycode);
                    # (Also store the interface which fired)
                    $self->ivAdd('perlCmdDataHash', '_interface', $number);

                    # For an independent macro, perform the instruction in ->response
                    if ($obj->indepFlag) {

                        $self->doInstruct($obj->response);

                    # For a dependent macro, make a function call
                    } else {

                        $class = $obj->callClass;
                        $method = $obj->callMethod;

                        $class->$method($self, $obj->number, $keycode);
                    }

                    # $keycode is no longer needed
                    $self->ivAdd('perlCmdDataHash', '_keycode', undef);
                    $self->ivAdd('perlCmdDataHash', '_interface', undef);

                    if ($obj->ivShow('attribHash', 'temporary')) {

                        # Mark a temporary active macro to be deleted
                        push (@deleteList, $obj);

                    } elsif ($obj->ivShow('attribHash', 'cooldown')) {

                        # Apply the cooldown period
                        $self->ivAdd(
                            'macroCooldownHash',
                            $obj->number,
                            $self->sessionTime + $obj->ivShow('attribHash', 'cooldown'),
                        );
                    }
                }
            }
        }

        # Any temporary macros which fired can now be deleted
        foreach my $obj (@deleteList) {

lib/Games/Axmud/Session.pm  view on Meta::CPAN

        } else {
            $_race = '';
        }

        local our $_char;
        if (defined $self->currentChar) {
            $_char = $self->currentChar->name;
        } else {
            $_char = '';
        }

        $compart->share('$_world', '$_guild', '$_race', '$_char');

        # Which interface fired to produce this instruction ('undef' if none)
        local our $_interface;
        if (defined $hash{'_interface'}) {
            $_interface = $hash{'_interface'};
        } else {
            $_interface = '';
        }

        $compart->share('$_interface');

        # Trigger interfaces
        local our $_line;
        if (defined $hash{'_line'}) {
            $_line = $hash{'_line'};
        } else {
            $_line = '';
        }

        local our $_stripLine;
        if (defined $hash{'_stripLine'}) {
            $_stripLine = $hash{'_stripLine'};
        } else {
            $_stripLine = '';
        }

        local our $_modLine;
        if (defined $hash{'_modLine'}) {
            $_modLine = $hash{'_modLine'};
        } else {
            $_modLine = '';
        }

        local our %_tagHash = $self->perlCmdTagHash;
        local our @_grpStringList = $self->perlCmdGrpStringList;

        $compart->share('$_line', '$_stripLine', '$_modLine', '%_tagHash', '@_grpStringList');

        # Alias interfaces
        local our $_originalCmd;
        if (defined $hash{'_originalCmd'}) {
            $_originalCmd = $hash{'_originalCmd'};
        } else {
            $_originalCmd = '';
        }

        $compart->share('$_originalCmd');

        # Macro interfaces
        local our $_keycode;
        if (defined $hash{'_keycode'}) {
            $_keycode = $hash{'_keycode'};
        } else {
            $_keycode = '';
        }

        $compart->share('$_keycode');

        # Timer interfaces
        local our $_timerExpect;
        if (defined $hash{'_timerExpect'}) {
            $_timerExpect = $hash{'_timerExpect'};
        } else {
            $_timerExpect = '';
        }

        local our $_timerTime;
        if (defined $hash{'_timerTime'}) {
            $_timerTime = $hash{'_timerTime'};
        } else {
            $_timerTime = '';
        }

        $compart->share('$_timerExpect', '$_timerTime');

        # Hook interfaces
        local our $_hookEvent;
        if (defined $hash{'_hookEvent'}) {
            $_hookEvent = $hash{'_hookEvent'};
        } else {
            $_hookEvent = '';
        }

        local our $_hookVar;
        if (defined $hash{'_hookVar'}) {
            $_hookVar = $hash{'_hookVar'};
        } else {
            $_hookVar = '';
        }

        local our $_hookVal;
        if (defined $hash{'_hookVal'}) {
            $_hookVal = $hash{'_hookVal'};
        } else {
            $_hookVal = '';
        }

        $compart->share('$_hookEvent', '$_hookVar', '$_hookVal');

        # Execute the Perl programme, using the default operator mask (specified by :default optag)
        # We set $axmud::SAFE_MODE_FLAG to TRUE so that the error-trapping code in axmud.pl doesn't
        #   try to make various function calls it can't complete in Safe's allocated namespace
        $axmud::SAFE_MODE_FLAG = TRUE;
        $val = $compart->reval($inputString);
        $axmud::SAFE_MODE_FLAG = FALSE;

        if ($@) {

            if ($@ =~ m/trapped by operation mask/) {



( run in 1.395 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )