File: demo.menu

package info (click to toggle)
libcurses-perl 1.08b-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 624 kB
  • ctags: 754
  • sloc: ansic: 8,714; perl: 1,773; makefile: 36; sh: 9
file content (121 lines) | stat: -rwxr-xr-x 2,329 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
#!/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 ExtUtils::testlib;
use Curses;

eval { new_menu() };
if ($@ =~ /not defined by your vendor/) {
    print STDERR "Curses was not compiled with menu support.\n";
    exit 1;
}

my $ilist = [
    [ "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 @il;
my @pack;

foreach my $I (@$ilist) {
    my $item = new_item($I->[0], $I->[1]);

    if ($item eq '') { fatal("new_item($I->[0], $I->[1]) failed: $item") }
    push @il, $item;
    push @pack, ${$item};
}
push @pack, 0;

my $menu = new_menu(pack "I*", @pack);
if ($menu eq '') { fatal("new_menu failed") }

my $rows;
my $cols;

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

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

set_menu_win($menu, $mwin);
set_menu_sub($menu, $msub);

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

post_menu($menu);

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($mwin);
    if ($ch == KEY_UP) {
	menu_driver($menu, REQ_UP_ITEM);
    }
    elsif ($ch == KEY_DOWN) {
	menu_driver($menu, REQ_DOWN_ITEM);
    }
    elsif ($ch == KEY_PPAGE) {
	menu_driver($menu, REQ_SCR_UPAGE);
    }
    elsif ($ch == KEY_NPAGE) {
	menu_driver($menu, REQ_SCR_DPAGE);
    }
    elsif ($ch == KEY_F(1)) {
	last;
    }
    elsif ($ch eq "\r" or $ch eq "\n") {
	$ci = current_item($menu);
	last;
    }
    elsif ($ch =~ /^\S$/) {
	menu_driver($menu, $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($menu);
delwin($mwin);
free_menu($menu);
map { free_item($_) } @il;
endwin();

exit 0;

sub fatal {
    clrtobot(0, 0);
    addstr(0, 0, "@_\n");
    refresh();
    sleep 2;
    exit 1;
}