view release on metacpan or  search on metacpan

lib/Language/Axbasic.pm  view on Meta::CPAN

        #
        # Expected arguments
        #   $interfaceObj       - The active interface that fired
        #   $fireBecause        - A scalar describing why the interface fired
        #
        # Optional arguments
        #   @dataList           - A list of additional data, supplied by the interface when it
        #                           fired (may be an empty list)
        #
        # Return values
        #   'undef' on improper arguments or if the LA::Notification object can't be created
        #   1 otherwise

        my ($self, $interfaceObj, $fireBecause, @dataList) = @_;

        # Local variables
        my $obj;

        # Check for improper arguments
        if (! defined $interfaceObj || ! defined $fireBecause) {

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

        # For triggers and aliases, @fireDataList (if it is populated at all) contains the whole
        #   matching line of text/world command, followed by any substrings. Remove the first
        #   element, leaving us with the substrings
        if (
            ($interfaceObj->category eq 'trigger' || $interfaceObj->category eq 'alias')
            && @dataList
        ) {
            shift @dataList;
        }

        # Create a LA::Notification object to store the information about the fired interface
        $obj = Language::Axbasic::Notification->new(
            $self,
            $interfaceObj,
            $fireBecause,
            @dataList,
        );

        if (! $obj) {

            return undef;

        } else {

            # Add this LA::Notification to the end of the script's list
            $self->ivPush('notificationList', $obj);
            # If the list was empty, make the first notification in the list, the current one
            if ($self->currentNotification == -1) {

                $self->ivPoke('currentNotification', 0);
            }

            return 1;
        }
    }

    sub updateInterfaces {

        # Called by the parent task, when it is paused and waiting for an interface to fire before
        #   resuming
        # Causes this LA::Script to update its IVs to remove the interface
        #
        # Expected arguments
        #   $interfaceName  - The name of the interface to remove
        #
        # Return values
        #   'undef' on improper arguments
        #   1 otherwise

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

        # Local variables
        my (@ifaceList, @newList);

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

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

        @ifaceList = $self->depInterfaceList;
        foreach my $name (@ifaceList) {

            my $obj = $self->session->ivShow('interfaceHash', $name);

            if ($obj && $obj->name ne $interfaceName) {

                push (@newList, $obj->name);
            }
        }

        $self->ivPoke('depInterfaceList', @newList);

        # Update the accompanying IV, if necessary
        if (
            defined $self->depInterfaceName
            && $self->depInterfaceName eq $interfaceName
        ) {
            $self->ivUndef('depInterfaceName');
        }

        return 1;
    }

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

    sub set_column {

        # Returns 'undef' on improper arguments
        # Returns 1 on success

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

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