view release on metacpan or  search on metacpan

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

                } else {

                    # Return the numbered exit's twin exit
                    return $obj->twinExit;
                }
            }
        }
    }
}

{ package Language::Axbasic::Function::Intrinsic::Numeric::getlostroom;

    use strict;
    use warnings;
#   use diagnostics;

    use Glib qw(TRUE FALSE);

    @Language::Axbasic::Function::Intrinsic::Numeric::getlostroom::ISA = qw(
        Language::Axbasic::Function::Intrinsic::Numeric
    );

    # Getlostroom ()

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

    sub evaluate {

        # Called by LA::Expression::Function->evaluate (using arguments in the form '')
        #
        # Expected arguments
        #   $arg    - The first (and only) argument in the argument list
        #
        # Return values
        #   The return value of the function

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

        # Local variables
        my $mapObj;

        # (No improper arguments to check)

        # Evaluate the function and return the value
        $mapObj = $self->scriptObj->session->mapObj;
        if (! $mapObj->lastKnownRoom) {

            # Automapper not lost
            return 0;

        } else {

            # Automapper is lost. Return the number of the previous room
            return $mapObj->lastKnownRoom->number;
        }
    }
}

{ package Language::Axbasic::Function::Intrinsic::Numeric::getobjectalive;

    use strict;
    use warnings;
#   use diagnostics;

    use Glib qw(TRUE FALSE);

    @Language::Axbasic::Function::Intrinsic::Numeric::getobjectalive::ISA = qw(
        Language::Axbasic::Function::Intrinsic::Numeric
    );

    # Getobjectalive (number)

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

    sub evaluate {

        # Called by LA::Expression::Function->evaluate (using arguments in the form 'N')
        #
        # Expected arguments
        #   $arg    - The first (and only) argument in the argument list
        #
        # Return values
        #   The return value of the function

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

        # Local variables
        my ($taskObj, $roomObj, $thisObj);

        # (No improper arguments to check)

        # Evaluate the function and return the value
        $taskObj = $self->scriptObj->session->locatorTask;
        if (! $taskObj) {

            # Locator task not running
            return 0;
        }

        # Perl indexes start at 0, but Axbasic indexes start at 1
        $arg--;

        $roomObj = $taskObj->roomObj;
        if (
            ! $roomObj
            || ! $roomObj->tempObjList
            || $arg < 0
            || scalar $roomObj->tempObjList <= $arg
        ) {
            # Locator task doesn't know current location, current location is empty or the
            #   numbered object doesn't exist
            return 0;

        } else {

            # Return the object's ->aliveFlag
            $thisObj = $roomObj->ivIndex('tempObjList', $arg);
            if (! $thisObj->aliveFlag) {
                return 0;
            } else {
                return 1;
            }
        }
    }
}

{ package Language::Axbasic::Function::Intrinsic::Numeric::getobjectcount;

    use strict;
    use warnings;
#   use diagnostics;

    use Glib qw(TRUE FALSE);

    @Language::Axbasic::Function::Intrinsic::Numeric::getobjectcount::ISA = qw(
        Language::Axbasic::Function::Intrinsic::Numeric
    );

    # Getobjectcount (number)

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

    sub evaluate {

        # Called by LA::Expression::Function->evaluate (using arguments in the form 'N')
        #
        # Expected arguments
        #   $arg    - The first (and only) argument in the argument list
        #
        # Return values
        #   The return value of the function

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

        # Local variables
        my ($taskObj, $roomObj, $thisObj);

        # (No improper arguments to check)

        # Evaluate the function and return the value
        $taskObj = $self->scriptObj->session->locatorTask;
        if (! $taskObj) {

            # Locator task not running
            return 0;
        }

        # Perl indexes start at 0, but Axbasic indexes start at 1
        $arg--;

        $roomObj = $taskObj->roomObj;
        if (
            ! $roomObj
            || ! $roomObj->tempObjList
            || $arg < 0
            || scalar $roomObj->tempObjList <= $arg
        ) {

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

    # Getroomobjects ()
    # Getroomobjects (string)

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

    sub evaluate {

        # Called by LA::Expression::Function->evaluate (using arguments in the form ';S')
        #
        # Expected arguments
        #   $arg    - The first (and only) argument in the argument list
        #
        # Return values
        #   The return value of the function

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

        # Local variables
        my ($taskObj, $count);

        # (No improper arguments to check)

        # Evaluate the function and return the value
        $taskObj = $self->scriptObj->session->locatorTask;

        if (! $taskObj || ! $taskObj->roomObj || ! $taskObj->roomObj->tempObjList) {

            # Locator task not running, does not know current location, or current location is
            #   empty
            return 0;

        } elsif (! $arg) {

            # Return number of objects in the room
            return (scalar $taskObj->roomObj->tempObjList);

        } else {

            # Count matching things
            $count = 0;

            if (
                $arg eq 'weapon' || $arg eq 'armour' || $arg eq 'garment' || $arg eq 'char'
                || $arg eq 'minion' || $arg eq 'sentient' || $arg eq 'creature'
                || $arg eq 'portable' || $arg eq 'decoration' || $arg eq 'custom'
            ) {
                foreach my $obj ($taskObj->roomObj->tempObjList) {

                    if ($obj->category eq $arg) {

                        $count++;
                    }
                }

            } elsif ($arg eq 'living') {

                foreach my $obj ($taskObj->roomObj->tempObjList) {

                    if ($obj->aliveFlag) {

                        $count++;
                    }
                }

            } elsif ($arg eq 'not_living') {

                foreach my $obj ($taskObj->roomObj->tempObjList) {

                    if (! $obj->aliveFlag) {

                        $count++;
                    }
                }

            } else {

                # Unrecognised string
                return 0;
            }

            # Return the number of matching objects (may be 0)
            return $count;
        }
    }
}

{ package Language::Axbasic::Function::Intrinsic::Numeric::ifacecount;

    use strict;
    use warnings;
#   use diagnostics;

    use Glib qw(TRUE FALSE);

    @Language::Axbasic::Function::Intrinsic::Numeric::ifacecount::ISA = qw(
        Language::Axbasic::Function::Intrinsic::Numeric
    );

    # Ifacecount ()

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

    sub evaluate {

        # Called by LA::Expression::Function->evaluate (using arguments in the form '')
        #
        # Expected arguments
        #   $arg    - The first (and only) argument in the argument list
        #
        # Return values
        #   The return value of the function

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

        # (No improper arguments to check)

        # Evaluate the function and return the value

        # Return the number of LA::Notifications received and not yet processed
        return $self->scriptObj->ivNumber('notificationList');
    }
}

{ package Language::Axbasic::Function::Intrinsic::Numeric::ifacedefined;

    use strict;
    use warnings;
#   use diagnostics;