view release on metacpan or  search on metacpan

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

            # Return the cause for the fired interface
            return $obj->fireBecause;
        }
    }
}

{ package Language::Axbasic::Function::Intrinsic::String::ifacetype;

    use strict;
    use warnings;
#   use diagnostics;

    use Glib qw(TRUE FALSE);

    @Language::Axbasic::Function::Intrinsic::String::ifacetype::ISA = qw(
        Language::Axbasic::Function::Intrinsic::String
    );

    # Ifacetype$ ()

    ##################
    # 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 $obj;

        # (No improper arguments to check)

        # Evaluate the function and return the value
        if (! $self->scriptObj->notificationList || $self->scriptObj->currentNotification < 0) {

            # The notification list is empty, so return an empty string
            return '';

        } else {

            # Get the current notification
            $obj = $self->scriptObj->ivIndex(
                'notificationList',
                $self->scriptObj->currentNotification,
            );

            # Return its category
            return $obj->category;
        }
    }
}

{ package Language::Axbasic::Function::Intrinsic::String::popup;

    use strict;
    use warnings;
#   use diagnostics;

    use Glib qw(TRUE FALSE);

    @Language::Axbasic::Function::Intrinsic::String::popup::ISA = qw(
        Language::Axbasic::Function::Intrinsic::String
    );

    # Popup$ (type, text, response)

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

    sub evaluate {

        # Called by LA::Expression::Function->evaluate (using arguments in the form 'SSS')
        #
        # Expected arguments
        #   @args   - The list of arguments supplied to the function
        #
        # Return values
        #   The return value of the function

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

        # Local variables
        my ($type, $response, $choice);

        # (No improper arguments to check)

        # Evaluate the function and return the value

        # Check that the type is one of the values permitted by GA::Generic::Win->showMsgDialogue
        #   and, if not, use a default type
        $type = $args[0];
        if (
            $type ne 'info' && $type ne 'warning' && $type ne 'error' && $type ne 'question'
        ) {
            $type = 'info';
        }

        # Substitute a hyphen for any underlines or spaces in the response
        $response = $args[2];
        $response =~ s/_/-/;
        $response =~ s/\s/-/;
        # Check that the response is one of the values permitted by
        #   GA::Generic::Win->showMsgDialogue and, if not, use a default respone
        if (
            $response ne 'none' && $response ne 'ok' && $response ne 'close'
            && $response ne 'cancel' && $response ne 'yes-no' && $response ne 'ok-cancel'
        ) {
            $response = 'ok';
        }

        # Open a 'dialogue' window to prompt the user
        $choice = $self->scriptObj->session->mainWin->showMsgDialogue(
            $self->scriptObj->name,     # Use the script name as the window's title
            $type,
            $args[1],
            $response,
        );

        if (! $choice || $choice eq 'delete-event') {
            return "";
        } else {