view release on metacpan or  search on metacpan

demo.form  view on Meta::CPAN

        }

        push(@fieldRList, $fieldR);
    }
    return @fieldRList;
}



sub interpretForm($$$) {

    my ($cFieldRListR, $firstNameR, $lastNameR) = @_;

    $$firstNameR  = field_buffer($cFieldRListR->[2], 0);
    $$lastNameR   = field_buffer($cFieldRListR->[4], 0);
}



sub demo($$) {

    my ($firstNameR, $lastNameR) = @_;

    noecho();

    eval { new_form() };
    if ($@ =~ m{not defined in your Curses library}) {
        print STDERR "Curses was not compiled with form function.\n";
        exit 1;
    }

    my @cFieldRList = makeFields();

    # Believe it or not, we have to pass to new_form() a string whose
    # representation in memory is a C array of pointers to C field objects.
    # Don't try to understand it; just copy this magic pack code.

    # The argument is a string whose ASCII encoding is an array of C
    # pointers.  Each pointer is to a FIELD object of the
    # executable-Curses library, except the last is NULL to mark the
    # end of the list.  For example, assume there are two fields and
    # the executable-Curses library represents them with FIELD objects
    # whose addresses (pointers) are 0x11223344 and 0x0004080C.  The
    # argument to Curses::new_form() is a 12 character string whose
    # ASCII encoding is 0x112233440004080C00000000 .

    my @cFieldList;
    foreach my $cFieldR (@cFieldRList) {
        push(@cFieldList, ${$cFieldR});
    }

    push(@cFieldList, 0);

    my $fieldListFormArg = pack('L!*', @cFieldList);

    my $formR = new_form($fieldListFormArg);
    if (${$formR} eq '') {
        fatal("new_form failed");
    }

    # Don't under any circumstance destroy $itemListMenuArg while the menu
    # object still exists, since the C menu object actually points to the
    # memory that backs $itemListMenuArg.
    
    # And don't destroy @cItemList or @cItemRList either while the menu object
    # still exists, because they are backed by memory that the C menu object
    # references as well.

    my $rows;
    my $cols;

    scale_form($formR, $rows, $cols);

    my $fwinR = newwin($rows + 2, $cols + 4, 4, 0);
    my $fsubR = derwin($fwinR, $rows, $cols, 1, 2);

    set_form_win($formR, $fwinR);
    set_form_sub($formR, $fsubR);

    box($fwinR, 0, 0);
    keypad($fwinR, 1);

    post_form($formR);

    addstr(0, 0, "Use KEY_UP/KEY_DOWN/KEY_PPAGE/KEY_NPAGE to navigate");
    addstr(1, 0, "Press 'ENTER' to select item, or 'F1' to exit");
    addstr(2, 0, "Other alphanumeric characters will enter data");
    refresh();

    driveForm($fwinR, $formR);

    interpretForm(\@cFieldRList, $firstNameR, $lastNameR);

    unpost_form($formR);
    delwin($fwinR);
    free_form($formR);
    map { free_field($_) } @cFieldRList;
}



##############################################################################
#                    MAINLINE
##############################################################################

initscr();

# The eval makes sure if it croaks, we have a chance to restore the
# terminal.

my ($firstName, $lastName);

eval { demo(\$firstName, \$lastName) };

endwin();

if ($@) {
    print STDERR "Failed.  $@\n";
    exit(1);
}

print "You entered '$firstName' for First Name and "
       . "'$lastName' for Last Name\n";