Games-Axmud

 view release on metacpan or  search on metacpan

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

# Copyright (C) 2011-2024 A S Lewis
#
# This program is free software: you can redistribute it and/or modify it under the terms of the GNU
# General Public License as published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with this program. If not,
# see <http://www.gnu.org/licenses/>.
#
#
# Games::Axmud::Interface::XXX
# Code that handles interfaces (triggers, alias, macros, timers and hooks)

{ package Games::Axmud::Interface::Active;

    use strict;
    use warnings;
#   use diagnostics;

    use Glib qw(TRUE FALSE);

    our @ISA = qw(Games::Axmud::Generic::Interface Games::Axmud);

    ##################
    # Constructors

    sub new {

        # Called by GA::Session->injectInterface, ->createIndependentInterface and
        #   ->createDependentInterface
        # Creates a new instance of the active interface object
        #
        # Axmud interfaces are triggers, aliases, macros, timers and hooks. Depending on which
        #   profiles are current ones, and how many current profiles have interfaces with the same
        #   name, an interface can be 'active' or 'inactive' and 'independent' or 'dependent'
        #
        # 'Independent' interfaces are normally created by the user, and stored in a cage associated
        #   with a particular profile
        # When a profile becomes a current profile, and provided that there are no other superior
        #   profile which have an interface with the same ->name, each of its interfaces becomes
        #   'active'
        # When an interface becomes active, GA::Session creates this object, copying into it the
        #   attributes from the parent GA::Interface::Trigger / ::Alias / ::Macro / ::Timer
        #   / ::Hook object
        # When the interface becomes inactive again, this object gets destroyed (but the parent
        #   interface continues to exist)
        #
        # 'Dependent' interfaces are normally created by parts of the Axmud code immediately before
        #   this object is created. As soon as this object becomes inactive, the parent
        #   dependent interface is destroyed, as well.
        #
        # Expected arguments
        #   $session        - The GA::Session which created this object
        #   $category       - 'trigger', 'alias', 'macro', 'timer' or 'hook'
        #   $indepFlag      - TRUE if the interface is 'independent' (when the interface fires, the
        #                       response depends on the value of the parent interface's
        #                       ->response IV)
        #                   - FALSE if the interface is 'dependent' (when the interface fires, the
        #                       ->response IV is ignored and, instead, a method call is made)
        #
        # Optional arguments
        #   $parent         - The inactive interface (a GA::Interface::Trigger etc object) whose
        #                       attributes are copied into this one; specified when the calling
        #                       function is GA::Session->injectInterface. If 'undef', attributes
        #                       must be set by the calling function
        #   $assocProf      - The inactive interface's associated profile, specified when the
        #                       calling function is GA::Session->injectInterface ('undef'
        #                       otherwise)
        #   $assocProfCategory
        #                   - If $assocProf is specified, its category ('undef' otherwise)
        #
        #
        # Return values
        #   'undef' on improper arguments
        #   Blessed reference to the newly-created object on success

        my (
            $class, $session, $category, $indepFlag, $parent, $assocProf, $assocProfCategory,
            $check,
        ) = @_;

        # Local variables
        my $modelObj;

        # Check for improper arguments
        if (
            ! defined $class || ! defined $session || ! defined $category || ! defined $indepFlag
            || defined $check
        ) {
            return $axmud::CLIENT->writeImproper($class . '->new', @_);
        }

        # Setup
        my $self = {
            _objName                    => 'active_interface',
            _objClass                   => $class,
            _parentFile                 => undef,       # No parent file object
            _parentWorld                => undef,       # No parent file object
            _privFlag                   => TRUE,        # All IVs are private

            # Perl object components
            # ----------------------

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

        #
        # Return values
        #   'undef' on improper arguments
        #   1 otherwise

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

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

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

        if ($self->category eq 'timer') {

            # If the timer fires every second, but has been disabled for 30 seconds, enabling it
            #   will cause the timer to fire 30 times while it tries to catch up
            # The next firing time should be $self->stimulus seconds after now (actually,
            #   $self->stimulus seconds after the last spin of the timer loop
            $self->session->ivAdd(
                'timerHash',
                $self->number,
                ($self->session->sessionTime + $self->stimulus),
            );
        }

        return 1;
    }

    sub cloneToInactiveInterface {

        # Called by GA::Generic::Cmd->importInterface
        # Creates an inactive interface, cloning the attributes of this active interface
        #
        # Expected arguments
        #   $category   - 'trigger', 'alias', 'macro', 'timer' or 'hook'
        #
        # Return values
        #   'undef' on improper arguments, or if $category is invalid
        #   Blessed reference to the newly-created object on success

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

        # Local variables
        my ($class, $parentFile, $parentWorld);

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

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

        if ($category eq 'trigger') {
            $class = 'Games::Axmud::Interface::Trigger';
        } elsif ($category eq 'alias') {
            $class = 'Games::Axmud::Interface::Alias';
        } elsif ($category eq 'macro') {
            $class = 'Games::Axmud::Interface::Macro';
        } elsif ($category eq 'timer') {
            $class = 'Games::Axmud::Interface::Timer';
        } elsif ($category eq 'hook') {
            $class = 'Games::Axmud::Interface::Hook';
        } else {
            return undef;
        }

        if ($self->assocProf) {

            $parentFile = 'otherprof';
            $parentWorld = $self->assocProf;
        }

        # Setup
        my $clone = {
            _objName                    => $self->name,
            _objClass                   => $class,
            _parentFile                 => $parentFile,
            _parentWorld                => $self->assocProf,
            _privFlag                   => TRUE,            # All IVs are private

            # Interface category
            # ------------------

            category                    => $category,

            # Standard interface attributes
            # -----------------------------

            name                        => $self->name,
            stimulus                    => $self->stimulus,
            response                    => $self->response,
            enabledFlag                 => $self->enabledFlag,

            # Trigger attributes
            # ------------------

            attribHash                  => {$self->attribHash},

            # Ordering
            # --------

            beforeHash                  => {},
            afterHash                   => {},
        };

        # Bless the object into existence
        bless $clone, $class;
        return $clone;
    }

    ##################
    # Accessors - set

    sub set_callClass {

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

        # Check for improper arguments

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

            # Interface category
            # ------------------

            category                    => $self->category,

            # Standard interface attributes
            # -----------------------------

            name                        => $self->name,
            stimulus                    => $self->stimulus,
            response                    => $self->response,
            enabledFlag                 => $self->enabledFlag,

            # Alias attributes
            # ----------------

            attribHash                  => {$self->attribHash},

            # Ordering
            # --------

            beforeHash                  => {$self->beforeHash},
            afterHash                   => {$self->afterHash},
        };

        # Bless the cloned object into existence
        bless $clone, $self->_objClass;
        return $clone;
    }

    ##################
    # Methods

    ##################
    # Accessors - set

    ##################
    # Accessors - get

    sub category
        { $_[0]->{category} }

    sub name
        { $_[0]->{name} }
    sub stimulus
        { $_[0]->{stimulus} }
    sub response
        { $_[0]->{response} }
    sub enabledFlag
        { $_[0]->{enabledFlag} }

    sub attribHash
        { my $self = shift; return %{$self->{attribHash}}; }

    sub beforeHash
        { my $self = shift; return %{$self->{beforeHash}}; }
    sub afterHash
        { my $self = shift; return %{$self->{afterHash}}; }
}

