--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/interps/clc-intercal/CLC-INTERCAL-UI-Curses-1.-94.-2/INTERCAL/Interface/Curses.pm	Sun Dec 09 19:30:08 2012 +0000
@@ -0,0 +1,911 @@
+package Language::INTERCAL::Interface::Curses;
+
+# Text (Curses) interface for sick and intercalc
+
+# This file is part of CLC-INTERCAL
+
+# Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.
+
+# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
+# and distribute it is granted provided that the conditions set out in the
+# licence agreement are met. See files README and COPYING in the distribution.
+
+use strict;
+use vars qw($VERSION $PERVERSION);
+($VERSION) = ($PERVERSION = "CLC-INTERCAL/UI-Curses INTERCAL/Interface/Curses.pm 1.-94.-2") =~ /\s(\S+)$/;
+
+use Carp;
+use Curses;
+use Language::INTERCAL::Exporter '1.-94.-2';
+use Language::INTERCAL::Interface::common '1.-94.-2';
+use vars qw(@ISA);
+@ISA = qw(Language::INTERCAL::Interface::common);
+
+my @savefields = qw(keypress keylist keyrows keycols lastkey
+		    menu_byname menu_entries menu_keys menu_index
+		    after_act in_menu in_dialog);
+
+my %keymap = (
+    'Left' => KEY_LEFT,
+    'BackSpace' => KEY_BACKSPACE,
+    'Enter' => KEY_ENTER,
+    'Return' => "\cM",
+    'Linefeed' => "\cJ",
+    (map { ("F$_" => KEY_F($_)) } (1..12)),
+    (map { ("M-" . chr($_) => chr($_ + 128)) } (1..127)),
+);
+
+my %reserved = (
+    &KEY_LEFT    => \&_move_left,
+    &KEY_RIGHT   => \&_move_right,
+    &KEY_UP      => \&_move_up,
+    &KEY_DOWN    => \&_move_down,
+    &KEY_ENTER   => \&_activate,
+    "\cM"        => \&_activate,
+    "\cJ"        => \&_activate,
+);
+
+sub new {
+    @_ == 2
+	or croak "Usage: Language::INTERCAL::Interface::Curses->new(SERVER)";
+    my ($class, $server) = @_;
+    $server or croak "Must provide SERVER";
+    initscr();
+    clearok(1);
+    noecho();
+    cbreak();
+    leaveok(0);
+    eval "END { eval { keypad(0) }; endwin(); print '\n' }";
+    keypad(1);
+    meta(1);
+    my $curse = bless {
+	keypress => {},
+	keylist => [],
+	keyrows => [],
+	keycols => [],
+	resize => 0,
+	redraw => 0,
+	windows => [],
+	pending => [],
+	menu_byname => {},
+	menu_entries => {},
+	menu_keys => [],
+	menu_index => {},
+	in_menu => 0,
+	in_dialog => 0,
+	wid => 0,
+	server => $server,
+    }, $class;
+    $server->file_listen(fileno(STDIN), sub {
+	my $k = getch();
+	while ($k ne ERR) {
+	    push @{$curse->{pending}}, $k;
+	    nodelay(1);
+	    $k = getch();
+	}
+	nodelay(0);
+    });
+    $curse->_initialise;
+    $SIG{WINCH} = sub { $curse->{resize} = $curse->{redraw} = 1 };
+    $curse;
+}
+
+sub has_window { 1 }
+sub is_interactive { 1 }
+sub is_terminal { 1 }
+sub can_paste { 0 }
+
+sub stdread {
+    croak "Curses interface should not use stdread directly";
+}
+
+sub getline {
+    @_ == 2 or croak "Usage: Curses->getline(PROMPT)";
+    my ($curse, $prompt) = @_;
+    # XXX this is just a draft implementation so there is some way of
+    # XXX executing a WRITE IN - it's not meant to be the final form
+    my $v = ' ' x ($COLS - 10);
+    my @def = (
+	'vstack', border => 2, data =>
+	['text', value => $prompt, align => 'c'],
+	['text', value => $v, align => 'l', name => '__getline'],
+    );
+    my $window = $curse->window("Program input", undef, \@def);
+    $curse->set_text('__getline', '');
+    my $line = '';
+    $curse->{in_dialog} = \$line;
+    my $ok = 1;
+    $curse->{keypress}{"\c["} = {
+	hidden => 1,
+	action => sub { $curse->{running} = 0; $ok = 0 },
+	enabled => 1,
+    };
+    $curse->{keypress}{$_} = {
+	hidden => 1,
+	action => sub {
+	    $line eq '' and return;
+	    chop $line;
+	    $curse->set_text('__getline', $line);
+	},
+	enabled => 1,
+    } for (KEY_BACKSPACE, "\cH");
+    my $or = $curse->{running};
+    $curse->run;
+    $curse->close($window);
+    $curse->{running} = $or;
+    $ok ? "$line\n" : undef;
+}
+
+sub file_dialog {
+    @_ == 5 or croak "Usage: Curses->file_dialog(TITLE, NEW?, OK, CANCEL)";
+    my ($curse, $title, $new, $ok, $cancel) = @_;
+    # XXX this is just a draft implementation so there is some way of
+    # XXX getting a file name - it's not meand to be the final form
+    return $curse->getline($title);
+}
+
+sub alter_data {
+    @_ == 3 or croak "Usage: Curses->alter_data(WINDOW, DATA)";
+    croak "Augment not implemented for Curses"; # XXX
+}
+
+sub window {
+    @_ == 4 || @_ == 5 || @_ == 6
+	or croak "Usage: Curses->window(NAME, DESTROY, DEFINITION "
+	       . "[, MENUS [, ACT]])";
+    my ($curse, $name, $destroy, $def, $menus, $act) = @_;
+    $curse->{after_act} = $act;
+    my $window = _window($curse, $name, $def, $menus);
+    _place($window, 0, COLS, 0, LINES);
+    _finish_window($curse, $window);
+    &{$window->{show}}($curse, $window);
+    $window;
+}
+
+sub _window {
+    my ($curse, $name, $def, $menus, $act) = @_;
+    $curse->{menu_byname} = {};
+    $curse->{menu_entries} = {};
+    $curse->{menu_keys} = [];
+    $curse->{menu_index} = {};
+    my $wid = ++$curse->{wid};
+    if (defined $menus) {
+	$curse->_parse_menus($wid, @$menus);
+	my @def = (
+	    'vstack', border => 0, data =>
+	    ['hstack', border => 1, data => @{$curse->{menu_keys}}, ],
+	    $def,
+	);
+	$def = \@def;
+    }
+    $curse->{keypress} = {};
+    $curse->{keylist} = [];
+    my $window = $curse->_parse_def($wid, @$def);
+    $window->{wid} = $wid;
+    $window;
+}
+
+sub _finish_window {
+    my ($curse, $window) = @_;
+    $curse->{keyrows} = [];
+    $curse->{keycols} = [];
+    $curse->{lastkey} = [0, 0];
+    if (@{$curse->{keylist}}) {
+	$curse->{keylist} =
+	    [ sort { $a->{y} <=> $b->{y} || $a->{x} <=> $b->{x} }
+		   @{$curse->{keylist}} ];
+	for (my $kp = 0; $kp < @{$curse->{keylist}}; $kp++) {
+	    my $k = $curse->{keylist}[$kp];
+	    push @{$curse->{keyrows}[$k->{y}]}, $kp;
+	    push @{$curse->{keycols}[$k->{x}]}, $kp;
+	}
+	my $nmenu = @{$curse->{menu_keys} || []};
+	$curse->{lastkey}[1] = $curse->{keylist}[$nmenu];
+	$curse->{lastkey}[0] = $nmenu;
+    }
+    push @{$curse->{windows}}, [$window, @$curse{@savefields}];
+    $curse->{in_menu} = 0;
+    $curse->{acter_act} = 0;
+    $window;
+}
+
+sub show {
+    @_ == 2 or croak "Usage: Curses->show(WINDOW)";
+    my ($curse, $window) = @_;
+    &{$window->{show}}($curse, $window);
+}
+
+sub enable {
+    @_ == 2 or croak "Usage: Curses->enable(WINDOW)";
+    my ($curse, $window) = @_;
+    $window->{enabled} = 1;
+    $curse->{redraw} = 1;
+}
+
+sub disable {
+    @_ == 2 or croak "Usage: Curses->disable(WINDOW)";
+    my ($curse, $window) = @_;
+    $window->{enabled} = 0;
+    $curse->{redraw} = 1;
+}
+
+sub update {
+    @_ == 1 or croak "Usage: Curses->update";
+    my ($curse) = @_;
+    refresh();
+}
+
+sub start {
+    @_ == 1 or croak "Usage: Curses->start";
+    refresh();
+}
+
+sub run {
+    @_ == 1 or croak "Usage: Curses->run";
+    my ($curse) = @_;
+    $curse->{running} = 1;
+    refresh();
+    nodelay(0);
+    while ($curse->{running}) {
+	if ($curse->{resize}) {
+	    $curse->{resize} = $curse->{redraw} = 0;
+	    endwin();
+	    clearok(1);
+	    $curse->_redraw(1);
+	} elsif ($curse->{redraw}) {
+	    $curse->{redraw} = 0;
+	    $curse->_redraw(0);
+	}
+	cbreak();
+	meta(1);
+	while (! @{$curse->{pending}}) {
+	    refresh();
+	    $curse->{server}->progress;
+	}
+	my $key = shift @{$curse->{pending}};
+	if ($key eq "\c[") {
+	    if (@{$curse->{pending}}) {
+		$key = shift @{$curse->{pending}};
+		$key = chr(ord($key) | 0x80);
+	    }
+	}
+	if (exists $reserved{$key}) {
+	    &{$reserved{$key}}($curse);
+	    next;
+	}
+	if (exists $curse->{keypress}{$key}) {
+	    $key = $curse->{keypress}{$key};
+	    next unless $key->{enabled};
+	    if ($curse->{lastkey}[1] != $key && ! $key->{hidden}) {
+		my $ok = $curse->{lastkey}[1];
+		$curse->{lastkey}[1] = $key;
+		for (my $kp = 0; $kp < @{$curse->{keylist}}; $kp++) {
+		    next if $curse->{keylist}[$kp] != $key;
+		    $curse->{lastkey}[0] = $kp;
+		}
+		$curse->show($ok);
+	    }
+	    $curse->show($key) unless $key->{hidden};
+	    $curse->{server}->progress(0) if ! @{$curse->{pending}};
+	    refresh() if ! @{$curse->{pending}};
+	    &{$key->{action}};
+	    $curse->{server}->progress(0) if ! @{$curse->{pending}};
+	    refresh() if ! @{$curse->{pending}};
+	    next;
+	}
+	if ($key =~ /^[[:print:]]$/ && $curse->{in_dialog}) {
+	    ${$curse->{in_dialog}} .= $key;
+	    $curse->set_text('__getline', ${$curse->{in_dialog}});
+	    $curse->update;
+	    next;
+	}
+    }
+}
+
+sub stop {
+    @_ == 1 or croak "Usage: Curses->stop";
+    my ($curse) = @_;
+    $curse->{running} = 0;
+}
+
+sub pending_events {
+    @_ == 1 or croak "Usage: Curses->pending_events";
+    my ($curse) = @_;
+    if (! @{$curse->{pending}}) {
+	$curse->{server}->progress(0);
+	cbreak();
+    }
+    return @{$curse->{pending}} != 0;
+}
+
+sub _activate {
+    my ($curse) = @_;
+    if ($curse->{in_dialog}) {
+	$curse->{running} = 0;
+	return;
+    }
+    return unless $curse->{lastkey}[1];
+    return unless $curse->{lastkey}[1]->{enabled};
+    &{$curse->{lastkey}[1]->{action}};
+}
+
+sub _move_left {
+    my ($curse) = @_;
+    if ($curse->{in_menu}) {
+	# close this menu, then open the one on the left
+	$curse->close($curse->{in_menu});
+	$curse->{in_menu} = 0;
+	return unless $curse->{lastkey}[1];
+	_move_left($curse);
+	_activate($curse);
+	return;
+    }
+    return unless $curse->{lastkey}[1];
+    my $i = $curse->{lastkey}[0];
+    my $k = $curse->{lastkey}[1];
+    my $r = $curse->{keyrows}[$k->{y}];
+    my $ok = $curse->{lastkey}[1];
+    if ($r->[0] == $i) {
+	$i = $#$r;
+    } else {
+	my $j = 1;
+	$j++ while $j < @$r && $r->[$j] != $i;
+	$j--;
+	$i = $j;
+    }
+    $curse->{lastkey}[0] = $r->[$i];
+    $curse->{lastkey}[1] = $curse->{keylist}[$r->[$i]];
+    $curse->show($ok);
+    $curse->show($curse->{lastkey}[1]);
+}
+
+sub _move_right {
+    my ($curse) = @_;
+    if ($curse->{in_menu}) {
+	# close this menu, then open the one on the left
+	$curse->close($curse->{in_menu});
+	$curse->{in_menu} = 0;
+	return unless $curse->{lastkey}[1];
+	_move_right($curse);
+	_activate($curse);
+	return;
+    }
+    return unless $curse->{lastkey}[1];
+    my $i = $curse->{lastkey}[0];
+    my $k = $curse->{lastkey}[1];
+    my $r = $curse->{keyrows}[$k->{y}];
+    my $ok = $curse->{lastkey}[1];
+    if ($r->[-1] == $i) {
+	$i = 0;
+    } else {
+	my $j = $#$r;
+	$j-- while $j >= 0 && $r->[$j] != $i;
+	$j++;
+	$i = $j;
+    }
+    $curse->{lastkey}[0] = $r->[$i];
+    $curse->{lastkey}[1] = $curse->{keylist}[$r->[$i]];
+    $curse->show($ok);
+    $curse->show($curse->{lastkey}[1]);
+}
+
+sub _move_up {
+    my ($curse) = @_;
+    return unless $curse->{lastkey}[1];
+    my $nmenu = @{$curse->{menu_keys} || []};
+    my $i = $curse->{lastkey}[0];
+    return if $i < $nmenu;
+    my $k = $curse->{lastkey}[1];
+    my $r = $curse->{keycols}[$k->{x}];
+    my $ok = $curse->{lastkey}[1];
+    my $idx = 0;
+    $idx++ while $idx < @$r && $r->[$idx] < $nmenu;
+    if ($r->[$idx] == $i) {
+	$i = $#$r;
+    } else {
+	my $j = 1;
+	$j++ while $j < @$r && $r->[$j] != $i;
+	$j--;
+	$i = $j;
+    }
+    $curse->{lastkey}[0] = $r->[$i];
+    $curse->{lastkey}[1] = $curse->{keylist}[$r->[$i]];
+    $curse->show($ok);
+    $curse->show($curse->{lastkey}[1]);
+}
+
+sub _down_until {
+    my ($curse, $until) = @_;
+    return unless $curse->{lastkey}[1];
+    my $i = $curse->{lastkey}[0];
+    do {
+	_move_down($curse);
+    } until $curse->{lastkey}[0] == $i
+	 || $curse->{lastkey}[1]->{value} =~ $until;
+}
+
+sub _move_down {
+    my ($curse) = @_;
+    return unless $curse->{lastkey}[1];
+    my $i = $curse->{lastkey}[0];
+    my $nmenu = @{$curse->{menu_keys} || []};
+    if ($i < $nmenu) {
+	# open this menu
+	_activate($curse);
+	return;
+    }
+    my $k = $curse->{lastkey}[1];
+    my $r = $curse->{keycols}[$k->{x}];
+    my $ok = $curse->{lastkey}[1];
+    my $idx = 0;
+    $idx++ while $idx < @$r && $r->[$idx] < $nmenu;
+    if ($r->[-1] == $i) {
+	$i = $idx;
+    } else {
+	my $j = $#$r;
+	$j-- while $j >= 0 && $r->[$j] != $i;
+	$j++;
+	$i = $j;
+    }
+    $curse->{lastkey}[0] = $r->[$i];
+    $curse->{lastkey}[1] = $curse->{keylist}[$r->[$i]];
+    $curse->show($ok);
+    $curse->show($curse->{lastkey}[1]);
+}
+
+sub _redraw {
+    my ($curse, $place) = @_;
+    erase();
+    $@ = '';
+    for my $w (@{$curse->{windows}}) {
+	if ($place) {
+	    eval { _place($w->[0], 0, $COLS, 0, $LINES) };
+	    last if $@;
+	}
+	&{$w->[0]{show}}($curse, $w->[0]);
+    }
+    if ($@) {
+	clearok(1);
+	erase();
+	my $line = 0;
+	for my $s (split(/\n/, $@)) {
+	    addstr($line++, 0, $s) if $line < $LINES;
+	}
+    }
+    refresh();
+}
+
+sub _offset {
+    my ($window, $x, $y) = @_;
+    $window->{x} += $x;
+    $window->{y} += $y;
+    return unless exists $window->{children};
+    for my $child (@{$window->{children}}) {
+	_offset($child, $x, $y);
+    }
+}
+
+sub _place {
+    my ($window, $x, $width, $y, $height) = @_;
+    my $diff = $width - $window->{width};
+    $diff = 0 if $diff < 0;
+    $x += int($diff / 2);
+    $window->{x} ||= 0;
+    $diff = $height - $window->{height};
+    $diff = 0 if $diff < 0;
+    $y += int($diff / 2);
+    $window->{y} ||= 0;
+    _offset($window, $x - $window->{x}, $y - $window->{y});
+}
+
+sub close {
+    @_ == 2 or croak "Usage: Curses->close(WINDOW)";
+    my ($curse, $window) = @_;
+    $curse->_close($window->{wid});
+    my @nw = grep { $_->[0] != $window } @{$curse->{windows}};
+    $curse->{windows} = \@nw;
+    if (@nw) {
+	my $w;
+	($w, @$curse{@savefields}) = @{$nw[-1]};
+    } else {
+	@$curse{@savefields} =
+	    ({}, {}, [], [], [0, 0], {}, {}, [], {}, 0, undef);
+	clearok(1);
+	$curse->_initialise;
+    }
+    $curse->_redraw(0);
+}
+
+sub _extend_width {
+    my ($e, $cw) = @_;
+    return if $e->{width} >= $cw;
+    my $diff = $cw - $e->{width};
+    $e->{width} = $cw;
+    return unless exists $e->{children};
+    my $d0 = int($diff / scalar @{$e->{colwidth}});
+    my $d1 = $diff % scalar @{$e->{colwidth}};
+    my $d = 0;
+    my @d = ();
+    for (my $c = 0; $c < @{$e->{colwidth}}; $c++) {
+	$d[$c] = $d;
+	$d += $d0 + (($c < $d1) ? 1 : 0);
+	$e->{colwidth}[$c] += $d0 + (($c < $d1) ? 1 : 0);
+    }
+    for my $child (@{$e->{children}}) {
+	my ($c0, $c1, $r0, $r1) = @{$child->{table}};
+	$d = -$e->{border};
+	for (my $c = $c0; $c < $c1; $c++) {
+	    $d += $e->{colwidth}[$c] + $e->{border};
+	}
+	_extend_width($child, $d);
+	_offset($child, $d[$c0], 0);
+    }
+}
+
+sub _extend_height {
+    my ($e, $rh) = @_;
+    return if $e->{height} >= $rh;
+    my $diff = $rh - $e->{height};
+    $e->{height} = $rh;
+    return unless exists $e->{children};
+    my $d0 = int($diff / scalar @{$e->{rowheight}});
+    my $d1 = $diff % scalar @{$e->{rowheight}};
+    my $d = 0;
+    my @d = ();
+    for (my $r = 0; $r < @{$e->{rowheight}}; $r++) {
+	$d[$r] = $d;
+	$d += $d0 + (($r < $d1) ? 1 : 0);
+	$e->{rowheight}[$r] += $d0 + (($r < $d1) ? 1 : 0);
+    }
+    for my $child (@{$e->{children}}) {
+	my ($c0, $c1, $r0, $r1) = @{$child->{table}};
+	$d = -$e->{border};
+	for (my $r = $r0; $r < $r1; $r++) {
+	    $d += $e->{rowheight}[$r] + $e->{border};
+	}
+	_extend_height($child, $d);
+	_offset($child, 0, $d[$r0]);
+    }
+}
+
+sub _make_table {
+    my ($curse, $rows, $cols, $elements, $border, $augment) = @_;
+    my @width = (0) x $cols;
+    my @height = (0) x $rows;
+    $border = $border ? 1 : 0;
+    # try to determine row/column sizes using one cell elements
+    for my $te (@$elements) {
+	my ($e, $c0, $c1, $r0, $r1) = @$te;
+	$width[$c0] = $e->{width}
+	    if $c0 + 1 == $c1 && $width[$c0] < $e->{width};
+	$height[$r0] = $e->{height}
+	    if $r0 + 1 == $r1 && $height[$r0] < $e->{height};
+    }
+    # now adjust it for multirow/multicolumn
+    for my $te (@$elements) {
+	my ($e, $c0, $c1, $r0, $r1) = @$te;
+	if ($c1 - $c0 > 1) {
+	    my $cw = ($c1 - $c0 - 1) * $border;
+	    for (my $c = $c0; $c < $c1; $c++) {
+		$cw += $width[$c];
+	    }
+	    if ($cw < $e->{width}) {
+		my $diff = $e->{width} - $cw;
+		my $d0 = int($diff / ($c1 - $c0));
+		my $d1 = $diff % ($c1 - $c0);
+		for (my $c = $c0; $c < $c1; $c++) {
+		    $width[$c] += $d0;
+		    $width[$c] ++ if $c < $d1;
+		}
+	    }
+	}
+	if ($r1 - $r0 > 1) {
+	    my $rh = ($r1 - $r0 - 1) * $border;
+	    for (my $r = $r0; $r < $r1; $r++) {
+		$rh += $height[$r];
+	    }
+	    if ($rh < $e->{height}) {
+		my $diff = $e->{height} - $rh;
+		my $d0 = int($diff / ($r1 - $r0));
+		my $d1 = $diff % ($r1 - $r0);
+		for (my $r = $r0; $r < $r1; $r++) {
+		    $height[$r] += $d0;
+		    $height[$r] ++ if $r < $d1;
+		}
+	    }
+	}
+    }
+    # determine total window size and cell starting points
+    my $width = $border;
+    my @x = ();
+    for (my $c = 0; $c < $cols; $c++) {
+	$x[$c] = $width;
+	$width += $width[$c] + $border;
+    }
+    my $height = $border;
+    my @y = ();
+    for (my $r = 0; $r < $rows; $r++) {
+	$y[$r] = $height;
+	$height += $height[$r] + $border;
+    }
+    # place all elements and extend them to fill cell if required
+    my @children = ();
+    for my $te (@$elements) {
+	my ($e, $c0, $c1, $r0, $r1) = @$te;
+	_offset($e, $x[$c0], $y[$r0]);
+	my $cw = ($c1 - $c0 - 1) * $border;
+	for (my $c = $c0; $c < $c1; $c++) {
+	    $cw += $width[$c];
+	}
+	_extend_width($e, $cw);
+	my $rh = ($r1 - $r0 - 1) * $border;
+	for (my $r = $r0; $r < $r1; $r++) {
+	    $rh += $height[$r];
+	}
+	_extend_height($e, $rh);
+	$e->{table} = [$c0, $c1, $r0, $r1];
+	push @children, $e;
+    }
+    # ready to go...
+    return {
+	type => 'table',
+	width => $width,
+	height => $height,
+	colwidth => \@width,
+	rowheight => \@height,
+	show => \&_show_table,
+	children => \@children,
+	border => $border,
+    };
+}
+
+sub _show_table {
+    my ($curse, $table) = @_;
+    $table->{type} eq 'table' or die "Internal error";
+    # draw border, if required
+    # XXX multirow fields may show '+' where '|' should be
+    if ($table->{border}) {
+	my $y = $table->{y};
+	my $row = 0;
+	for my $rh (@{$table->{rowheight}}, 0) {
+	    move($y, $table->{x});
+	    my $col = 0;
+	    for my $cw (@{$table->{colwidth}}, 0) {
+		my $plus = '-';
+		for my $e (@{$table->{children}}) {
+		    next if $e->{table}[0] != $col && $e->{table}[1] != $col;
+		    next if $e->{table}[2] != $row && $e->{table}[3] != $row;
+		    $plus = '+';
+		    last;
+		}
+		addstr($plus . ('-' x $cw));
+		$col++;
+	    }
+	    $y++;
+	    for (my $x = 0; $x < $rh; $x++) {
+		move($y, $table->{x});
+		for my $cw (@{$table->{colwidth}}, 0) {
+		    addstr('|' . (' ' x $cw));
+		}
+		$y++;
+	    }
+	    $row++;
+	}
+    }
+    # draw elements
+    for my $e (@{$table->{children}}) {
+	&{$e->{show}}($curse, $e);
+    }
+}
+
+sub _make_text {
+    my ($curse, $value, $align, $size) = @_;
+    $size ||= length $value;
+    return {
+	type => 'text',
+	width => $size,
+	height => 1,
+	value => $value,
+	enabled => 1,
+	align => $align,
+	show => \&_show_text_key,
+    };
+}
+
+sub _show_text_key {
+    my ($curse, $text) = @_;
+    $text->{type} eq 'text' || $text->{type} eq 'key'
+	or die "Internal error";
+    move($text->{y}, $text->{x});
+    my $diff0 = $text->{width} - length($text->{value});
+    my $diff1 = int($diff0 / 2);
+    my $diff2 = $diff0 - $diff1;
+    eval { attrset(A_NORMAL) };
+    eval { attron(A_BOLD) } if $text->{enabled};
+    eval { attron(A_REVERSE) } if $text == $curse->{lastkey}[1];
+    addstr(' ' x $diff0) if $diff0 > 0 && $text->{align} =~ /^r/i;
+    addstr(' ' x $diff1) if $diff1 > 0 && $text->{align} =~ /^c/i;
+    addstr($text->{value});
+    addstr(' ' x $diff0) if $diff0 > 0 && $text->{align} =~ /^l/i;
+    addstr(' ' x $diff2) if $diff2 > 0 && $text->{align} =~ /^c/i;
+    eval { attrset(A_NORMAL) };
+}
+
+sub _set_text {
+    my ($curse, $text, $value) = @_;
+    $text->{type} eq 'text' or die "Internal error";
+    defined $value or $value = '';
+    $value = substr($value, 0, $text->{width});
+    $text->{value} = $value;
+    _show_text_key($curse, $text);
+}
+
+sub _get_text {
+    my ($curse, $text) = @_;
+    $text->{type} eq 'text' or die "Internal error";
+    $text->{value};
+}
+
+sub _make_key {
+    my ($curse, $label, $action, $keys) = @_;
+    if ($curse->{after_act}) {
+	my $act = $curse->{after_act};
+	my $cb = $action;
+	$action = sub {
+	      $@ = '';
+	      my $res = eval { $cb->(@_); };
+	      if ($act) {
+		  $act->($curse, $@ || $res, @_);
+	      } elsif ($@) {
+		  die $@;
+	      }
+	};
+    }
+    my $key = {
+	type => 'key',
+	width => length $label,
+	height => 1,
+	action => $action,
+	align => ($curse->{keyalign} || 'c'),
+	enabled => 1,
+	value => $label,
+	show => \&_show_text_key,
+    };
+    push @{$curse->{keylist}}, $key;
+    for my $k (@$keys) {
+	$k = $keymap{$k} if exists $keymap{$k};
+	next if exists $reserved{$k};
+	$curse->{keypress}{$k} = $key;
+    };
+    return $key;
+}
+
+sub _make_menu {
+    my ($curse, $name) = @_;
+    $curse->{menu_byname}{$name} = {};
+    $curse->{menu_entries}{$name} = [];
+    my $key1 = 'M-' . lc(substr($name, 0, 1));
+    my $key2 = 'M-' . uc(substr($name, 0, 1));
+    $curse->{menu_index}{$name} = scalar @{$curse->{menu_keys}};
+    push @{$curse->{menu_keys}}, [
+	'key',
+	name => $name,
+	action => sub { _show_menu($curse, @_) },
+	key => [$key1, $key2],
+    ];
+    1;
+}
+
+sub _show_menu {
+    my ($curse, $name) = @_;
+    # find this menu
+    exists $curse->{menu_index}{$name} or return;
+    my $entry = $curse->{menu_index}{$name};
+    # check if menu has ticks
+    my $c = $curse->{menu_byname}{$name};
+    my $ticks = grep { exists $_->{ticked} } values %$c;
+    # get list of entries;
+    my $e = $curse->{menu_entries}{$name};
+    my @entries = grep { $c->{$_->[0]}{enabled} } @$e;
+    return unless @entries;
+    if ($ticks) {
+	@entries =
+	    map { [($c->{$_->[0]}{ticked} ? '*' : ' ') . $_->[0],
+		   $_->[0],
+		   $_->[1]]
+	        } @entries;
+    } else {
+	@entries = map { [$_->[0], $_->[0], $_->[1]] } @entries;
+    }
+    # determine menu size and draw window
+    my $rows = scalar @entries;
+    my $cols = 0;
+    for my $e (@entries) {
+	$cols = length($e->[0]) if $cols < length($e->[0]);
+    }
+    # now open a window under the menu label with the entries as a stack of buttons
+    my $mw;
+    my $act = $curse->{after_act};
+    my @keys = map {
+	my ($label, $keyname, $action) = @$_;
+	[ 'key',
+	  action => sub {
+	      $curse->close($mw);
+	      $@ = '';
+	      my $res = eval { $action->($curse, $name, @_); };
+	      if ($act) {
+		  $act->($curse, $@ || $res, $name, @_);
+	      } elsif ($@) {
+		  die $@;
+	      }
+	  },
+	  name => $keyname,
+	  label => $label,
+	  key => [],
+	],
+    } @entries;
+    my @wd = (
+	'vstack',
+	border => 1,
+	data => [
+	    'vstack',
+	    border => 0,
+	    data => @keys,
+	],
+    );
+    my $k = $curse->{keylist}[$entry];
+    $curse->{keyalign} = 'l';
+    $mw = $curse->_window($name, \@wd);
+    delete $curse->{keyalign};
+    $curse->{keypress}{"\c["} = {
+	hidden => 1,
+	action => sub { $curse->close($mw) },
+	enabled => 1,
+    };
+    for my $ent (@entries) {
+	my $initial = lc(substr($ent->[1], 0, 1));
+	next if exists $curse->{keypress}{$initial};
+	$curse->{keypress}{$initial} = {
+	    hidden => 1,
+	    enabled => 1,
+	    action => sub { _down_until($curse, qr/^[\s\*]*$initial/i) },
+	}
+    }
+    _offset($mw, $k->{x} - 1, $k->{y} + 1);
+    _finish_window($curse, $mw);
+    $curse->{in_menu} = $mw;
+    &{$mw->{show}}($curse, $mw);
+}
+
+sub _make_menu_entry {
+    my ($curse, $action, $menu, $name, $entry, $ticks) = @_;
+    $curse->{menu_byname}{$name}{$entry} = {
+	action => $action,
+	enabled => 1,
+    };
+    push @{$curse->{menu_entries}{$name}}, [$entry, $action];
+    1;
+}
+
+sub _enable_menu {
+    my ($curse, $item, $state, $name, $entry) = @_;
+    $curse->{menu_byname}{$name}{$entry}{enabled} = $state;
+    1;
+}
+
+sub _tick_menu {
+    my ($curse, $item, $state, $name, $entry) = @_;
+    $curse->{menu_byname}{$name}{$entry}{ticked} = $state;
+    1;
+}
+
+sub _menu_action {
+    my ($curse, $item, $name, $entry) = @_;
+    exists $curse->{menu_byname}{$name}{$entry} or return 0;
+    $curse->{menu_byname}{$name}{$entry}{enabled} or return 0;
+    my $action = $curse->{menu_byname}{$name}{$entry}{action};
+    $action or return 0;
+    $action->($curse, $name, $entry);
+}
+
+1;