File Coverage

blib/lib/Term/ANSIMenu.pm

Criterion	Covered	Total	%
statement	752	1410	53.3
branch	294	842	34.9
condition	10	99	10.1
subroutine	145	181	80.1
pod	0	101	0.0
total	1201	2633	45.6

package Term::ANSIMenu;

use 5.006;
use strict;
use warnings;
use Carp;
use Term::ReadKey;

our $VERSION = '0.02';

#===============================================================================
#Constants
#===============================================================================

#Screen control
use constant VT100      => "\x1B[61\"p";
use constant LINES      => "\x1B(0";
use constant ASCII      => "\x1B(B";
use constant WRAP_ON    => "\x1B[?7h";
use constant WRAP_OFF   => "\x1B[?7l";
use constant REGION_ON  => "\x1B[?6h";
use constant REGION_OFF => "\x1B[?6l";

#Deleting
use constant DEL_TO_END     => "\x1B[0K";
use constant DEL_FROM_BEGIN => "\x1B[1K";
use constant DEL_LINE       => "\x1B[2K";
use constant DEL_TO_EOS     => "\x1B[0J";
use constant DEL_FROM_BOS   => "\x1B[1J";
use constant DEL_SCREEN     => "\x1B[2J";
use constant CLS            => "\x1B[2J";

#Cursor control
use constant CURSOR_OFF  => "\x1B[?25l";
use constant CURSOR_ON   => "\x1B[?25h";
use constant CURSOR_SAV  => "\x1B7";
use constant CURSOR_RST  => "\x1B8";
use constant REGION_UP   => "\x1BM";
use constant REGION_DOWN => "\x1BD";
use constant NEXT_LINE   => "\x1BE";
use constant HOME        => "\x1B[H";

#Line drawing
use constant HOR => LINES . "q" . ASCII;
use constant VER => LINES . "x" . ASCII;
use constant ULC => LINES . "l" . ASCII;
use constant URC => LINES . "k" . ASCII;
use constant LRC => LINES . "j" . ASCII;
use constant LLC => LINES . "m" . ASCII;
use constant LTE => LINES . "t" . ASCII;
use constant RTE => LINES . "u" . ASCII;
use constant TTE => LINES . "w" . ASCII;
use constant BTE => LINES . "v" . ASCII;
use constant CTE => LINES . "n" . ASCII;

#Attributes
use constant CLEAR     => "\x1B[0m";
use constant RESET     => "\x1B[0m";
use constant BOLD      => "\x1B[1m";
use constant DIM       => "\x1B[2m";
use constant UNDERLINE => "\x1B[4m";
use constant BLINK     => "\x1B[5m";
use constant REVERSE   => "\x1B[7m";
use constant HIDDEN    => "\x1B[8m";

#Colors
use constant  BLACK   => "\x1B[30m";
use constant  RED     => "\x1B[31m";
use constant  GREEN   => "\x1B[32m";
use constant  YELLOW  => "\x1B[33m";
use constant  BLUE    => "\x1B[34m";
use constant  MAGENTA => "\x1B[35m";
use constant  CYAN    => "\x1B[36m";
use constant  WHITE   => "\x1B[37m";

use constant  ON_BLACK   => "\x1B[40m";
use constant  ON_RED     => "\x1B[41m";
use constant  ON_GREEN   => "\x1B[42m";
use constant  ON_YELLOW  => "\x1B[43m";
use constant  ON_BLUE    => "\x1B[44m";
use constant  ON_MAGENTA => "\x1B[45m";
use constant  ON_CYAN    => "\x1B[46m";
use constant  ON_WHITE   => "\x1B[47m";

#===============================================================================
#Encapsulated data
#===============================================================================