{ package Games::Axmud::Interface::Macro;

    use strict;
    use warnings;
#   use diagnostics;

    use Glib qw(TRUE FALSE);

    our @ISA = qw(Games::Axmud::Generic::Interface Games::Axmud);

    ##################
    # Constructors

    sub new {

        # Creates a new instance of the macro object
        #
        # Axmud interfaces are triggers, aliases, macros, timers and hooks. Depending on which
        #   profiles are current ones, and how many current profiles have interfaces with the same
        #   name, an interface can be 'active' or 'inactive'
        #
        # This object represents an 'inactive' macro. It is stored in a cage, attached to a
        #   particular profile
        # When the profile becomes a current profile, and provided that there are no other superior
        #   profiles which have a macro with the same ->name, the macro becomes 'active'
        # When a macro becomes active, GA::Session creates a GA::Interface::Active object,
        #   copying it into its registries of active interfaces.
        # When the macro becomes inactive again, the GA::Interface::Active object is destroyed (but
        #   this object continues to exist throughout)
        #
        # Expected arguments
        #   $session        - The GA::Session which created this object (not stored as an IV)
        #   $name           - A name for the macro which is unique within its cage, but which could
        #                       be the same as the name of other macros in other cages (e.g.
        #                       'mymacro') (max 32 chars)
        #   $stimulus       - The stimulus (a key, for macros)
        #   $response       - The response (an action, for macros)
        #
        # Optional arguments
        #   $enabledFlag    - A flag, TRUE if (when the macro becomes active) it is responsive,
        #                       FALSE if it does nothing (if 'undef', the attribute is set to TRUE)
        #
        # Return values
        #   'undef' on improper arguments
        #   Blessed reference to the newly-created object on success

        my ($class, $session, $name, $stimulus, $response, $enabledFlag, $check) = @_;

        # Local variables
        my $flag;

        # Check for improper arguments
        if (
            ! defined $class || ! defined $session || ! defined $name || ! defined $stimulus
            || ! defined $response || defined $check
        ) {
            return $axmud::CLIENT->writeImproper($class . '->new', @_);
        }

        # Translate all values of $enabledFlag into TRUE of FALSE
        if (! defined $enabledFlag || $enabledFlag) {
            $flag = TRUE;      # Default is TRUE
        } else {
            $flag = FALSE;
        }

        # Setup
        my $self = {
            _objName                    => $name,
            _objClass                   => $class,
            _parentFile                 => 'otherprof',
            _parentWorld                => $session->currentWorld->name,
            _privFlag                   => TRUE,        # All IVs are private

            # Interface category
            # ------------------

            category                    => 'macro',     # Shortcut to $self->_objClass

            # Standard interface attributes
            # -----------------------------

            name                        => $name,       # Max 32 chars
            stimulus                    => $stimulus,   # An Axmud standard keycode
            response                    => $response,   # An instruction
            enabledFlag                 => $flag,

            # Macro attributes
            # ----------------

            # Current values for each macro attribute (initially set to defaults)
            attribHash                  => {
                'temporary'             => FALSE,
                'cooldown'              => 0,
            },

            # Ordering
            # --------

            # A hash of inactive macro names. When this macro becomes active, all other active mac
            #   macros are checked. If their corresponding inactive macros have names which appear
            #   in this list, then the active macro corresponding to this object is placed BEFORE
            #   them in the ordered list of active macros. Hash in the form
            #       $beforeHash{inactive_macro_name} = undef
            beforeHash                  => {},
            # Hash of inactive macro names; if corresponding active macros exist, this object's
            #   active macro is placed AFTER them
            afterHash                   => {},
        };

        # Bless the object into existence
        bless $self, $class;
        return $self;
    }

    sub clone {

        # Creates a clone of an existing interface; only used when the parent cage is cloned, or
        #   when interfaces are exported to the GA::Client's interface clipboard
        #
        # Expected arguments
        #   $profName       - The parent profile's name (e.g. matches the object's ->name)
        #
        # Return values
        #   'undef' on improper arguments
        #   Blessed reference to the newly-created object on success

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

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

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

        # Setup
        my $clone = {
            _objName                    => $self->_objName,
            _objClass                   => $self->_objClass,
            _parentFile                 => 'otherprof',
            _parentWorld                => $profName,
            _privFlag                   => TRUE,            # All IVs are private

            # Interface category
            # ------------------

            category                    => $self->category,

            # Standard interface attributes
            # -----------------------------

            name                        => $self->name,
            stimulus                    => $self->stimulus,
            response                    => $self->response,
            enabledFlag                 => $self->enabledFlag,

            # Macro attributes
            # ----------------

            attribHash                  => {$self->attribHash},

            # Ordering
            # --------

            beforeHash                  => {$self->beforeHash},
            afterHash                   => {$self->afterHash},
        };

        # Bless the cloned object into existence
        bless $clone, $self->_objClass;
        return $clone;
    }

    ##################
    # Methods

    ##################
    # Accessors - set

    ##################
    # Accessors - get

    sub category
        { $_[0]->{category} }

    sub name
        { $_[0]->{name} }
    sub stimulus
        { $_[0]->{stimulus} }
    sub response
        { $_[0]->{response} }
    sub enabledFlag
        { $_[0]->{enabledFlag} }

    sub attribHash
        { my $self = shift; return %{$self->{attribHash}}; }

    sub beforeHash
        { my $self = shift; return %{$self->{beforeHash}}; }
    sub afterHash
        { my $self = shift; return %{$self->{afterHash}}; }
}

{ package Games::Axmud::Interface::Timer;

    use strict;
    use warnings;
#   use diagnostics;

    use Glib qw(TRUE FALSE);

    our @ISA = qw(Games::Axmud::Generic::Interface Games::Axmud);

    ##################
    # Constructors

    sub new {



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