The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/perl
##

use ExtUtils::testlib;
use Curses;

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

my $flist = [
    [ 'L', 0,  0,  0,  8, "Form"        ],
    [ 'L', 0,  0,  2,  0, "First Name"  ],
    [ 'F', 1, 15,  2, 12, "F Name"      ],
    [ 'L', 0,  0,  3,  0, "Last Name"   ],
    [ 'F', 1, 15,  3, 12, "L Name"      ],
    [ 'L', 0,  0,  5,  8, "Form (pt 2)" ],
    [ 'L', 0,  0,  7,  0, "# Tuits"     ],
    [ 'F', 1,  5,  7, 12, "Tuits"       ],
    [ 'L', 0,  0,  8,  0, "# Bleems"    ],
    [ 'F', 1,  5,  8, 12, "Bleems"      ]
];

initscr;
noecho;

my @fl;
my @pack;

foreach my $F (@$flist) {
    my $field;

    if ($F->[0] eq 'L') {
	$field = new_field(1, length($F->[5]), $F->[3], $F->[4], 0, 0);
	if ($field eq '') { fatal("new_field $F->[5] failed") }

	set_field_buffer($field, 0, $F->[5]);
	field_opts_off($field, O_ACTIVE);
	field_opts_off($field, O_EDIT);
    }
    elsif ($F->[0] eq 'F') {
	$field = new_field($F->[1], $F->[2], $F->[3], $F->[4], 0, 0);
	if ($field eq '') { fatal("new_field $F->[5] failed") }

	if ($F->[5] eq "Tuits") {
	    set_field_buffer($field, 0, $F->[5]);
	}

	set_field_back($field, A_UNDERLINE);
    }

    push @fl, $field;
    push @pack, ${$field};
}
push @pack, 0;

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

my $rows;
my $cols;

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

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

set_form_win($form, $fwin);
set_form_sub($form, $fsub);

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

post_form($form);

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

while(1) {
    my $ch = getch($fwin);
    if ($ch == KEY_UP) {
	form_driver($form, REQ_PREV_FIELD);
    }
    elsif ($ch == KEY_DOWN or $ch eq "\t" or $ch eq "\r" or $ch eq "\n") {
	form_driver($form, REQ_NEXT_FIELD);
    }
    elsif ($ch == KEY_LEFT) {
	form_driver($form, REQ_LEFT_CHAR);
    }
    elsif ($ch == KEY_RIGHT) {
	form_driver($form, REQ_RIGHT_CHAR);
    }
    elsif ($ch == KEY_NPAGE) {
	form_driver($form, REQ_NEXT_PAGE);
    }
    elsif ($ch == KEY_PPAGE) {
	form_driver($form, REQ_PREV_PAGE);
    }
    elsif ($ch == KEY_DC or ord($ch) == 8 or ord($ch) == 127) {
	form_driver($form, REQ_DEL_PREV);
    }
    elsif ($ch == KEY_F(1)) {
	last;
    }
    elsif ($ch =~ /^\S$/) {
	form_driver($form, ord($ch));
    }
    else {
	beep();
    }
}

unpost_form($form);
delwin($fwin);
free_form($form);
map { free_field($_) } @fl;
endwin();

exit 0;

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