{
  my %_attribs = (           #Default value              Mode   #Comment
    _term_width           => [0,                         'r' ], #INT
    _term_height          => [0,                         'r' ], #INT
    _width                => [0,                         'rw'], #INT, clip if < length title or > $term_width
    _height               => [0,                         'rw'], #INT, clip if > $height
    _space_after_title    => [1,                         'rw'], #BOOL
    _space_after_items    => [1,                         'rw'], #BOOL
    _space_after_status   => [0,                         'rw'], #BOOL
    _spacious_items       => [0,                         'rw'], #BOOL
    _cursor               => [1,                         'rw'], #BOOL
    _cursor_char          => ['?',                       'rw'], #CHAR
    _up_keys              => [['UP', 'PGUP', 'LEFT'],    'rw'], #ARRAY of keys
    _down_keys            => [['DOWN', 'PGDN', 'RIGHT'], 'rw'], #ARRAY of keys
    _exit_keys            => [['q', 'Q', 'CTRL-c'],      'rw'], #ARRAY of keys
    _help_keys            => [['F1', '?']              , 'rw'], #ARRAY of keys
    _help                 => [[],                        'rw'], #ARRAY of [status_msg, CODE reference]
    _selection            => [0,                         'rw'], #INT, > 0 and <= number of items
    _selection_keys       => [['SPACE', 'ENTER'],        'rw'], #ARRAY of keys
    _selection_wrap       => [1,                         'rw'], #BOOL
    _selection_style      => [['REVERSE'],               'rw'], #ARRAY of attributes BLINK, REVERSE, BOLD, UNDERLINE or CLEAR
    _selection_fgcolor    => ['',                        'rw'], #FGCOLOR
    _selection_bgcolor    => ['',                        'rw'], #BGCOLOR
    _leader               => [0,                         'rw'], #BOOL
    _leader_delimiter     => ['',                        'rw'], #STR or LINE CHAR
    _trailer              => [0,                         'rw'], #BOOL
    _trailer_delimiter    => ['',                        'rw'], #STR or LINE CHAR
    _shortcut_prefix      => ['',                        'rw'], #STR or LINE CHAR
    _shortcut_postfix     => ['',                        'rw'], #STR or LINE CHAR
    _delimiter            => ['',                        'rw'], #STR or LINE CHAR
    _label_prefix         => ['',                        'rw'], #STR or LINE CHAR
    _label_postfix        => ['',                        'rw'], #STR or LINE CHAR
    _title                => ['',                        'rw'], #STR
    _title_style          => [['BOLD'],                  'rw'], #ARRAY of attributes BLINK, REVERSE, BOLD, UNDERLINE or CLEAR
    _title_fgcolor        => ['',                        'rw'], #FGCOLOR
    _title_bgcolor        => ['',                        'rw'], #BGCOLOR
    _title_align          => ['CENTER',                  'rw'], #LEFT|RIGHT|CENTER
    _title_fill           => [1,                         'rw'], #BOOL
    _title_frame          => [1,                         'rw'], #BOOL
    _title_frame_style    => [['BOLD'],                  'rw'], #ARRAY of attributes BLINK, REVERSE, BOLD or CLEAR
    _title_frame_fgcolor  => ['',                        'rw'], #FGCOLOR
    _title_frame_bgcolor  => ['',                        'rw'], #BGCOLOR
    _items                => [[],                        'rw'], #ARRAY of ['shortcut', 'description', \&code ]
    _item_style           => [['CLEAR'],                 'rw'], #ARRAY of attributes BLINK, REVERSE, BOLD, UNDERLINE or CLEAR
    _item_fgcolor         => ['',                        'rw'], #FGCOLOR
    _item_bgcolor         => ['',                        'rw'], #BGCOLOR
    _item_align           => ['LEFT',                    'rw'], #LEFT|RIGHT|CENTER
    _item_fill            => [1,                         'rw'], #BOOL
    _item_frame           => [1,                         'rw'], #BOOL
    _item_frame_style     => [['CLEAR'],                 'rw'], #ARRAY of attributes BLINK, REVERSE, BOLD or CLEAR
    _item_frame_fgcolor   => ['',                        'rw'], #FGCOLOR
    _item_frame_bgcolor   => ['',                        'rw'], #BGCOLOR
    _status               => ['',                        'rw'], #STR
    _status_style         => [['CLEAR'],                 'rw'], #ARRAY of attributes BLINK, REVERSE, BOLD, UNDERLINE or CLEAR
    _status_fgcolor       => ['',                        'rw'], #FGCOLOR
    _status_bgcolor       => ['',                        'rw'], #BGCOLOR
    _status_align         => ['LEFT',                    'rw'], #LEFT|RIGHT|CENTER
    _status_fill          => [1,                         'rw'], #BOOL
    _status_frame         => [0,                         'rw'], #BOOL
    _status_frame_style   => [['CLEAR'],                 'rw'], #ARRAY of attributes BLINK, REVERSE, BOLD or CLEAR
    _status_frame_fgcolor => ['',                        'rw'], #FGCOLOR
    _status_frame_bgcolor => ['',                        'rw'], #BGCOLOR
    _prompt               => ['',                        'rw'], #STR
    _prompt_style         => [['BOLD'],                  'rw'], #ARRAY of attributes BLINK, REVERSE, BOLD, UNDERLINE or CLEAR
    _prompt_fgcolor       => ['',                        'rw'], #FGCOLOR
    _prompt_bgcolor       => ['',                        'rw'], #BGCOLOR
    _prompt_align         => ['LEFT',                    'rw'], #LEFT|RIGHT|CENTER
    _prompt_fill          => [1,                         'rw'], #BOOL
    _prompt_frame         => [0,                         'rw'], #BOOL
    _prompt_frame_style   => [['BOLD'],                  'rw'], #ARRAY of attributes BLINK, REVERSE, BOLD or CLEAR
    _prompt_frame_fgcolor => ['',                        'rw'], #FGCOLOR
    _prompt_frame_bgcolor => ['',                        'rw']);#BGCOLOR

  my %_keynames = ( "\e[1~"  => "HOME",   #Linux console
                    "\e[2~"  => "INSERT", #VT100
                    "\e[3~"  => "DEL",    #VT100
                    "\e[4~"  => "END",    #Linux console
                    "\e[5~"  => "PGUP",   #VT100
                    "\e[6~"  => "PGDN",   #VT100
                    "\e[11~" => "F1",     #VT100
                    "\e[12~" => "F2",     #VT100
                    "\e[13~" => "F3",     #VT100
                    "\e[14~" => "F4",     #VT100
                    "\e[15~" => "F5",     #VT100
                    "\e[17~" => "F6",     #VT100
                    "\e[18~" => "F7",     #VT100
                    "\e[19~" => "F8",     #VT100
                    "\e[20~" => "F9",     #VT100
                    "\e[21~" => "F10",    #VT100
                    "\e[23~" => "F11",    #VT100
                    "\e[24~" => "F12",    #VT100
                    "\e[[A"  => "F1",     #Linux console
                    "\e[[B"  => "F2",     #Linux console
                    "\e[[C"  => "F3",     #Linux console
                    "\e[[D"  => "F4",     #Linux console
                    "\e[[E"  => "F5",     #Linux console
                    "\e[A"   => "UP",     #VT100
                    "\e[B"   => "DOWN",   #VT100
                    "\e[C"   => "RIGHT",  #VT100
                    "\e[D"   => "LEFT",   #VT100
                    "\e[F"   => "END",    #VT100
                    "\e[H"   => "HOME",   #VT100
                    "\eOA"   => "UP",     #XTerm
                    "\eOB"   => "DOWN",   #XTerm
                    "\eOC"   => "RIGHT",  #XTerm
                    "\eOD"   => "LEFT",   #XTerm
                    "\eOF"   => "END",    #XTerm
                    "\eOH"   => "HOME",   #XTerm
                    "\eOP"   => "F1",     #XTerm
                    "\eOQ"   => "F2",     #XTerm
                    "\eOR"   => "F3",     #XTerm
                    "\eOS"   => "F4",     #XTerm
                    "\ea"    => "META-a",
                    "\eb"    => "META-b",
                    "\ec"    => "META-c",
                    "\ed"    => "META-d",
                    "\ee"    => "META-e",
                    "\ef"    => "META-f",
                    "\eg"    => "META-g",
                    "\eh"    => "META-h",
                    "\ei"    => "META-i",
                    "\ej"    => "META-j",
                    "\ek"    => "META-k",
                    "\el"    => "META-l",
                    "\em"    => "META-m",
                    "\en"    => "META-n",
                    "\eo"    => "META-o",
                    "\ep"    => "META-p",
                    "\eq"    => "META-q",
                    "\er"    => "META-r",
                    "\es"    => "META-s",
                    "\et"    => "META-t",
                    "\eu"    => "META-u",
                    "\ev"    => "META-v",
                    "\ew"    => "META-w",
                    "\ex"    => "META-x",
                    "\ey"    => "META-y",
                    "\ez"    => "META-z",
                    "\x01"   => "CTRL-a",
                    "\x02"   => "CTRL-b",
                    "\x03"   => "CTRL-c",
                    "\x04"   => "CTRL-d",
                    "\x05"   => "CTRL-e",
                    "\x06"   => "CTRL-f",
                    "\x07"   => "CTRL-g",
                    "\x08"   => "CTRL-h",
                    "\x09"   => "TAB",    #Also CRTL-i
                    "\x0A"   => "ENTER",  #Also CTRL-j
                    "\x0B"   => "CTRL-k",
                    "\x0C"   => "CTRL-l",
                    "\x0D"   => "CTRL-m", #Apparently CTRL-m gives \x0A
                    "\x0E"   => "CTRL-n",
                    "\x0F"   => "CTRL-o",
                    "\x10"   => "CTRL-p",
                    "\x11"   => "CTRL-q",
                    "\x12"   => "CTRL-r",
                    "\x13"   => "CTRL-s",
                    "\x14"   => "CTRL-t",
                    "\x15"   => "CTRL-u",
                    "\x16"   => "CTRL-v",
                    "\x17"   => "CTRL-w",
                    "\x18"   => "CTRL-x",
                    "\x19"   => "CTRL-y",
                    "\x1A"   => "CTRL-z",
                    "\x20"   => "SPACE",
                    "\x7F"   => "BS");

  #Get the name of a key or return undef
  sub _get_keyname {
    my ($self, $sequence) = @_;
    my $keyname = undef;
    $keyname = $_keynames{$sequence} if exists $_keynames{$sequence};
    return $keyname;
  }

  #Is argument a valid key name?
  sub _is_keyname {
    my ($self, $name) = @_;
    return 1 if length($name) == 1 and $name =~ /^[[:graph:] ]$/;
    my %keynames = reverse %_keynames;
    return 1 if exists $keynames{$name};
    return 0;
  }

 #Get default value for an attribute
  sub _get_default {
    my ($self, $attrib) = @_;
    return $_attribs{$attrib}[0];
  }

  #Get a list of all attributes
  sub _list_attribs {
    return keys %_attribs;
  }

  #Verify the access mode for an attribute
  sub _check_mode {
    my ($self, $attrib, $mode) = @_;
    return $_attribs{$attrib}[1] =~ /$mode/i;
  }

  #Verify existence of an attribute
  sub _check_attrib {
    my ($self, $attrib) = @_;
    return exists $_attribs{$attrib};
  }

  #Verify validity of an attribute value
  sub _check_value {
    my ($self, $attrib, $value) = @_;
    my $ok = 0;
    #Make sure a value was given
    return $ok unless defined $value;
    #Now check if the given value(s) is/are appropriate
    SWITCH: {
      if ($attrib eq '_width') {
        $ok++ if $value > 0 and $value < $self->{_term_width};
        last SWITCH;
      }
      if ($attrib eq '_height') {
        $ok++ if $value > 0 and $value < $self->{_term_height};
        last SWITCH;
      }
      if ($attrib =~ /^_space_after_/) {
        $ok++ if $value =~ /^(?:\-|\+|0|1|NO|N|YES|Y|FALSE|F|TRUE|T)$/i;
        last SWITCH;
      }
      if ($attrib eq '_spacious_items') {
        $ok++ if $value =~ /^(?:\-|\+|0|1|NO|N|YES|Y|FALSE|F|TRUE|T)$/i;
        last SWITCH;
      }
      if ($attrib eq '_cursor') {
        $ok++ if $value =~ /^(?:\-|\+|0|1|NO|N|YES|Y|FALSE|F|TRUE|T)$/i;
        last SWITCH;
      }
      if ($attrib eq '_cursor_char') {
        $ok++ if $value =~ /^[[:graph:] ]$/;
        last SWITCH;
      }
      if ($attrib eq '_selection') {
        $ok++ if $value =~ /^\d+$/ and $value <= scalar(@{$self->{_items}});
        last SWITCH;
      }
      if ($attrib eq '_selection_wrap') {
        $ok++ if $value =~ /^(?:\-|\+|0|1|NO|N|YES|Y|FALSE|F|TRUE|T)$/i;
        last SWITCH;
      }
      if ($attrib eq '_help') {
        last SWITCH unless ref($value) eq 'ARRAY';
        foreach my $help (@{$value}) {
          if (defined $help) {
            last SWITCH unless ref($help) eq 'ARRAY';
            if (defined $help->[0]) {
              last SWITCH unless $help->[0] =~ /^[[:graph:] ]*$/;
            }
            if (defined $help->[1]) {
              last SWITCH unless ref($help->[1]) eq 'CODE';
            }
          }
        }
        $ok++;
        last SWITCH;
      }
      if ($attrib =~ /_keys$/) {
        last SWITCH unless ref($value) eq 'ARRAY';
        foreach my $arg (@{$value}) {
          last SWITCH unless $self->_is_keyname($arg);
        }
        $ok++;
        last SWITCH;
      }
      if ($attrib eq '_items') {
        last SWITCH unless ref($value) eq 'ARRAY';
        foreach my $item (@{$value}) {
          last SWITCH unless ref($item) eq 'ARRAY';
          last SWITCH unless defined($item->[0]) and $self->_is_keyname($item->[0]);
          last SWITCH unless defined($item->[1]) and $item->[1] =~ /^[[:graph:] ]*$/;
          if (defined $item->[2]) {
            last SWITCH unless ref($item->[2]) eq 'CODE';
          }
        }
        $ok++;
        last SWITCH;
      }
      if ($attrib =~ /_fill$/) {
        $ok++ if $value =~ /^(?:\-|\+|0|1|NO|N|YES|Y|FALSE|F|TRUE|T)$/i;
        last SWITCH;
      }
      if ($attrib =~ /_(?:leader|trailer)$/) {
        $ok++ if $value =~ /^(?:\-|\+|0|1|NO|N|YES|Y|FALSE|F|TRUE|T)$/i;
        last SWITCH;
      }
      if ($attrib =~ /_(?:pre|post)fix$/) {
        if ($value =~ /^ *(?:HOR|VER|ULC|URC|LRC|LLC|LTE|RTE|TTE|BTE|CTE) *$/) {
          $ok++;
        }
        elsif ($value =~ /^[[:graph:] ]*$/) {
          $ok++;
        }
        last SWITCH;
      }
      if ($attrib =~ /_delimiter$/) {
        if ($value =~ /^(?:HOR|VER|ULC|URC|LRC|LLC|LTE|RTE|TTE|BTE|CTE)$/) {
          $ok++;
        }
        elsif ($value =~ /^[[:graph:] ]?$/) {
          $ok++;
        }
        last SWITCH;
      }
      if ($attrib =~ /^_(?:prompt|status|title)$/) {
        $ok++ if $value =~ /^[[:graph:] ]*$/;
        last SWITCH;
      }
      if ($attrib =~ /_align$/) {
        $ok++ if $value =~ /^(?:LEFT|RIGHT|CENTER)$/i;
        last SWITCH;
      }
      if ($attrib =~ /_frame$/) {
        $ok++ if $value =~ /^(?:\-|\+|0|1|NO|N|YES|Y|FALSE|F|TRUE|T)$/i;
        last SWITCH;
      }
      if ($attrib =~ /_frame_style$/) {
        last SWITCH unless ref($value) eq 'ARRAY';
        foreach my $arg (@{$value}) {
          last SWITCH unless $arg =~ /^(?:BLINK|REVERSE|BOLD|CLEAR)$/i;
        }
        $ok++;
        last SWITCH;
      }
      if ($attrib =~ /_style$/) {
        last SWITCH unless ref($value) eq 'ARRAY';
        foreach my $arg (@{$value}) {
          last SWITCH unless $arg =~ /^(?:BLINK|REVERSE|BOLD|UNDERLINE|CLEAR)$/i;
        }
        $ok++;
        last SWITCH;
      }
      if ($attrib =~ /_[fb]gcolor$/) {
        $ok++ if $value =~ /^(?:BLACK|RED|GREEN|YELLOW|BLUE|MAGENTA|CYAN|WHITE)$/i;
        last SWITCH;
      }
      else {
        croak "No such attribute: $attrib";
      }
    }
    return $ok;
  }

  sub _linestr_length {
    my ($self, $str) = @_;

    my $length = 0;
    if ($str =~ /^( *)(?:HOR|VER|ULC|URC|LRC|LLC|LTE|RTE|TTE|BTE|CTE)( *)$/) {
      $length = length($1) + 1 + length($2);
    }
    else {
      $length = length $str;
    }
    return $length;
  }

  sub _print_linestr {
    my ($self, $str) = @_;

    if ($str =~ /^( *)(HOR|VER|ULC|URC|LRC|LLC|LTE|RTE|TTE|BTE|CTE)( *)$/) {
      print $1;
      print &{\&$2};
      print $3;
    }
    else {
      print $str;
    }
  }

  sub _print_color {
    my ($self, $fgcolor, $bgcolor) = @_;

    print &{\&$fgcolor} if $fgcolor;
    if ($bgcolor) {
      $bgcolor = "ON_" . $bgcolor;
      print &{\&$bgcolor};
    }
  }

  sub _print_style {
    my ($self, @styles) = @_;

    foreach my $style (@styles) {
      print &{\&$style} if $style;
    }
  }

  sub _items_start {
    my $self = shift;

    my $line = 1;
    if (length($self->title()) > 0) {
      $line++;
      $line += 2 if $self->title_frame();
      $line++ if $self->space_after_title();
    }
    return $line;
  }

  sub _status_start {
    my $self = shift;

    my $line = $self->_items_start();
    if ($self->item_count() > 0) {
      $line++ if $self->leader() and not $self->item_frame();
      $line += 2 if $self->item_frame();
      $line += $self->item_count();
      $line += $self->item_count() - 1 if $self->item_frame() and $self->spacious_items() and $self->item_count() > 1;
      $line++ if $self->trailer() and not $self->item_frame();
      $line++ if $self->space_after_items();
    }
    return $line;
  }

  sub _prompt_start {
    my $self = shift;

    my $line = $self->_status_start();
    if (length($self->status()) > 0) {
      $line++;
      $line += 2 if $self->status_frame();
      $line++ if $self->space_after_status();
    }
    return $line;
  }

  sub _cursor_pos {
    my $self = shift;

    my $line = $self->_prompt_start();
    $line++ if $self->prompt_frame();
    my $max_length = $self->width() - 1;
    $max_length -= 2 if $self->prompt_frame();
    my $prompt_length = length $self->prompt();
    $prompt_length = $max_length if $prompt_length > $max_length;
    my $padding = $max_length - $prompt_length;
    $padding = 0 if $padding < 0;
    my $col = 1;
    if ($self->prompt_fill()) {
      if ($self->prompt_align() eq 'CENTER') {
        $padding = int ($padding / 2);
        $col += $padding + $prompt_length;
        $col++ if $self->prompt_frame();
      }
      elsif ($self->prompt_align() eq 'RIGHT') {
        $col += $padding + $prompt_length;
        $col++ if $self->prompt_frame();
      }
      else {
        $col += $prompt_length;
        $col++ if $self->prompt_frame();
      }
    }
    else {
      $col += $prompt_length;
      $col++ if $self->prompt_frame();
    }
    return $line, $col;
  }

  sub _clear_after_items {
    my $self = shift;

    $self->pos($self->_status_start(), 1);
    print DEL_TO_EOS;
  }

  sub _update_hint {
    my ($self, $hint) = @_;

    if (defined $hint and $self->_check_value('_status', $hint)) {
      $self->_clear_after_items();
      $self->print_status($hint) if $self->status();
      $self->print_prompt() if $self->prompt();
      $self->print_cursor();
    }
  }

}

