Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
demo	1.65 KB	-rwxr-xr-x
demo.form	6.03 KB	-rwxr-xr-x
demo.menu	3.08 KB	-rwxr-xr-x
demo.panel	1.49 KB	-rwxr-xr-x
demo2	1.7 KB	-rwxr-xr-x

Code Editor : demo.menu

#! /usr/bin/perl
##
##  This code contributed by Yury Pshenichny <yura@zp.ua>
##  based on demo.panel by Chris Leach <leachcj@bp.com>
##  and pretty much redone by me

use strict;
use warnings;
use English;
use ExtUtils::testlib;
use Curses;

sub fatal {
    clrtobot(0, 0);
    addstr(0, 0, "@_\n");
    refresh();
    sleep 2;
    die("Fatal error.");
}

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

my $itemListR = [
    [ "AAA" => "A descr" ],
    [ "BBB" => "B descr" ],
    [ "CCC" => "C descr" ],
    [ "DDD" => "D descr" ],
    [ "EEE" => "E descr" ],
    [ "FFF" => "F descr" ],
    [ "GGG" => "G descr" ],
    [ "HHH" => "H descr (This item has a very long descr) "]
];

initscr;
noecho;

my @cItemRList;

foreach my $itemR (@$itemListR) {
    my $cItemR = new_item($itemR->[0], $itemR->[1]);

if (${$cItemR} eq '') {
        fatal("new_item($itemR->[0], $itemR->[1]) failed")
    }
    push @cItemRList, $cItemR;
}

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

my @cItemList;

foreach my $cItemR (@cItemRList) {
    push(@cItemList, ${$cItemR});
}

push @cItemList, 0;

my $itemListMenuArg = pack('L!*', @cItemList);

my $menuR = new_menu($itemListMenuArg);
if (${$menuR} eq '') {
    fatal("new_menu 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;

set_menu_mark($menuR, '->');
set_menu_format($menuR, 3, 1);
scale_menu($menuR, $rows, $cols);

my $mwinR = newwin($rows + 2, $cols + 2, 8, 15);
my $msubR = derwin($mwinR, $rows, $cols, 1, 1);

set_menu_win($menuR, $mwinR);
set_menu_sub($menuR, $msubR);

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

post_menu($menuR);

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");
refresh();

my $ci;

while(1) {
    my $ch = getch($mwinR);
    if ($ch eq KEY_UP) {
	menu_driver($menuR, REQ_UP_ITEM);
    }
    elsif ($ch eq KEY_DOWN) {
	menu_driver($menuR, REQ_DOWN_ITEM);
    }
    elsif ($ch eq KEY_PPAGE) {
	menu_driver($menuR, REQ_SCR_UPAGE);
    }
    elsif ($ch eq KEY_NPAGE) {
	menu_driver($menuR, REQ_SCR_DPAGE);
    }
    elsif ($ch eq KEY_F(1)) {
	last;
    }
    elsif ($ch eq "\r" or $ch eq "\n") {
	$ci = current_item($menuR);
	last;
    }
    elsif ($ch =~ /^\S$/) {
	menu_driver($menuR, $ch);
    }
    else {
	beep();
    }
}

if ($ci) {
    addstr(0, 0, "You selected " . item_name($ci) . "\n");
}
else {
    addstr(0, 0, "You didn't select anything\n");
}
clrtoeol(1,0);
refresh();
sleep 2;

unpost_menu($menuR);
delwin($mwinR);
free_menu($menuR);
map { free_item($_) } @cItemRList;
endwin();

exit 0;

${this.title}

Code Editor : demo.menu