#===============================================================================
#Constructor and destructor
#===============================================================================

sub new {
  my ($caller, %args) = @_;

  my $caller_is_obj = ref($caller);
  my $class = $caller_is_obj || $caller;
  my $self = bless {}, $class;

  #Set attributes
  my ($w, $h) = GetTerminalSize;
  $self->{_term_width} = $w;
  $self->{_term_height} = $h;
  foreach my $attrib ($self->_list_attribs()) {
    next unless $self->_check_mode($attrib, 'w');
    my ($arg) = ($attrib =~ /^_(\w+)/);
    if (exists $args{$arg}) {
      if ($self->_check_value($attrib, $args{$arg})) {
        $self->{$attrib} = $self->$arg($args{$arg});
      }
      else {
        croak "Invalid value for $arg: $args{$arg}";
      }
    }
    elsif ($caller_is_obj) {
      $self->{$attrib} = $caller->{$attrib};
    }
    else {
      $self->{$attrib} = $self->_get_default($attrib);
    }
  }
  $self->{_width} = $w unless $self->_check_value('_width', $self->{_width});
  $self->{_height} = $h unless $self->_check_value('_height', $self->{_height});
  #Initialize terminal
  $| = 1;            #Set flush mode
  print "\e[61\"p";  #Set VT100 mode
  print "\e[2J";     #Clear screen
  print "\e[1;1H";   #Position cursor at top left
  return $self;
}

sub DESTROY {
  Term::ReadKey::ReadMode(0); #Restore propper readmode
  #print "\e[?6l";             #Remove region
  print "\e(B";               #Restore charset
  #print "\e8";                #Restore cursor
  print "\e[?25h";            #Turn cursor on
  print "\e[0m";              #Restore all attributes
  #print "\e[2J";              #Clear screen
  #print "\e[1;1H";            #Position cursor at top left
}

#===============================================================================
#Accessors and mutators
#===============================================================================

#Sorry, I just don't like AUTOLOAD and yes I do know about affordances but
#separate read/write methods feel awkward to me. Consequently this is more code
#than strictly needed, but that's only a one-time investment. A small one if
#you're using vim `;-)

sub width {
  my ($self, $width) = @_;

  if ($width) {
    if ($self->_check_value('_width', $width)) {
      $self->{_width} = $width;
    }
    else {
      carp "width must be larger than 0 and smaller than the terminal width";
    }
  }
  return $self->{_width};
}

sub height {
  my ($self, $height) = @_;

  if ($height) {
    if ($self->_check_value('_height', $height)) {
      $self->{_height} = $height;
    }
    else {
      carp "height must be larger than 0 and smaller than the terminal height";
    }
  }
  return $self->{_height};
}

sub space_after_title {
  my ($self, $space) = @_;

  if (defined $space) {
    if ($self->_check_value('_space_after_title', $space)) {
      if ($space =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_space_after_title} = 1;
      }
      else {
        $self->{_space_after_title} = 0;
      }
    }
    else {
      carp "space_after_title must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_space_after_title};
}

sub space_after_items {
  my ($self, $space) = @_;

  if (defined $space) {
    if ($self->_check_value('_space_after_items', $space)) {
      if ($space =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_space_after_items} = 1;
      }
      else {
        $self->{_space_after_items} = 0;
      }
    }
    else {
      carp "space_after_items must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_space_after_items};
}

sub space_after_status {
  my ($self, $space) = @_;

  if (defined $space) {
    if ($self->_check_value('_space_after_status', $space)) {
      if ($space =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_space_after_status} = 1;
      }
      else {
        $self->{_space_after_status} = 0;
      }
    }
    else {
      carp "space_after_status must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_space_after_status};
}

sub spacious_items {
  my ($self, $space) = @_;

  if (defined $space) {
    if ($self->_check_value('_spacious_items', $space)) {
      if ($space =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_spacious_items} = 1;
      }
      else {
        $self->{_spacious_items} = 0;
      }
    }
    else {
      carp "spacious_items must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_spacious_items};
}

sub cursor {
  my ($self, $cursor) = @_;

  if (defined $cursor) {
    if ($self->_check_value('_cursor', $cursor)) {
      if ($cursor =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_cursor} = 1;
      }
      else {
        $self->{_cursor} = 0;
      }
    }
    else {
      carp "cursor must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_cursor};
}

sub cursor_char {
  my ($self, $char) = @_;

  if ($char) {
    if ($self->_check_value('_cursor_char', $char)) {
      $self->{_cursor_char} = $char;
    }
    else {
      carp "cursor_char must be a printable character";
    }
  }
  return $self->{_cursor_char};
}

sub up_keys {
  my ($self, $keys) = @_;

  if ($keys) {
    if (ref $keys eq 'ARRAY') {
      if ($self->_check_value('_up_keys', $keys)) {
        $self->{_up_keys} = $keys;
      }
      else {
        carp "up_keys must be one or more keynames";
      }
    }
    else {
      carp "up_keys must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_up_keys}} : $self->{_up_keys};
}

sub down_keys {
  my ($self, $keys) = @_;

  if ($keys) {
    if (ref $keys eq 'ARRAY') {
      if ($self->_check_value('_down_keys', $keys)) {
        $self->{_down_keys} = $keys;
      }
      else {
        carp "down_keys must be one or more keynames";
      }
    }
    else {
      carp "down_keys must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_down_keys}} : $self->{_down_keys};
}

sub help {
  my ($self, $help) = @_;

  if ($help) {
    if (ref $help eq 'ARRAY') {
      if ($self->_check_value('_help', $help)) {
        $self->{_help} = $help;
      }
      else {
        carp "help must an array of arrays containing strings and code references";
      }
    }
    else {
      carp "help must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_help}} : $self->{_help};
}

sub help_keys {
  my ($self, $keys) = @_;

  if ($keys) {
    if (ref $keys eq 'ARRAY') {
      if ($self->_check_value('_help_keys', $keys)) {
        $self->{_help_keys} = $keys;
      }
      else {
        carp "help_keys must be one or more keynames";
      }
    }
    else {
      carp "help_keys must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_help_keys}} : $self->{_help_keys};
}

sub exit_keys {
  my ($self, $keys) = @_;

  if ($keys) {
    if (ref $keys eq 'ARRAY') {
      if ($self->_check_value('_exit_keys', $keys)) {
        $self->{_exit_keys} = $keys;
      }
      else {
        carp "exit_keys must be one or more keynames";
      }
    }
    else {
      carp "exit_keys must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_exit_keys}} : $self->{_exit_keys};
}

sub selection {
  my ($self, $sel) = @_;

  if (defined $sel) {
    if ($self->_check_value('_selection', $sel)) {
      $self->{_selection} = $sel;
    }
    else {
      carp "selection must be larger than or equal to 0 and smaller than or equal to the number of items";
    }
  }
  return $self->{_selection};
}

sub selection_wrap {
  my ($self, $wrap) = @_;

  if (defined $wrap) {
    if ($self->_check_value('_selection_wrap', $wrap)) {
      if ($wrap =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_selection_wrap} = 1;
      }
      else {
        $self->{_selection_wrap} = 0;
      }
    }
    else {
      carp "selection_wrap must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_selection_wrap};
}

sub selection_keys {
  my ($self, $keys) = @_;

  if ($keys) {
    if (ref $keys eq 'ARRAY') {
      if ($self->_check_value('_selection_keys', $keys)) {
        $self->{_selection_keys} = $keys;
      }
      else {
        carp "selection_keys must be one or more keynames";
      }
    }
    else {
      carp "selection_keys must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_selection_keys}} : $self->{_selection_keys};
}

sub selection_style {
  my ($self, $styles) = @_;

  if ($styles) {
    if (ref $styles eq 'ARRAY') {
      if ($self->_check_value('_selection_style', $styles)) {
        foreach my $style (@{$styles}) {
          $style = uc $style;
        }
        $self->{_selection_style} = $styles;
      }
      else {
        carp "selection_style must be BLINK, REVERSE, BOLD, UNDERLINE and/or CLEAR";
      }
    }
    else {
      carp "selection_style must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_selection_style}} : $self->{_selection_style};
}

sub selection_fgcolor {
  my ($self, $fgcolor) = @_;

  if ($fgcolor) {
    if ($self->_check_value('_selection_fgcolor', $fgcolor)) {
      $self->{_selection_fgcolor} = uc $fgcolor;
    }
    else {
      carp "selection_fgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_selection_fgcolor};
}

sub selection_bgcolor {
  my ($self, $bgcolor) = @_;

  if ($bgcolor) {
    if ($self->_check_value('_selection_bgcolor', $bgcolor)) {
      $self->{_selection_bgcolor} = uc $bgcolor;
    }
    else {
      carp "selection_bgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_selection_bgcolor};
}

sub leader {
  my ($self, $leader) = @_;

  if (defined $leader) {
    if ($self->_check_value('_leader', $leader)) {
      if ($leader =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_leader} = 1;
      }
      else {
        $self->{_leader} = 0;
      }
    }
    else {
      carp "leader must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_leader};
}

sub trailer {
  my ($self, $trailer) = @_;

  if (defined $trailer) {
    if ($self->_check_value('_trailer', $trailer)) {
      if ($trailer =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_trailer} = 1;
      }
      else {
        $self->{_trailer} = 0;
      }
    }
    else {
      carp "trailer must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_trailer};
}

sub shortcut_prefix {
  my ($self, $prefix) = @_;

  if (defined $prefix) {
    if ($self->_check_value('_shortcut_prefix', $prefix)) {
      $self->{_shortcut_prefix} = $prefix;
    }
    else {
      carp "shortcut_prefix must be a string of printable characters or a line-drawing character";
    }
  }
  return $self->{_shortcut_prefix};
}

sub shortcut_postfix {
  my ($self, $postfix) = @_;

  if (defined $postfix) {
    if ($self->_check_value('_shortcut_postfix', $postfix)) {
      $self->{_shortcut_postfix} = $postfix;
    }
    else {
      carp "shortcut_postfix must be a string of printable characters or a line-drawing character";
    }
  }
  return $self->{_shortcut_postfix};
}

sub delimiter {
  my ($self, $del) = @_;

  if (defined $del) {
    if ($self->_check_value('_delimiter', $del)) {
      $self->{_delimiter} = $del;
    }
    else {
      carp "delimiter must be a string of printable characters or a line-drawing character";
    }
  }
  return $self->{_delimiter};
}

sub leader_delimiter {
  my ($self, $del) = @_;

  if (defined $del) {
    if ($self->_check_value('_leader_delimiter', $del)) {
      $self->{_leader_delimiter} = $del;
    }
    else {
      carp "leader_delimiter must be a string of printable characters or a line-drawing character";
    }
  }
  return $self->{_leader_delimiter};
}

sub trailer_delimiter {
  my ($self, $del) = @_;

  if (defined $del) {
    if ($self->_check_value('_trailer_delimiter', $del)) {
      $self->{_trailer_delimiter} = $del;
    }
    else {
      carp "trailer_delimiter must be a string of printable characters or a line-drawing character";
    }
  }
  return $self->{_trailer_delimiter};
}

sub label_prefix {
  my ($self, $prefix) = @_;

  if (defined $prefix) {
    if ($self->_check_value('_label_prefix', $prefix)) {
      $self->{_label_prefix} = $prefix;
    }
    else {
      carp "label_prefix must be a string of printable characters or a line-drawing character";
    }
  }
  return $self->{_label_prefix};
}

sub label_postfix {
  my ($self, $postfix) = @_;

  if (defined $postfix) {
    if ($self->_check_value('_label_postfix', $postfix)) {
      $self->{_label_postfix} = $postfix;
    }
    else {
      carp "label_postfix must be a string of printable characters or a line-drawing character";
    }
  }
  return $self->{_label_postfix};
}

sub title {
  my ($self, $title) = @_;

  if (defined $title) {
    if ($self->_check_value('_title', $title)) {
      $self->{_title} = $title;
    }
    else {
      carp "title must be a string of printable characters";
    }
  }
  return $self->{_title};
}

sub title_style {
  my ($self, $styles) = @_;

  if ($styles) {
    if (ref $styles eq 'ARRAY') {
      if ($self->_check_value('_title_style', $styles)) {
        foreach my $style (@{$styles}) {
          $style = uc $style;
        }
        $self->{_title_style} = $styles;
      }
      else {
        carp "title_style must be BLINK, REVERSE, BOLD, UNDERLINE and/or CLEAR";
      }
    }
    else {
      carp "title_style must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_title_style}} : $self->{_title_style};
}

sub title_fgcolor {
  my ($self, $fgcolor) = @_;

  if ($fgcolor) {
    if ($self->_check_value('_title_fgcolor', $fgcolor)) {
      $self->{_title_fgcolor} = uc $fgcolor;
    }
    else {
      carp "title_fgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_title_fgcolor};
}

sub title_bgcolor {
  my ($self, $bgcolor) = @_;

  if ($bgcolor) {
    if ($self->_check_value('_title_bgcolor', $bgcolor)) {
      $self->{_title_bgcolor} = uc $bgcolor;
    }
    else {
      carp "title_bgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_title_bgcolor};
}

sub title_align {
  my ($self, $align) = @_;

  if ($align) {
    if ($self->_check_value('_title_align', $align)) {
      $self->{_title_align} = uc $align;
    }
    else {
      carp "title_align must be LEFT, RIGHT or CENTER";
    }
  }
  return $self->{_title_align};
}

sub title_fill {
  my ($self, $fill) = @_;

  if (defined $fill) {
    if ($self->_check_value('_title_fill', $fill)) {
      if ($fill =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_title_fill} = 1;
      }
      else {
        $self->{_title_fill} = 0;
      }
    }
    else {
      carp "title_fill must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_title_fill};
}

sub title_frame {
  my ($self, $frame) = @_;

  if (defined $frame) {
    if ($self->_check_value('_title_frame', $frame)) {
      if ($frame =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_title_frame} = 1;
      }
      else {
        $self->{_title_frame} = 0;
      }
    }
    else {
      carp "title_frame must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_title_frame};
}

sub title_frame_style {
  my ($self, $styles) = @_;

  if ($styles) {
    if (ref $styles eq 'ARRAY') {
      if ($self->_check_value('_title_frame_style', $styles)) {
        foreach my $style (@{$styles}) {
          $style = uc $style;
        }
        $self->{_title_frame_style} = $styles;
      }
      else {
        carp "title_frame_style must be BLINK, REVERSE, BOLD and/or CLEAR";
      }
    }
    else {
      carp "title_frame_style must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_title_frame_style}} : $self->{_title_frame_style};
}

sub title_frame_fgcolor {
  my ($self, $fgcolor) = @_;

  if ($fgcolor) {
    if ($self->_check_value('_title_frame_fgcolor', $fgcolor)) {
      $self->{_title_frame_fgcolor} = uc $fgcolor;
    }
    else {
      carp "title_frame_fgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_title_frame_fgcolor};
}

sub title_frame_bgcolor {
  my ($self, $bgcolor) = @_;

  if ($bgcolor) {
    if ($self->_check_value('_title_frame_bgcolor', $bgcolor)) {
      $self->{_title_frame_bgcolor} = uc $bgcolor;
    }
    else {
      carp "title_frame_bgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_title_frame_bgcolor};
}

sub items {
  my ($self, $items) = @_;

  if ($items) {
    if (ref $items eq 'ARRAY') {
      if ($self->_check_value('_items', $items)) {
        $self->{_items} = $items;
      }
      else {
        carp "items must be an array of arrays containing keynames, descriptions and code references";
      }
    }
    else {
      carp "items must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_items}} : $self->{_items};
}

sub item_style {
  my ($self, $styles) = @_;

  if ($styles) {
    if (ref $styles eq 'ARRAY') {
      if ($self->_check_value('_item_style', $styles)) {
        foreach my $style (@{$styles}) {
          $style = uc $style;
        }
        $self->{_item_style} = $styles;
      }
      else {
        carp "item_style must be BLINK, REVERSE, BOLD, UNDERLINE and/or CLEAR";
      }
    }
    else {
      carp "item_style must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_item_style}} : $self->{_item_style};
}

sub item_fgcolor {
  my ($self, $fgcolor) = @_;

  if ($fgcolor) {
    if ($self->_check_value('_item_fgcolor', $fgcolor)) {
      $self->{_item_fgcolor} = uc $fgcolor;
    }
    else {
      carp "item_fgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_item_fgcolor};
}

sub item_bgcolor {
  my ($self, $bgcolor) = @_;

  if ($bgcolor) {
    if ($self->_check_value('_item_bgcolor', $bgcolor)) {
      $self->{_item_bgcolor} = uc $bgcolor;
    }
    else {
      carp "item_bgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_item_bgcolor};
}

sub item_align {
  my ($self, $align) = @_;

  if ($align) {
    if ($self->_check_value('_item_align', $align)) {
      $self->{_item_align} = uc $align;
    }
    else {
      carp "item_align must be LEFT, RIGHT or CENTER";
    }
  }
  return $self->{_item_align};
}

sub item_fill {
  my ($self, $fill) = @_;

  if (defined $fill) {
    if ($self->_check_value('_item_fill', $fill)) {
      if ($fill =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_item_fill} = 1;
      }
      else {
        $self->{_item_fill} = 0;
      }
    }
    else {
      carp "item_fill must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_item_fill};
}

sub item_frame {
  my ($self, $frame) = @_;

  if (defined $frame) {
    if ($self->_check_value('_item_frame', $frame)) {
      if ($frame =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_item_frame} = 1;
      }
      else {
        $self->{_item_frame} = 0;
      }
    }
    else {
      carp "item_frame must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_item_frame};
}

sub item_frame_style {
  my ($self, $styles) = @_;

  if ($styles) {
    if (ref $styles eq 'ARRAY') {
      if ($self->_check_value('_item_frame_style', $styles)) {
        foreach my $style (@{$styles}) {
          $style = uc $style;
        }
        $self->{_item_frame_style} = $styles;
      }
      else {
        carp "item_frame_style must be BLINK, REVERSE, BOLD and/or CLEAR";
      }
    }
    else {
      carp "item_frame_style must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_item_frame_style}} : $self->{_item_frame_style};
}

sub item_frame_fgcolor {
  my ($self, $fgcolor) = @_;

  if ($fgcolor) {
    if ($self->_check_value('_item_frame_fgcolor', $fgcolor)) {
      $self->{_item_frame_fgcolor} = uc $fgcolor;
    }
    else {
      carp "item_frame_fgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_item_frame_fgcolor};
}

sub item_frame_bgcolor {
  my ($self, $bgcolor) = @_;

  if ($bgcolor) {
    if ($self->_check_value('_item_frame_bgcolor', $bgcolor)) {
      $self->{_item_frame_bgcolor} = uc $bgcolor;
    }
    else {
      carp "item_frame_bgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_item_frame_bgcolor};
}

sub status {
  my ($self, $status) = @_;

  if (defined $status) {
    if ($self->_check_value('_status', $status)) {
      $self->{_status} = $status;
    }
    else {
      carp "status must be a string of printable characters";
    }
  }
  return $self->{_status};
}

sub status_style {
  my ($self, $styles) = @_;

  if ($styles) {
    if (ref $styles eq 'ARRAY') {
      if ($self->_check_value('_status_style', $styles)) {
        foreach my $style (@{$styles}) {
          $style = uc $style;
        }
        $self->{_status_style} = $styles;
      }
      else {
        carp "status_style must be BLINK, REVERSE, BOLD, UNDERLINE and/or CLEAR";
      }
    }
    else {
      carp "status_style must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_status_style}} : $self->{_status_style};
}

sub status_fgcolor {
  my ($self, $fgcolor) = @_;

  if ($fgcolor) {
    if ($self->_check_value('_status_fgcolor', $fgcolor)) {
      $self->{_status_fgcolor} = uc $fgcolor;
    }
    else {
      carp "status_fgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_status_fgcolor};
}

sub status_bgcolor {
  my ($self, $bgcolor) = @_;

  if ($bgcolor) {
    if ($self->_check_value('_status_bgcolor', $bgcolor)) {
      $self->{_status_bgcolor} = uc $bgcolor;
    }
    else {
      carp "status_bgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_status_bgcolor};
}

sub status_align {
  my ($self, $align) = @_;

  if ($align) {
    if ($self->_check_value('_status_align', $align)) {
      $self->{_status_align} = uc $align;
    }
    else {
      carp "status_align must be LEFT, RIGHT or CENTER";
    }
  }
  return $self->{_status_align};
}

sub status_fill {
  my ($self, $fill) = @_;

  if (defined $fill) {
    if ($self->_check_value('_status_fill', $fill)) {
      if ($fill =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_status_fill} = 1;
      }
      else {
        $self->{_status_fill} = 0;
      }
    }
    else {
      carp "status_fill must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_status_fill};
}

sub status_frame {
  my ($self, $frame) = @_;

  if (defined $frame) {
    if ($self->_check_value('_status_frame', $frame)) {
      if ($frame =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_status_frame} = 1;
      }
      else {
        $self->{_status_frame} = 0;
      }
    }
    else {
      carp "status_frame must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_status_frame};
}

sub status_frame_style {
  my ($self, $styles) = @_;

  if ($styles) {
    if (ref $styles eq 'ARRAY') {
      if ($self->_check_value('_status_frame_style', $styles)) {
        foreach my $style (@{$styles}) {
          $style = uc $style;
        }
        $self->{_status_frame_style} = $styles;
      }
      else {
        carp "status_frame_style must be BLINK, REVERSE, BOLD and/or CLEAR";
      }
    }
    else {
      carp "status_frame_style must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_status_frame_style}} : $self->{_status_frame_style};
}

sub status_frame_fgcolor {
  my ($self, $fgcolor) = @_;

  if ($fgcolor) {
    if ($self->_check_value('_status_frame_fgcolor', $fgcolor)) {
      $self->{_status_frame_fgcolor} = uc $fgcolor;
    }
    else {
      carp "status_frame_fgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_status_frame_fgcolor};
}

sub status_frame_bgcolor {
  my ($self, $bgcolor) = @_;

  if ($bgcolor) {
    if ($self->_check_value('_status_frame_bgcolor', $bgcolor)) {
      $self->{_status_frame_bgcolor} = uc $bgcolor;
    }
    else {
      carp "status_frame_bgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_status_frame_bgcolor};
}

sub prompt {
  my ($self, $prompt) = @_;

  if (defined $prompt) {
    if ($self->_check_value('_prompt', $prompt)) {
      $self->{_prompt} = $prompt;
    }
    else {
      carp "prompt must be a string of printable characters";
    }
  }
  return $self->{_prompt};
}

sub prompt_style {
  my ($self, $styles) = @_;

  if ($styles) {
    if (ref $styles eq 'ARRAY') {
      if ($self->_check_value('_prompt_style', $styles)) {
        foreach my $style (@{$styles}) {
          $style = uc $style;
        }
        $self->{_prompt_style} = $styles;
      }
      else {
        carp "prompt_style must be BLINK, REVERSE, BOLD, UNDERLINE and/or CLEAR";
      }
    }
    else {
      carp "prompt_style must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_prompt_style}} : $self->{_prompt_style};
}

sub prompt_fgcolor {
  my ($self, $fgcolor) = @_;

  if ($fgcolor) {
    if ($self->_check_value('_prompt_fgcolor', $fgcolor)) {
      $self->{_prompt_fgcolor} = uc $fgcolor;
    }
    else {
      carp "prompt_fgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_prompt_fgcolor};
}

sub prompt_bgcolor {
  my ($self, $bgcolor) = @_;

  if ($bgcolor) {
    if ($self->_check_value('_prompt_bgcolor', $bgcolor)) {
      $self->{_prompt_bgcolor} = uc $bgcolor;
    }
    else {
      carp "prompt_bgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_prompt_bgcolor};
}

sub prompt_align {
  my ($self, $align) = @_;

  if ($align) {
    if ($self->_check_value('_prompt_align', $align)) {
      $self->{_prompt_align} = uc $align;
    }
    else {
      carp "prompt_align must be LEFT, RIGHT or CENTER";
    }
  }
  return $self->{_prompt_align};
}

sub prompt_fill {
  my ($self, $fill) = @_;

  if (defined $fill) {
    if ($self->_check_value('_prompt_fill', $fill)) {
      if ($fill =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_prompt_fill} = 1;
      }
      else {
        $self->{_prompt_fill} = 0;
      }
    }
    else {
      carp "prompt_fill must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_prompt_fill};
}

sub prompt_frame {
  my ($self, $frame) = @_;

  if (defined $frame) {
    if ($self->_check_value('_prompt_frame', $frame)) {
      if ($frame =~ /^(?:\+|1|YES|Y|TRUE|T)$/i) {
        $self->{_prompt_frame} = 1;
      }
      else {
        $self->{_prompt_frame} = 0;
      }
    }
    else {
      carp "prompt_frame must be -, +, 0, 1, NO, N, YES, Y, FALSE, F, TRUE or T";
    }
  }
  return $self->{_prompt_frame};
}

sub prompt_frame_style {
  my ($self, $styles) = @_;

  if ($styles) {
    if (ref $styles eq 'ARRAY') {
      if ($self->_check_value('_prompt_frame_style', $styles)) {
        foreach my $style (@{$styles}) {
          $style = uc $style;
        }
        $self->{_prompt_frame_style} = $styles;
      }
      else {
        carp "prompt_frame_style must be BLINK, REVERSE, BOLD and/or CLEAR";
      }
    }
    else {
      carp "prompt_frame_style must be given as a reference to an array";
    }
  }
  return wantarray ? @{$self->{_prompt_frame_style}} : $self->{_prompt_frame_style};
}

sub prompt_frame_fgcolor {
  my ($self, $fgcolor) = @_;

  if ($fgcolor) {
    if ($self->_check_value('_prompt_frame_fgcolor', $fgcolor)) {
      $self->{_prompt_frame_fgcolor} = uc $fgcolor;
    }
    else {
      carp "prompt_frame_fgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_prompt_frame_fgcolor};
}

sub prompt_frame_bgcolor {
  my ($self, $bgcolor) = @_;

  if ($bgcolor) {
    if ($self->_check_value('_prompt_frame_bgcolor', $bgcolor)) {
      $self->{_prompt_frame_bgcolor} = uc $bgcolor;
    }
    else {
      carp "prompt_frame_bgcolor must be BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN or WHITE";
    }
  }
  return $self->{_prompt_frame_bgcolor};
}

#===============================================================================
#Methods
#===============================================================================

sub read_key {
  my $self = shift;

  my $key = undef;
  ReadMode(4);
  my $char = ReadKey(0);
  if ($char eq "\e") {
    #Escape sequences
    $char = ReadKey(0);
    if ($char eq "[") {
      $char = ReadKey(0);
      if ($char =~ /[ABCDFH]/) {
        #VT100 specific sequences
        $key = $self->_get_keyname("\e[" . $char);
      }
      elsif ($char eq "[") {
        $char = ReadKey(0);
        if ($char =~ /[ABCDE]/) {
          #Linux console specific sequences
          $key = $self->_get_keyname("\e[[" . $char);
        }
      }
      elsif ($char =~ /^\d$/) {
        my $num = $char;
        $char = ReadKey(0);
        while ($char ne '~') {
          $num = $num * 10 + $char;
          $char = ReadKey(0);
        }
        #VT100 and Linux console sequences
        $key = $self->_get_keyname("\e[" . $num . "~");
      }
    }
    elsif ($char eq "O") {
      $char = ReadKey(0);
      if ($char =~ /[ABCDFHPQRS]/) {
        #Xterm specific sequences
        $key = $self->_get_keyname("\eO" . $char);
      }
    }
    elsif ($char =~ /[a-z]/) {
      #Meta a-z
      $key = $self->_get_keyname("\e" . $char);
    }
  }
  elsif ($self->_get_keyname($char)) {
    #Keys with special names, including CTRL a-z
    $key = $self->_get_keyname($char);
  }
  elsif ($char =~ /^[[:graph:]]$/) {
    #Plain keys
    $key = $char;
  }
  ReadMode(0);
  return $key;
}

sub up {
  my ($self, $n) = @_;

  $n = 0 unless defined $n;
  if ($n =~ /^\d+$/) {
    print "\x1B[" . $n . "A";
    return 1;
  }
  return 0;
}

sub down {
  my ($self, $n) = @_;

  $n = 0 unless defined $n;
  if ($n =~ /^\d+$/) {
    print "\x1B[" . $n . "B";
    return 1;
  }
  return 0;
}

sub right {
  my ($self, $n) = @_;

  $n = 0 unless defined $n;
  if ($n =~ /^\d+$/) {
    print "\x1B[" . $n . "C";
    return 1;
  }
  return 0;
}

sub left {
  my ($self, $n) = @_;

  $n = 0 unless defined $n;
  if ($n =~ /^\d+$/) {
    print "\x1B[" . $n . "D";
    return 1;
  }
  return 0;
}

sub region {
  my ($self, $t, $b) = @_;

  $t = 1 unless defined $t and $t <= $self->height();
  $b = $self->height() unless defined $b and $b <= $self->height();
  if ($b >= $t) {
    print "\x1B[" . $t . ";" . $b . "r";
    return 1;
  }
  return 0;
}

sub pos {
  my ($self, $l, $c) = @_;

  $l = 1 unless defined $l and $l > 0 and $l <= $self->height();
  $c = 1 unless defined $c and $c > 0 and $c <= $self->width();
  if ($l =~ /^\d+$/ and $c =~ /^\d+$/) {
    print "\x1B[" . $l . ";" . $c ."H";
    return 1;
  }
  return 0;
}

sub print_title {
  my $self = shift;

  my $width = $self->width();
  my $title = $self->title();
  my $max_length = $width;
  $max_length -= 2 if $self->title_frame();
  my $padding = $max_length - length $title;
  $title = substr($title, 0, $max_length) if length($title) > $max_length;
  if ($self->title_fill()) {
    if ($self->title_align() eq 'CENTER') {
      my $lpadding = int ($padding / 2);
      my $rpadding = $padding - $lpadding;
      $title = " " x $lpadding . $title . " " x $rpadding;
    }
    elsif ($self->title_align() eq 'RIGHT') {
      $title = " " x $padding . $title;
    }
    else {
      $title .= " " x $padding;
    }
  }
  $self->pos(1,1);
  if ($self->title_frame()) {
    print RESET;
    $self->_print_color($self->title_frame_fgcolor(), $self->title_frame_bgcolor());
    $self->_print_style($self->title_frame_style());
    print ULC;
    print HOR x length $title;
    print URC;
    print "\n";
    print VER;
  }
  print RESET;
  $self->_print_color($self->title_fgcolor(), $self->title_bgcolor());
  $self->_print_style($self->title_style());
  print $title;
  if ($self->title_frame()) {
    print RESET;
    $self->_print_color($self->title_frame_fgcolor(), $self->title_frame_bgcolor());
    $self->_print_style($self->title_frame_style());
    print VER;
    print "\n";
    print LLC;
    print HOR x length $title;
    print LRC;
  }
  print RESET;
  print "\n";
}

sub print_items {
  my ($self, $selected) = @_;

  if (defined $selected) {
    $self->selection($selected) if $self->_check_value('_selection', $selected);
  }
  my $width = $self->width();
  my $max_length = $width;
  if ($self->item_frame()) {
    $max_length -= 3;
  }
  elsif ($self->delimiter()) {
    $max_length--;
  }
  my $key_length = 0;
  my $desc_length = 0;
  foreach my $item (@{$self->items()}) {
    $key_length = length($item->[0]) if length($item->[0]) > $key_length;
    $desc_length = length($item->[1]) if length($item->[1]) > $desc_length;
  }
  $key_length += $self->_linestr_length($self->shortcut_prefix());
  $key_length += $self->_linestr_length($self->shortcut_postfix());
  my $label_length = $desc_length;
  $label_length += $self->_linestr_length($self->label_prefix());
  $label_length += $self->_linestr_length($self->label_postfix());
  if ($key_length + $label_length > $max_length or $self->item_fill()) {
    $label_length = $max_length - $key_length;
    $desc_length = $label_length - $self->_linestr_length($self->shortcut_prefix());
    $desc_length = $desc_length - $self->_linestr_length($self->shortcut_postfix());
  }
  my $last_item = $self->item_count() - 1;
  my $highlight = 0;
  $highlight++ if $self->selection() > 0 and $self->selection() <= $last_item + 1;
  my $i = 0;
  $self->pos($self->_items_start(),1);
  foreach my $item (@{$self->items()}) {
    if ($i == 0) {
      if ($self->item_frame()) {
        print RESET;
        $self->_print_color($self->item_frame_fgcolor(), $self->item_frame_bgcolor());
        $self->_print_style($self->item_frame_style());
        print ULC;
        print HOR x $key_length;
        print TTE;
        print HOR x $label_length;
        print URC;
        print "\n";
      }
      elsif ($self->leader()) {
        print RESET;
        $self->_print_color($self->item_fgcolor(), $self->item_bgcolor());
        $self->_print_style($self->item_style());
        print ULC;
        print HOR x ($key_length - 1);
        $self->_print_linestr($self->leader_delimiter()) if $self->delimiter();
        print HOR x ($label_length - 1);
        print URC;
        print "\n";
      }
    }
    if ($self->item_frame()) {
      print RESET;
      $self->_print_color($self->item_frame_fgcolor(), $self->item_frame_bgcolor());
      $self->_print_style($self->item_frame_style());
      print VER;
    }
    print RESET;
    if ($highlight and $i == $self->selection() - 1) {
      $self->_print_color($self->selection_fgcolor(), $self->selection_bgcolor());
      $self->_print_style($self->selection_style());
    }
    else {
      $self->_print_color($self->item_fgcolor(), $self->item_bgcolor());
      $self->_print_style($self->item_style());
    }
    $self->_print_linestr($self->shortcut_prefix()) if $self->shortcut_prefix();
    print $item->[0];
    if (length($item->[0]) < $key_length) {
      print ' ' x ($key_length - length($item->[0]));
    }
    $self->_print_linestr($self->shortcut_postfix()) if $self->shortcut_postfix();
    if ($self->item_frame()) {
      print RESET;
      $self->_print_color($self->item_frame_fgcolor(), $self->item_frame_bgcolor());
      $self->_print_style($self->item_frame_style());
      if ($self->spacious_items()) {
        print VER;
      }
      else {
        if ($self->delimiter()) {
          $self->_print_linestr($self->delimiter());
        }
        else {
          print VER;
        }
      }
    }
    elsif ($self->delimiter()) {
      $self->_print_linestr($self->delimiter());
    }
    print RESET;
    if ($highlight and $i == $self->selection() - 1) {
      $self->_print_color($self->selection_fgcolor(), $self->selection_bgcolor());
      $self->_print_style($self->selection_style());
    }
    else {
      $self->_print_color($self->item_fgcolor(), $self->item_bgcolor());
      $self->_print_style($self->item_style());
    }
    if ($self->label_prefix()) {
      $self->_print_linestr($self->label_prefix());
    }
    my $desc = '';
    if (length($item->[1]) > $desc_length) {
      $desc = substr($item->[1], 0, $desc_length);
    }
    elsif (length($item->[1]) < $desc_length) {
      if ($self->item_fill()) {
        if ($self->item_align() eq 'CENTER') {
          my $lpad = int (($desc_length - length($item->[1])) / 2);
          my $rpad = $desc_length - length($item->[1]) - $lpad;
          $desc = ' ' x $lpad . $item->[1] . ' ' x $rpad;
        }
        elsif ($self->item_align() eq 'RIGHT') {
          $desc = ' ' x ($desc_length - length($item->[1])) . $item->[1];
        }
        else {
          $desc = $item->[1] . ' ' x ($desc_length - length($item->[1]));
        }
      }
      else {
        $desc = $item->[1];
      }
    }
    else {
      $desc = $item->[1];
    }
    print $desc;
    if ($self->label_postfix()) {
      $self->_print_linestr($self->label_postfix());
    }
    if ($self->item_frame()) {
      print RESET;
      $self->_print_color($self->item_frame_fgcolor(), $self->item_frame_bgcolor());
      $self->_print_style($self->item_frame_style());
      print VER;
    }
    print "\n";
    if ($i < $last_item and $self->spacious_items()) {
      if ($self->item_frame()) {
        print LTE;
        print HOR x $key_length;
        print CTE;
        print HOR x $label_length;
        print RTE;
        print "\n";
      }
    }
    if ($i == $last_item) {
      if ($self->item_frame()) {
        print RESET;
        $self->_print_color($self->item_frame_fgcolor(), $self->item_frame_bgcolor());
        $self->_print_style($self->item_frame_style());
        print LLC;
        print HOR x $key_length;
        print BTE;
        print HOR x $label_length;
        print LRC;
        print "\n";
      }
      elsif ($self->trailer()) {
        print RESET;
        $self->_print_color($self->item_fgcolor(), $self->item_bgcolor());
        $self->_print_style($self->item_style());
        print LLC;
        print HOR x ($key_length - 1);
        $self->_print_linestr($self->trailer_delimiter()) if $self->delimiter();
        print HOR x ($label_length - 1);
        print LRC;
        print "\n";
      }
    }
    $i++;
  }
  print RESET;
}

sub print_status {
  my ($self, $text) = @_;

  my $width = $self->width();
  my $status;
  if (defined $text and length $text > 0) {
    $status = $text;
  }
  else {
    $status = $self->status();
  }
  my $max_length = $width;
  $max_length -= 2 if $self->status_frame();
  my $padding = $max_length - length $status;
  $status = substr($status, 0, $max_length) if length($status) > $max_length;
  if ($self->status_fill()) {
    if ($self->status_align() eq 'CENTER') {
      my $lpadding = int ($padding / 2);
      my $rpadding = $padding - $lpadding;
      $status = " " x $lpadding . $status . " " x $rpadding;
    }
    elsif ($self->status_align() eq 'RIGHT') {
      $status = " " x $padding . $status;
    }
    else {
      $status .= " " x $padding;
    }
  }
  $self->pos($self->_status_start(),1);
  if ($self->status_frame()) {
    print RESET;
    $self->_print_color($self->status_frame_fgcolor(), $self->status_frame_bgcolor());
    $self->_print_style($self->status_frame_style());
    print ULC;
    print HOR x length $status;
    print URC;
    print "\n";
    print VER;
  }
  print RESET;
  $self->_print_color($self->status_fgcolor(), $self->status_bgcolor());
  $self->_print_style($self->status_style());
  print $status;
  if ($self->status_frame()) {
    print RESET;
    $self->_print_color($self->status_frame_fgcolor(), $self->status_frame_bgcolor());
    $self->_print_style($self->status_frame_style());
    print VER;
    print "\n";
    print LLC;
    print HOR x length $status;
    print LRC;
  }
  print RESET;
  print "\n";
}

sub print_prompt {
  my $self = shift;

  my $width = $self->width();
  my $max_length = $width - 1; #Allocate space for cursor
  $max_length -= 2 if $self->prompt_frame();
  my $padding = $max_length - length $self->prompt();
  $padding = 0 if $padding < 0;
  my $lpadding = 0;
  my $rpadding = 0;
  my $prompt = $self->prompt();
  $prompt = substr($self->prompt(), 0, $max_length) if length($self->prompt()) > $max_length;
  if ($self->prompt_fill()) {
    if ($self->prompt_align() eq 'CENTER') {
      $lpadding = int ($padding / 2);
      $rpadding = $padding - $lpadding;
    }
  }
  $self->pos($self->_prompt_start(),1);
  if ($self->prompt_frame()) {
    print RESET;
    $self->_print_color($self->prompt_frame_fgcolor(), $self->prompt_frame_bgcolor());
    $self->_print_style($self->prompt_frame_style());
    print ULC;
    print HOR x (length($prompt) + 1);
    if ($self->prompt_fill()) {
      print HOR x $padding;
    }
    print URC;
    print "\n";
    print VER;
  }
  print RESET;
  $self->_print_color($self->prompt_fgcolor(), $self->prompt_bgcolor());
  $self->_print_style($self->prompt_style());
  if ($self->prompt_fill()) {
    if ($self->prompt_align() eq 'CENTER') {
      print ' ' x $lpadding;
      print $prompt, ' ';
      print ' ' x $rpadding;
    }
    elsif ($self->prompt_align() eq 'RIGHT') {
      print ' ' x $padding;
      print $prompt, ' ';
    }
    else {
      print $prompt, ' ';
      print ' ' x $padding;
    }
  }
  else {
    print $prompt, ' ';
  }
  if ($self->prompt_frame()) {
    print RESET;
    $self->_print_color($self->prompt_frame_fgcolor(), $self->prompt_frame_bgcolor());
    $self->_print_style($self->prompt_frame_style());
    print VER;
    print "\n";
    print LLC;
    print HOR x (length($prompt) + 1);
    if ($self->prompt_fill()) {
      print HOR x $padding;
    }
    print LRC;
  }
  print RESET;
  print "\n";
  $self->print_cursor();
}

#Position the cursor and print cursor_char
sub print_cursor {
  my $self = shift;

  my ($l, $c) = $self->_cursor_pos();
  $self->pos($l, $c);
  if ($self->cursor() and $self->prompt()) {
    print $self->cursor_char();
    $self->left(1);
    $self->cursor_on();
  }
  else {
    $self->cursor_off();
  }
}

#Turn off the cursor
sub cursor_off {
  my $self = shift;

  print CURSOR_OFF;
}

#Turn on the cursor
sub cursor_on {
  my $self = shift;

  print CURSOR_ON;
}

#Clear the screen
sub clearscreen {
  my $self = shift;

  $self->pos(1,1);
  print CLS;
}

#Is argument a UP key?
sub is_up_key {
  my ($self, $key) = @_;
  foreach my $up_key ($self->up_keys()) {
    return 1 if $key eq $up_key;
  }
  return 0;
}

#Is argument a DOWN key?
sub is_down_key {
  my ($self, $key) = @_;
  foreach my $down_key ($self->down_keys()) {
    return 1 if $key eq $down_key;
  }
  return 0;
}

#Is argument a HELP key?
sub is_help_key {
  my ($self, $key) = @_;
  foreach my $help_key ($self->help_keys()) {
    return 1 if $key eq $help_key;
  }
  return 0;
}

#Is argument a DOWN key?
sub is_exit_key {
  my ($self, $key) = @_;
  foreach my $exit_key ($self->exit_keys()) {
    return 1 if $key eq $exit_key;
  }
  return 0;
}

#Is argument a SELECTION key?
sub is_selection_key {
  my ($self, $key) = @_;
  foreach my $selection_key ($self->selection_keys()) {
    return 1 if $key eq $selection_key;
  }
  return 0;
}

#Is argument a shortcut key and if so which item does it refer to?
sub is_shortcut {
  my ($self, $key) = @_;

  my @items = @{$self->items()};
  for (my $i = 1; $i <= $self->item_count(); $i++) {
    return $i if $key eq $items[$i - 1]->[0];
  }
  return 0;
}

#Get a list of all shortcuts that directly select an item
sub shortcuts {
  my $self = shift;

  my @shortcuts = ();
  foreach my $item (@{$self->items()}) {
    push @shortcuts, $item->[0];
  }
  return wantarray ? @shortcuts : \@shortcuts;
}

#Get the number of items
sub item_count {
  my $self = shift;

  return scalar(@{$self->items()});
}

#Move selection
sub move_selection {
  my ($self, $offset) = @_;

  my $new_sel = 0;
  if (defined $offset and $offset =~ /^[+-]?\d+/) {
    if (abs($offset) > $self->item_count()) {
      $offset = $offset % $self->item_count();
    }
    $new_sel = $self->selection() + $offset;
    if ($new_sel > $self->item_count()) {
      $new_sel = $self->selection_wrap() ? $new_sel - $self->item_count() : $self->item_count();
    }
    elsif ($new_sel == 0) {
      $new_sel = $self->selection_wrap() ? $self->item_count() : 1;
    }
    elsif ($new_sel < 0) {
      $new_sel = $self->selection_wrap() ? $self->item_count() + $new_sel + 1 : 1;
    }
  }
  $self->selection($new_sel);
  $self->print_items();
  my @help = $self->help();
  if (defined $help[$new_sel]->[0] and length($help[$new_sel]->[0]) > 0) {
    $self->_update_hint($help[$new_sel]->[0]);
  }
  else {
    $self->update_status();
  }
  $self->print_cursor();
}

#Return code reference associated with a shortcut
sub get_code_ref {
  my ($self, $shortcut) = @_;

  foreach my $item (@{$self->items()}) {
    return $item->[2] if $item->[0] eq $shortcut;
  }
  return undef;
}

#Perform action associated with a key
#Return 0 for noop, 1 for success and undef for exit
sub do_key {
  my ($self, $key, @args) = @_;

  return 0 unless defined $key;
  if ($self->is_exit_key($key)) {
    return undef;
  }
  if ($self->is_up_key($key)) {
    $self->move_selection(-1);
    return 1;
  }
  if ($self->is_down_key($key)) {
    $self->move_selection(1);
    return 1;
  }
  if ($self->is_selection_key($key) and $self->selection() > 0) {
    if (defined $self->items()->[$self->selection() - 1]->[2]) {
      $self->do_item($self->items()->[$self->selection() - 1]->[2], $self->selection());
    }
    return 1;
  }
  if ($self->is_help_key($key)) {
    my @help = $self->help();
    if ($self->help()->[$self->selection()]) {
      $self->do_help($self->help()->[$self->selection()], $self->selection());
    }
    elsif ($help[0]) {
      $self->do_help($self->help()->[0], $self->selection());
    }
    return 1;
  }
  if (my $sel = $self->is_shortcut($key)) {
    $self->print_items($self->selection($sel));
    if (defined $self->items()->[$sel - 1]->[2]) {
      $self->do_item($self->items()->[$sel - 1]->[2], $sel);
    }
    if (defined $self->help()->[$sel]->[0] and length($self->help()->[$sel]->[0]) > 0) {
      $self->_update_hint($self->help()->[$sel]->[0]);
    }
    else {
      $self->update_status();
      $self->print_cursor();
    }
    return 1;
  }
  return 0;
}

sub do_item {
  my ($self, $code_ref, @args) = @_;

  $self->clearscreen();
  $code_ref->(@args);
  $self->print_menu();
}

sub do_help {
  my ($self, $ref, @args) = @_;

  if (defined $ref->[1]) {
    $self->clearscreen();
    $ref->[1]->(@args);
    $self->print_menu();
  }
  elsif (defined $ref->[0] and length($ref->[0]) > 0) {
    $self->_update_hint($ref->[0]);
  }
}

sub print_menu {
  my $self = shift;

  $self->clearscreen();
  if (length $self->title() > 0) {
    $self->print_title();
    print "\n" if $self->space_after_title();
  }
  if ($self->item_count() > 0) {
    $self->print_items();
    print "\n" if $self->space_after_items();
  }
  if (length $self->status() > 0) {
    $self->print_status();
    print "\n" if $self->space_after_status();
  }
  if (length $self->prompt() > 0) {
    $self->print_prompt();
  }
  else {
    $self->print_cursor()
  }
}

sub update_status {
  my ($self, $status) = @_;

  if (defined $status and $self->_check_value('_status', $status)) {
    $self->status($status);
  }
  $self->_clear_after_items();
  $self->print_status() if $self->status();
  $self->print_prompt() if $self->prompt();
  $self->print_cursor();
}

sub update_prompt {
  my ($self, $prompt) = @_;

  if (defined $prompt and $self->_check_value('_prompt', $prompt)) {
    $self->prompt($prompt);
  }
  $self->_clear_after_items();
  $self->print_status() if $self->status();
  $self->print_prompt() if $self->prompt();
  $self->print_cursor();
}

sub line_after_menu {
  my $self = shift;

  my $line = $self->_status_start();
  if (length($self->status()) > 0) {
    $line++;
    $line += 2 if $self->status_frame();
    $line++ if $self->space_after_status();
  }
  if (length($self->prompt()) > 0) {
    $line++;
    $line += 2 if $self->prompt_frame();
  }
  return $line;
}

#===============================================================================
#Make sure this modules ends with a true value
#===============================================================================

"That's all folks!";

__END__