Cmenu
view release on metacpan or search on metacpan
#**********
# MENU_INITIALISE
#
# Function: Setups Curses elements and prepares a backdrop
# Also define terminal atributes and defines default colours
# (these can be changed after this function has been called)
#
# Call format: &menu_initialise("title string","advice note string");
#
# Arguments: - the title of the Menu application
# this is displayed in the top left-hand corner of all screens
# - an advice note to be displayed on all pages
# normally displayed at the foot of each screen
# may be replaced by user comments with &menu_advice routine
#
# Returns: Main window - this can be referenced externally for
# direct drawing by user program (untested)
#**********
sub menu_initialise {
my ($title,$advice)=@_;
my ($key,$action);
$menu_title=$title;
$menu_advice=$advice;
# Only do this once
if($did_initterm==0) {
# ##################################################################################
# BLOCK 1
# =======
# Initialise curses structures
# ##################################################################################
if(!$menu_screen) { # Checks whether user has done this already
$menu_screen=&initscr(); # create a curses structure
} # auto save tty settings to be restore at end by endwin
$menu_hascolor=eval {has_colors()};
start_color();
# ##################################################################################
# BLOCK 2
# =======
# Setup key sequences for input filtering
# These are the defaults - may be over-ridden by loaded preferences
# ##################################################################################
# ##################################################################################
# Unable to test the alternative getcap/tigetstr/tput settings so these are
# left alone. tigetstr continues to not work on Linux/Curses
# --------------------------------------------------------------------------------
# Functional mappings are
# Cursor movement
# UP : move up
# DOWN : move down
# RITE : move right
# LEFT : move left
# LYNXR : move right - can mimic lynx-style motion
# LYNXL : move left - can mimic lynx-style motion
# Large cursor movement
# HOME : go to top (of menu)
# END : go to bottom (of menu)
# NEXT : next page
# PREV : previous page
# JUMP : leap to a specific menu item
# action
# HELP : display active help page/info
# RET : action current selection
# EXIT : cancel or abort current operation
# QUIT : go back a menu
# SPACE : toggle radio button or action button (equiv to RET)
# REFS : refresh the screen
# button or field navigation
# TAB : next field
# BACK : previous field
# text buffer editing
# DEL : delete chracter right
# BS : delete character left
# INS : toggle insert mode
# KILL : kill current line to buffer
# YANK : yank buffer
# BUFF : empty the text buffer
# Specials
# KEY_RESIZE : } trap screen resizing } these are input from Curses
# 401 : } " " " } not by the user
# NOP : do nothing
# --------------------------------------------------------------------------------
# ==================================================================================
# Next blocks are system specific - choose the one(s) you need
# ==================================================================================
# Method 1 (getcap) - UNTESTED
# Uncomment if you have "getcap"
# --------------------------------------------------------------------------------
# $kseq{&getcap('ku')}="UP"; # Cursor-up
# $kseq{&getcap('kd')}="DOWN"; # Cursor-down
# $kseq{&getcap('kr')}="RITE"; # Cursor-right
# $kseq{&getcap('kl')}="LEFT"; # Cursor-left
# $kseq{&getcap('cr')}="RET"; # Carriage-return
# $kseq{&getcap('nl')}="RET"; # New-line
# --------------------------------------------------------------------------------
# Method 2 (tigetstr) - UNTESTED
# Uncomment if you have tigetstr (Solaris) instead of "getcap"
# --------------------------------------------------------------------------------
# $kseq{&tigetstr('kcuu1')}="UP"; # Cursor-up
# $kseq{&tigetstr('dcud1')}="DOWN"; # Cursor-down
# $kseq{&tigetstr('kcuf1')}="RITE"; # Cursor-right
# $kseq{&tigetstr('kcub1')}="LEFT"; # Cursor-left
# $kseq{&tigetstr('cr')}="RET"; # Carriage-return
# $kseq{&tigetstr('nl')}="RET"; # New-line
# --------------------------------------------------------------------------------
# Method 3 (tput)
# Uncomment if you have terminfo (and tput) instead of "getcap"
# Works for modern Linux
# --------------------------------------------------------------------------------
$kseq{`tput kcuu1`}="UP"; # Cursor-up
$kseq{`tput kcud1`}="DOWN"; # Cursor-down
$kseq{`tput kcuf1`}="RITE"; # Cursor-right
$kseq{`tput kcub1`}="LEFT"; # Cursor-left
$kseq{`tput kent`}="RET"; # Carriage-return
# HP-UX 9.05 users: try $kseq[4] = `tput cr` if
# "tput kent" gives errors
$kseq{ `tput nel`}="RET"; # New-line
# --------------------------------------------------------------------------------
# Method 4
# Explicit control sequences - should work for all terminals regardless
# These should be Uncommented for all systems/platforms
# Hacks for Xterms and standard emacs style definitions
# --< Xterm hacks >---------------------------------------------------------------
$kseq{"\033[A"}="UP"; # Ansi cursor-up (for DEC xterm)
$kseq{"\033[B"}="DOWN"; # Ansi cursor-down (for DEC xterm)
$kseq{"\033[C"}="RITE"; # Ansi cursor-right (for DEC xterm)
$kseq{"\033[D"}="LEFT"; # Ansi cursor-left (for DEC xterm)
# added mapping for Home/End and Page buttons for xterms
$kseq{"\033[E"}="PREV"; # Ansi guess (for DEC xterm)
$kseq{"\033[F"}="END"; # Ansi end key (for DEC xterm)
$kseq{"\033[G"}="NEXT"; # Ansi guess (for DEC xterm)
$kseq{"\033[H"}="HOME"; # Ansi home key (for DEC xterm)
# --< kvt specials >---------------------------------------------------------------
# -- KDE2 and its terminal kvt do funny things with the keys
# -- keymaps may be lost entirely with the key bindings
$kseq{scalar(KEY_SELECT)}="END"; # end key (for kvt)
$kseq{scalar(KEY_FIND)}="HOME"; # home key (for kvt)
# --< Emacs hacks >---------------------------------------------------------------
$kseq{"\cA"}="HOME"; # begin of line
$kseq{"\cE"}="END"; # end of line
$kseq{"\cF"}="RITE"; # next char
$kseq{"\cB"}="LEFT"; # prev char
$kseq{"\cN"}="TAB"; # next field
$kseq{"\cP"}="BACK"; # prev field
$kseq{"\cL"}="REFS"; # redraw screen
$kseq{"\cD"}="DEL"; # delete right
$kseq{"\cK"}="KILL"; # kill line
# Normally yank_line would be "\cY" (C-y), unfortunately both C-z and C-y are
# are used to send the suspend signal in our environment. Bind it to
# C-v for a lack of anything better.
$kseq{"\cV"}="YANK"; # yank/paste buffer
# buffer
$kseq{"\cX"}="BUFF"; # copy and kill to buffer
# --------------------------------------------------------------------------------
# Method 5
# Standard PC keyboard commands
# with ncurses keypad turned on - these should work for any terminal type
# either termcap or terminfo
# --------------------------------------------------------------------------------
$kseq{scalar(KEY_HOME)}="HOME"; # home
$kseq{scalar(KEY_END)}="END"; # end
$kseq{scalar(KEY_PPAGE)}="PREV"; # page up
$kseq{scalar(KEY_NPAGE)}="NEXT"; # page down
$kseq{scalar(KEY_IC)}="INS"; # insert toggle
$kseq{scalar(KEY_DC)}="DEL"; # delete
$kseq{scalar(KEY_BACKSPACE)}="BS"; # backspace
$kseq{"\cI"}="TAB"; # tab
$kseq{scalar(KEY_BTAB)}="BTAB"; # shifted tab
$kseq{scalar(KEY_UP)}="UP"; # up arrow
$kseq{scalar(KEY_DOWN)}="DOWN"; # down arrow
$kseq{scalar(KEY_LEFT)}="LYNXL"; # left arrow
$kseq{scalar(KEY_RIGHT)}="LYNXR"; # right arrow
$kseq{scalar(KEY_ENTER)}="RET"; # enter key
$kseq{scalar(KEY_BREAK)}="EXIT"; # break
$kseq{"\cJ"}="RET"; # normal return key
# Functions keys have no special meaning - user mapable
# some helpful defaults are set here but are not necessary
$kseq{scalar(KEY_F(1))}="HELP"; # Func key 1
$kseq{scalar(KEY_F(2))}="NOP"; # Func key 2
$kseq{scalar(KEY_F(3))}="NOP"; # Func key 3
$kseq{scalar(KEY_F(4))}="NOP"; # Func key 4
$kseq{scalar(KEY_F(5))}="NOP"; # Func key 5
$kseq{scalar(KEY_F(6))}="NOP"; # Func key 6
$kseq{scalar(KEY_F(7))}="NOP"; # Func key 7
$kseq{scalar(KEY_F(8))}="QUIT"; # Func key 8
# and a small advice note at the foot (centred)
&bkgd($menu_screen,$menu_attributes{"backdrop"});
&clear($menu_screen);
if(length($menu_title)<1) {
&addstr($menu_screen,0,1,"Cmenu Menu");
} else {
&addstr($menu_screen,0,1,$menu_title);
}
&move($menu_screen,1,1);
&hline($menu_screen,ACS_HLINE,$menu_screen_cols-2);
# Display system advice message
&attrset($menu_screen,$menu_attributes{"advice"});
&move($menu_screen,$menu_screen_lines-1,0);
if(length($menu_advice)>0) {
&addstr($menu_screen,$menu_screen_lines-1,($menu_screen_cols-length($menu_advice))/2,$menu_advice);
}
if($menu_hascolor) {
# Draw basic Window inlay with shadow (colour only)
attrset($menu_screen,$menu_attributes{"shadow"});
move($menu_screen,$menu_inlay_y+1,$menu_screen_cols-$menu_inlay_x);
vline($menu_screen," ",$menu_screen_lines-($menu_inlay_y*2));
move($menu_screen,$menu_inlay_y+1,$menu_screen_cols-$menu_inlay_x+1);
vline($menu_screen," ",$menu_screen_lines-($menu_inlay_y*2));
move($menu_screen,$menu_screen_lines-$menu_inlay_y,$menu_inlay_x+2);
hline($menu_screen," ",$menu_screen_cols-($menu_inlay_x*2)-2);
}
# Create Window insert
$menu_inlay=newwin($menu_screen_lines-($menu_inlay_y*2),$menu_screen_cols-($menu_inlay_x*2),$menu_inlay_y,$menu_inlay_x);
bkgd($menu_inlay,$menu_attributes{"text"});
&clear($menu_inlay);
noutrefresh($menu_screen);
# Sets bounds for Window inlay
$menu_inlay_lines=$menu_screen_lines-($menu_inlay_y*2);
$menu_inlay_cols=$menu_screen_cols-($menu_inlay_x*2);
}
#**********
# MENU_TERMINATE
#
# Function: Closedown all Curses structures and quit
#
# Call format: &menu_terminate("Message text");
#
# Arguments: - Text message to be left on the screen when program finishes
# This is not a Curses string, just a simple Perl echo
#
# Returns: Peace and Happiness for all ManKind
#**********
sub menu_terminate {
my ($message)=@_;
my($key);
&delwin($menu_inlay);
&standend();
&clear();
&refresh(); # clears the screen
&curs_set(1); # turn the cursor back on
&endwin(); # closes all structures and auto restores tty
print "$message\r\n";
exit();
}
# ##################################################################################
# Menu Processing and Navigation
# ##################################################################################
#**********
# MENU_INIT
#
# Function: Initialize a new menu structure: menu arrays, title, and "top" flags.
#
# Call format: &menu_init("Top Title","Sub Titles","HelpFile");
#
# Arguments: - "Top Title" is the title of the menu displayed centred in
# the window inlay
# - "Sub Title" is text comments provided to describe the menu or
# give clues to its usage; user provided.
# Normally centred unless greater than the width of the window
# - "HelpFile" defines a help file to be displayed when the
# help key is pressed. Help files can be associated with individual
# menu items so this file is used when an item has no help file
# See menu_help for more information on these help facilities
#
# Returns: Window value from "initscr" call.
#
#**********
sub menu_init {
my ($top_title,$sub_title,$help_page) = @_;
my ($i,$justify);
$menu_top_title=$top_title;
$menu_sub_title=$sub_title;
# Sort out undefined variables to their default
if(!$help_page) {
$menu_help="help.txt";
} else {
$menu_help=$help_page;
}
&menu_draw_inlay();
# $item_lines_per_screen = $last_line - $first_line + 1;
# Init menu items array
@menu_sel_text = (); # Selection text for each item
@menu_sel_label = (); # Action text/label for each item
@menu_sel_style = (); # Display style for menu item
@menu_sel_flag = (); # Data associated with menu item
@menu_sel_pos = (); # Position for data field
$menu_index = 0; # menu item counter
# Init some other key variables
$max_item_len = 0; # max length of menu item text
$max_sel_len = 0; # length of selection text/label
if($menu_buttons==0) {
# Display messages in button bar
&attrset($menu_inlay,$menu_attributes{"dull"});
&move($menu_inlay,$menu_inlay_lines-2,1);
&clrtoeol($menu_inlay);
move($menu_inlay,$menu_inlay_lines-2,$menu_inlay_cols-1);
vline($menu_inlay,ACS_VLINE, 1);
if(length($advice)>0) {
&addstr($menu_inlay,$menu_inlay_lines-2,($menu_inlay_cols-length($advice))/2,$advice);
} else {
&addstr($menu_inlay,$menu_inlay_lines-2,($menu_inlay_cols-length($menu_advice))/2,$menu_advice);
}
&noutrefresh($menu_inlay);
} else {
# display messages at foot of screen
&attrset($menu_screen,$menu_attributes{"advice"});
&move($menu_screen,$menu_screen_lines-1,1);
&clrtoeol($menu_screen);
if(length($advice) > 0 ) {
&addstr($menu_screen,$menu_screen_lines-1,($menu_screen_cols-length($advice))/2,$advice);
} else {
&addstr($menu_screen,$menu_screen_lines-1,($menu_screen_cols-length($menu_advice))/2,$menu_advice);
}
&noutrefresh($menu_screen);
}
}
#**********
# MENU_NAVIGATE
#
# Function: Allows user to navigate the current menu until an items is selected
# or the menu is exited
#
# Call format: &menu_navigate();
#
# Returns: selected menu item at exit point
# %UP% -- quit menu
# %EMPTY% -- abort menu
#
# Notes: 1) This routine ALWAYS sets "nocbreak" and "echo" terminal
# modes before returning.
# 2) This routine exits directly (after calling the optional
# "quit" routine) if "q"|"Q" is pressed.
# 3) performs all menu functions including field editing
# returning any data as a tokenised string
#**********
sub menu_navigate {
my ($help,$i,$j,$style,$new_option,$action,$trunc,$indent);
my $ret="";
# Check for no "menu_item" calls.
if ($#menu_sel_text < 0) {
return("%EMPTY%".$menu_sep);
}
# curses cookery
cbreak(); # permits keystroke examination
noecho(); # no input echo until enabled explicitly
curs_set(0); # turn the cursor off
# reset and draw button bar
$menu_hot_button=1;
&menu_button_bar(0);
&menu_draw_window();
noutrefresh($menu_window);
# Compute prepend length (for stuff we prepend to each selection text)
# indent : indent to centre items
# item_pos : where item text starts
$menu_item_pos=$max_sel_len+1;
# Also trunc is number of characters to shorten text
# decide whether or not to truncate menu items
$trunc=($max_item_len+$menu_item_pos)-($menu_pane_cols-2);
if($trunc<=0) {
$menu_indent=($trunc*-1)/2;
$trunc=0;
} else {
$menu_indent=0;
}
if($trunc>=$max_item_len) {
# menu not wide enough to show anything so abort this menu
&menu_advice("Item descriptions too long - Aborting!");
&refresh();
getch($menu_screen);
$ret="%UP%".$menu_sep;
} else {
&menu_create_pane();
GET_KEY: do {
# Draw up and down symbols
# Skip the next next bit if everything fits on one page
if(($menu_pane_lines-3)<$menu_index-1) {
# Display page excess arrows
move($menu_window,0,$menu_pane_scroll);
if($menu_top_option>0) {
# there are items above this
attrset($menu_window,$menu_attributes{"scroll"});
addstr($menu_window, "-^-");
} else {
attrset($menu_window,$menu_attributes{"dull"});
hline($menu_window,ACS_HLINE,3);
}
move($menu_window,$menu_pane_lines-1,$menu_pane_scroll);
if($menu_index-1>$menu_top_option+$menu_pane_lines-3) {
# there are items below this
attrset($menu_window,$menu_attributes{"scroll"});
addstr($menu_window, "-v-");
} else {
attrset($menu_window,$menu_attributes{"edge"});
hline($menu_window,ACS_HLINE,3);
}
noutrefresh($menu_window);
}
doupdate();
# Collect key sequences until something we recoginize
# (or we know we don't care)
$action = &menu_key_seq($menu_pane);
# ------------------------------------------------------------------------------
# Switch construct for dealing with key sequence input
# ------------------------------------------------------------------------------
KEYWAIT: for ($action) {
# Set return value as current option
$ret=$menu_sel_return[$menu_cur_option].$menu_sep;
# General cursor movement
/LEFT/ && do { # Left arrow
# Treat this like an UP-Menu request
$action="UP";
# redo KEYWAIT;
};
/RITE/ && do { # Right arrow
# Treat this like a RETURN
$action="DOWN";
# redo KEYWAIT;
};
/LYNXL/ && do { # Left arrow
# Treat this like an UP-Menu request
$action="QUIT";
redo KEYWAIT;
};
/LYNXR/ && do { # Right arrow
# Treat this like a RETURN
$action="RET";
redo KEYWAIT;
};
/DOWN/ && do { # down arrow
if($menu_cur_option==$menu_index-1) {
# Hit the bottom
&menu_advice("You are on the last entry!");
} else {
do {
menu_draw_line($menu_cur_option,$menu_indent);
$menu_cur_option++;
if(($menu_cur_option-$menu_top_option)>$menu_pane_lines-3) {
&scrl($menu_pane,1);
$menu_top_option++;
}
} until ($menu_sel_style[$menu_cur_option]!=9);
&menu_draw_active($menu_cur_option,$menu_indent);
&noutrefresh($menu_pane);
&menu_advice("");
}
&doupdate();
last KEYWAIT;
};
/UP/ && do { # Up arrow
if($menu_cur_option==0) {
# Hit the bottom
&menu_advice("You are on the first entry!");
} else {
do {
menu_draw_line($menu_cur_option,$menu_indent);
$menu_cur_option--;
if(($menu_cur_option-$menu_top_option)<0) {
&scrl($menu_pane,-1);
$menu_top_option--;
}
redo if ($menu_sel_style[$menu_cur_option]==9);
&menu_draw_active($menu_cur_option,$menu_indent);
};
&noutrefresh($menu_pane);
&menu_advice("");
}
&doupdate();
last KEYWAIT;
};
# larger cursor motion
/PREV/ && do { # Page up
if($menu_top_option<=0) {
# Hit the bottom
menu_advice("There are no more options!");
} else {
$menu_cur_option=$menu_cur_option-($menu_pane_lines-3);
$menu_top_option=$menu_top_option-($menu_pane_lines-3);
&menu_draw_pane();
&menu_advice("");
}
&doupdate();
last KEYWAIT;
};
/NEXT/ && do { # Page down
if($menu_top_option>($menu_index-1-($menu_pane_lines-2))) {
# Hit the bottom
menu_advice("There are no more options!");
} else {
$menu_cur_option=$menu_cur_option+($menu_pane_lines-3);
$menu_top_option=$menu_top_option+($menu_pane_lines-3);
&menu_draw_pane();
&menu_advice("");
}
&doupdate();
last KEYWAIT;
};
/HOME/ && do { # Home
if($menu_top_option==0) {
# Check if the top item is already on the screen
if($menu_cur_option==0) {
# Already at the top
&menu_advice("You are already at the top");
} else {
menu_draw_line($menu_cur_option,$menu_indent);
$menu_cur_option=0;
&menu_draw_active($menu_cur_option,$menu_indent);
&noutrefresh($menu_pane);
&menu_advice("");
}
} else {
$menu_top_option=0;
$menu_cur_option=0;
&menu_draw_pane();
&menu_advice("");
}
&doupdate();
last KEYWAIT;
};
/END/ && do { # End
if($menu_cur_option==$menu_index-1) {
&menu_advice("You are already on the last option!");
} else {
if($menu_top_option+$menu_pane_lines-3>$menu_index-1) {
# the final option is already on screen
menu_draw_line($menu_cur_option,$menu_indent);
$menu_cur_option=$menu_index-1;
&menu_draw_active($menu_cur_option,$menu_indent);
&noutrefresh($menu_pane);
&menu_advice("");
} else {
&menu_draw_active($menu_cur_option,$menu_indent);
$action="NOP";
&doupdate();
last DO_STYLE;
};
/9/ && do {
# Failsafe: should not really get here
$action="NOP";
redo KEYWAIT;
};
$menu_sel_flag[$menu_cur_option]=1;
last DO_STYLE;
};
last KEYWAIT;
};
/ACCEPT/ && do { # Return (enter)
$action="STOP";
if($menu_sel_style[$menu_cur_option]!=3) {
if($menu_sel_style[$menu_cur_option]==6) {
# edit an alpha field
&menu_edit($menu_cur_option,$menu_indent);
$action="NOP";
&menu_draw_active($menu_cur_option,$menu_indent);
}
if($menu_sel_style[$menu_cur_option]==7) {
# edit a numeric field
&menu_edit($menu_cur_option,$menu_indent,1);
$action="NOP";
&menu_draw_active($menu_cur_option,$menu_indent);
}
}
last KEYWAIT;
};
/JUMP/ && do { # Jump to some option
menu_advice("$action not defined yet");
&doupdate();
last KEYWAIT;
};
/QUIT/ && do { # Return (enter)
$ret="%UP%".$menu_sep;
$action="STOP";
last KEYWAIT;
};
/EXIT/ && do { # Return (enter)
$ret="%EMPTY%".$menu_sep;
$action="STOP";
last KEYWAIT;
};
/HELP/ && do { # Return (enter)
if(-e $menu_help_root.$menu_help) {
$help="";
open(IN,"<".$menu_help_root.$menu_help);
while(<IN>) {
$help=$help.$_;
}
close(IN);
&menu_show("Help File ".$menu_help_root.$menu_help,$help,"HELP");
# these get switched off by menu_show so do this
cbreak(); # permits keystroke examination
noecho(); # no input echo until enabled explicitly
curs_set(0); # turn the cursor off
&menu_refresh();
} else {
beep();
&menu_advice("Help file ".$menu_help_root.$menu_help." not found");
&doupdate;
}
$action="NOP";
last KEYWAIT;
};
/REFS/ && do { # Refresh screen
&menu_noutrefresh();
&menu_advice("Refreshed Screen");
&doupdate();
last KEYWAIT;
};
# button navigation
/TAB/ && do { # Next field
&menu_button_bar("TAB");
&doupdate();
last KEYWAIT;
};
/BACK/ && do { # Previous field
&menu_button_bar("BACK");
&doupdate();
last KEYWAIT;
};
# Text editing - not relevant here
/DEL/ && do { # Delete right
menu_advice("$action not defined yet");
&doupdate();
last KEYWAIT;
};
/KILL/ && do { # Kill line
menu_advice("$action not defined yet");
&doupdate();
last KEYWAIT;
};
/YANK/ && do { # Yank buffer
menu_advice("$action not defined yet");
&doupdate();
last KEYWAIT;
};
/BUFF/ && do { # Kill buffer
menu_advice("$action not defined yet");
&doupdate();
last KEYWAIT;
};
/INS/ && do { # insert toggle
menu_advice("$action not defined yet");
&doupdate();
last KEYWAIT;
};
/BS/ && do { # Backspace
menu_advice("$action not defined yet");
&doupdate();
last KEYWAIT;
};
/NOP/ && do { # Jump to some option
# menu_advice("doing nothing");
last KEYWAIT;
};
# default: assume a JUMP to a menu option
# pressing a letter tries to jump to an entry beginning with that
# letter; really only works for menu styles 0,8 or data fields
$i=$menu_cur_option+1;
$new_option=-1;
CHECK_OPTION: {
# Scan next few items for a match
$j=ord(uc($action));
while($i<$menu_index) {
if(ord(uc($menu_sel_label[$i])) == $j) {
$new_option=$i;
last CHECK_OPTION;
}
$i++;
}
# Scan earlier items for a match
$i=0;
while($i<$menu_cur_option) {
if(ord(uc($menu_sel_label[$i])) == $j) {
$new_option=$i;
last CHECK_OPTION;
}
$i++;
}
}; # end of option check
if($new_option>=0) {
$menu_cur_option=$new_option;
$menu_top_option=$menu_cur_option;
&menu_draw_pane();
&doupdate();
}
};
} until ($action eq "STOP");
# We have made our selection so dump the menu windows
&delwin($menu_pane);
}
# curses cookery
nocbreak(); # permits keystroke examination
echo(); # no input echo until enabled explicitly
curs_set(1); # turn the cursor on
delwin($menu_window);
$ret;
}
#**********
# MENU_DRAW_INLAY
#
# Function: Draws a menu inlaid box to contain menu options
# Overlays standard backdrop
#
# Call format: &menu_draw_inlay();
#
# Arguments: None
#
# Returns: Undetermined
#
#**********
sub menu_draw_inlay {
my @words = ();
my ($count,$line,$i);
# Draw relief boxes in window
erase($menu_inlay);
attrset($menu_inlay,$menu_attributes{"edge"});
addch($menu_inlay,0,0, ACS_ULCORNER);
hline($menu_inlay,ACS_HLINE, $menu_inlay_cols);
move($menu_inlay,1,0);
vline($menu_inlay,ACS_VLINE, $menu_inlay_lines-2);
addch($menu_inlay,$menu_inlay_lines-1,0, ACS_LLCORNER);
addch($menu_inlay,$menu_inlay_lines-3,0,ACS_LTEE);
hline($menu_inlay,ACS_HLINE,$menu_inlay_cols-2);
attrset($menu_inlay,$menu_attributes{"dull"});
move($menu_inlay,$menu_inlay_lines-1,1);
hline($menu_inlay,ACS_HLINE, $menu_inlay_cols-2);
addch($menu_inlay, $menu_inlay_lines-1,$menu_inlay_cols-1,ACS_LRCORNER);
addch($menu_inlay,0, $menu_inlay_cols-1, ACS_URCORNER);
move($menu_inlay,1,$menu_inlay_cols-1);
vline($menu_inlay,ACS_VLINE, $menu_inlay_lines-2);
addch($menu_inlay,$menu_inlay_lines-3,$menu_inlay_cols-1,ACS_RTEE);
# Draw the Menu title
attrset($menu_inlay,$menu_attributes{"title"});
move($menu_inlay,0,($menu_inlay_cols-length($menu_top_title)-2)/2);
addstr($menu_inlay," $menu_top_title ");
# Process any sub-titles like the title.
attrset($menu_inlay,$menu_attributes{"dull"});
if(length($menu_sub_title)>$menu_inlay_cols-4) {
# Do multi-line subtitle
@words=split(/ /,$menu_sub_title);
$menu_sub_title_lines=1;
$line=$words[0];
for($i=1;$i<=$#words;$i++) {
if(length($line." ".$words[$i])<$menu_inlay_cols-4) {
attrset($menu_pane,$menu_attributes{"rtitle"});
addstr($menu_pane,$menu_sel_label[$m_item]);
last MENU_STYLE;
};
/8/ && do {
#
# Display option text
move($menu_pane,$i,$m_indent+$menu_item_pos-1-length($menu_sel_label[$m_item]));
attrset($menu_pane,$menu_attributes{"rtitle"});
addstr($menu_pane,$menu_sel_label[$m_item]);
last MENU_STYLE;
};
/9/ && do {
# seperator
last MENU_STYLE;
};
}
if($menu_sel_style[$m_item]==5) {
# Display item text right aligned
move($menu_pane,$i,$m_indent+$menu_item_pos+$max_item_len-length($menu_sel_text[$m_item]));
attrset($menu_pane,$menu_attributes{"rtext"});
addstr($menu_pane,$menu_sel_text[$m_item]);
} else {
# Display item text
move($menu_pane,$i,$m_indent+$menu_item_pos);
attrset($menu_pane,$menu_attributes{"rtext"});
addstr($menu_pane,$menu_sel_text[$menu_cur_option]);
}
}
#**********
# MENU_CREATE_PANE
#
# Function: Create a window within the menu window to display items
#
# Call format: &menu_create_pane();
#
# Arguments: none
#
# Returns: undetermined
#
#**********
sub menu_create_pane {
# Initialise menu pane and control variables
$menu_pane=newwin($menu_pane_lines-2,$menu_pane_cols-2,$menu_pane_y+1,$menu_pane_x+1);
bkgd($menu_pane,$menu_attributes{"text"});
clear($menu_pane);
idlok($menu_pane,1);
scrollok($menu_pane,1);
$menu_top_option=0;
keypad($menu_pane,1);
&menu_draw_pane();
}
#*********
# MENU_DRAW_PANE
#
# Function: Draws the actual menu especially after a keystroke
# Usually only necessary after big relocations of the menu cursor
#
# Input: Nothing
#
# Returns: Nothing
#
#*********
sub menu_draw_pane {
my ($i);
# Performs test to make sure the items are aligned correctly to use as much of the
# screen as possible
if(($menu_top_option+($menu_pane_lines-2))>$menu_index-1) { $menu_top_option=$menu_index-1-($menu_pane_lines-3); }
if($menu_top_option<0) {$menu_top_option=0; }
if($menu_cur_option>$menu_index-1) { $menu_cur_option=$menu_index-1; }
if($menu_cur_option>=($menu_top_option+($menu_pane_lines-2))) {$menu_top_option=$menu_cur_option-($menu_pane_lines-3); }
if($menu_top_option<0) {$menu_top_option=0; }
if($menu_cur_option<$menu_top_option) { $menu_cur_option=$menu_top_option; }
# Now draw the menu items
clear($menu_pane);
$i=$menu_top_option;
while(($i<$menu_index)&&(($i-$menu_top_option)<$menu_pane_lines-2)) {
&menu_draw_line($i,$menu_indent);
$i++;
}
&menu_draw_active($menu_cur_option,$menu_indent);
&noutrefresh($menu_pane);
}
#**********
# MENU_KEY_SEQ -- Collect characters until a sequence we recognize (or we
# know it cannot possibly fit any "magic" sequences.
#
# Call format: $sel = &menu_key_seq();
#
# Arguments: none
#
# Returns: either a single letter or a key stroke mneumonic for an action to do
# in some cases it will return nothing if;
# - an invalid/unrecognised function key was pressed
# - the screen was resized
# bum values like these should be ignored
#
#**********
sub menu_key_seq {
my ($cwin) = @_;
my ($possible,$ch);
my ($collect,$action) = "";
my ($resizing)=0;
$possible = 0; # Set number of possible matches
# Trapping resizing strings waiting for them to stop
resize_trap:
do {
$collect="";
$action="";
seq_seek:
while ($possible <$key_max) {
$ch = &getch($cwin);
#
# Call format: &menu_refresh();
#
# Arguments: None
#
# Returns: nuffink
#
#**********
sub menu_refresh {
&menu_redraw_backdrop();
&noutrefresh($menu_screen);
&menu_draw_inlay();
&redrawwin($menu_inlay);
&menu_button_bar();
&noutrefresh($menu_inlay);
&delwin($menu_window);
&menu_draw_window();
&noutrefresh($menu_window);
&delwin($menu_pane);
&menu_create_pane();
&doupdate();
}
# ##################################################################################
# Data entry routines
# ##################################################################################
#**********
# MENU_EDIT_ALPHA
#
# Function: Edit an alphanumeric field
#
# Call format: &menu_edit_alpha();
# assumes the current item
#
# Returns: nuffink
#
#**********
sub menu_edit {
my ($m_item,$m_indent,$numbers) = @_;
my ($item_line,$item_col,$item_len,$pos,$dec,$field,$ins,$menu_field,$action,$i);
$item_line=$menu_pane_y+1+$m_item-$menu_top_option;
$item_col=$menu_pane_x+1+$m_indent+$menu_item_pos;
# Get the field information
($item_len,$dec) = split(/ /,$menu_sel_pos[$m_item]);
if($item_len<1) {$item_len=length($menu_sel_text[$m_item]); }
if(!$item_line) {$item_line=0; }
if(!$item_col) {$item_col=0; }
if(!$numbers) {$numbers=0; }
# Initialise field
$field=$menu_sel_text[$m_item];
if(!$field) { $field=""; } # Make sure something is defined
$menu_field=newwin(1,$item_len,$item_line,$item_col);
bkgd($menu_field,$menu_attributes{"advice"});
# curses cookery
curs_set(1); # turn the cursor off
$ins=1; # turn insert mode on
$pos=length($field);
# Now edit the field
READ_KEY: do {
# Collect key sequences until something we recoginize
# (or we know we don't care)
# Format numbers correctly
if($numbers==1) {
if(!$field) { $field=0; }
if($dec==0) {
$field=sprintf("%d",$field);
} else {
$field=sprintf("%f",$field);
}
if($pos>length($field)) { $pos=length($field); }
}
move($menu_field,0,0);
erase($menu_field);
addstr($menu_field,$field);
move($menu_field,0,$pos);
noutrefresh($menu_field);
doupdate();
$action = &menu_key_seq($menu_pane);
# ------------------------------------------------------------------------------
# Switch construct for dealing with key sequence input
# ------------------------------------------------------------------------------
EDITKEY: for ($action) {
# General cursor movement
/DOWN/ && do { # down arrow
$action="ACCEPT";
redo EDITKEY;
};
/UP/ && do { # Up arrow
$action="ACCEPT";
redo EDITKEY;
};
/LYNXL/ && do { # Left arrow
$action="LEFT";
};
/LYNXR/ && do { # Right arrow
$action="RITE";
};
/LEFT/ && do { # Left arrow
$pos--;
if($pos<0) {$pos=0; }
last EDITKEY;
};
/RITE/ && do { # Right arrow
$pos++;
if($pos>length($field)) {$pos=length($field); }
last EDITKEY;
};
# larger cursor motion
/PREV/ && do { # Page up
$action="ACCEPT";
redo EDITKEY;
};
/NEXT/ && do { # Page down
$action="ACCEPT";
redo EDITKEY;
};
/HOME/ && do { # Home
$pos=0;
last EDITKEY;
};
/END/ && do { # End
$pos=length($field);
last EDITKEY;
};
/SPACE/ && do { # button press
$action=" ";
redo EDITKEY;
};
/RET/ && do { # button press
$action="ACCEPT";
redo EDITKEY;
};
/ACCEPT/ && do { # Return (enter)
$action="STOP";
$menu_sel_text[$m_item]=$field;
$menu_sel_flag[$m_item]=1;
last EDITKEY;
};
/QUIT/ && do { # Return (enter)
$action="STOP";
last EDITKEY;
};
/EXIT/ && do { # Return (enter)
$action="STOP";
last EDITKEY;
};
/HELP/ && do { # Return (enter)
menu_advice("$action not defined yet");
last EDITKEY;
};
/REFS/ && do { # Refresh screen
&menu_advice("Refreshed Screen");
last EDITKEY;
};
# button navigation
/TAB/ && do { # Next field
$action="ACCEPT";
redo EDITKEY;
};
/BACK/ && do { # Previous field
$action="ACCEPT";
redo EDITKEY;
};
/BS/ && do { # Home
if($pos!=0) {
$field=substr($field,0,$pos-1).substr($field,$pos);
$pos--;
if($pos==0) {$pos=0; }
/KILL/ && do { # Kill line
$field="";
$pos=0;
&menu_advice("Field cleared");
last EDITKEY;
};
/YANK/ && do { # Yank buffer
$field=$buffer;
$pos=length($field);
&menu_advice("Field recalled from buffer");
last EDITKEY;
};
/BUFF/ && do { # Copy to buffer
$buffer=$field;
&menu_advice("Field copied to buffer");
last EDITKEY;
};
/INS/ && do { # insert toggle
if($ins==1) {
&menu_advice("Overwrite mode On");
$ins=0;
} else {
$ins=1;
&menu_advice("Insert mode On");
}
last EDITKEY;
};
/NOP/ && do { # Jump to some option
last EDITKEY;
};
# deal with a letter press or unknown key
if(length($action)==1) {
if(($numbers==1) && (index("0123456789+-.",$action)<0)) {
# check for numeric only input
beep();
last EDITKEY;
}
study($field);
if($ins==1) {
# insert a character
if(length($field)>=$item_len) {
# ignore if field already full
beep();
last EDITKEY;
}
$i=substr($field,0,$pos).$action.substr($field,$pos);
$pos++;
if($pos>=$item_len) {$pos--; }
} else {
# replace text (overwrite)
$i=substr($field,0,$pos).$action.substr($field,$pos+1);
if($pos==length($field)) {$pos++; }
if($pos>=$item_len) {$pos--; }
}
$field=$i;
}
}; # end of option check
} until ($action eq "STOP");
# return screen to normal after field edit
curs_set(0); # turn the cursor off
delwin($menu_field);
move($menu_pane,$m_item-$menu_top_option,$m_indent);
clrtoeol($menu_pane);
&noutrefresh($menu_window);
}
# ##################################################################################
# ***************************************************************************
# Button Bar
# ~~~~~~~~~~
# A button bar can appear at the foot of each Menu. Button labels are
# user definable using the menu_button_set function
# Buttons perform
# ACTION - select the current menu option
# HELP - display user provided help information
# EXIT - exit back from the current menu
# These functions are pre-set
# ***************************************************************************
# ##################################################################################
#**********
# MENU_BUTTON_SET
#
# Function: Sets the text to be displayed in the 3 standard buttons
#
# Call format: &menu_button_set(button[0|1|2|3],"Button text");
#
# Arguments: - which button to affect 0=None 1=Okey 2=Help 3=Exit
# Setting of None causes messages to be shown in the
# button bar with the text used as default text
# - Textual content of the button
# If content is empty the button will be switched off
# If all buttons are off mode changes as if NONE selected
#
# Notes: User code must keep track of what is going on, we don't
#**********
sub menu_button_set {
my ($button,$button_text) = @_;
my ($i);
$menu_button[$button]=$button_text;
# FAILSAFE: Check that some buttons are on
$menu_buttons=0;
for($i=1;$i<=3;$i++) {
if(length($menu_button[$i])>0) {
$menu_buttons++;
}
}
}
#**********
# MENU_BUTTON_BAR
#
# Function: Bounces the active button right or left
#
# Call format: &menu_button_bar(action);
#
# Arguments: action can be either TAB or BACK which bounces the active
&attrset($menu_inlay,$menu_attributes{"rtext"});
&move($menu_inlay,$menu_inlay_lines-2,$h_indent);
addstr($menu_inlay,"<");
&attrset($menu_inlay,$menu_attributes{"rtitle"});
addstr($menu_inlay,$text);
&attrset($menu_inlay,$menu_attributes{"rtext"});
addstr($menu_inlay,">");
&attrset($menu_inlay,$menu_attributes{"roption"});
&move($menu_inlay,$menu_inlay_lines-2,$h_indent+1);
addch($menu_inlay,$cap);
}
# Draw an inactive button
sub menu_draw_button {
my ($h_indent,$text) = @_;
&attrset($menu_inlay,$menu_attributes{"button"});
&move($menu_inlay,$menu_inlay_lines-2,$h_indent);
addstr($menu_inlay,"<");
addstr($menu_inlay,$text);
addstr($menu_inlay,">");
}
# ##################################################################################
# Splash screen for Popups and Text displays
# ##################################################################################
#**********
# MENU_POPUP
#
# Function: Pops up a single line text message
# Can be used to keep users interested while a lengthy process
# completes; popup remains on screen until destroyed by
# calling the routine again with no message
#
# Call format: &menu_popup(message,title); # create a popup
# &menu_popup(); # destroy popup
#
# Arguments: - message - a text message to be displayed;
# should be single line only, will be truncated if too long
# If the message is empty an old popup will be destroyed
# - title - title centred in the popup border
# defaults to "processing" if not provided
#
# Returns: nothing
#
# Notes: popup may appear over a blank screen since the menu windows
# may have been removed (not guaranteed)
#**********
sub menu_popup {
my ($message,$ptitle) = @_;
if(!$ptitle) {$ptitle="processing"; }
&menu_advice(" ");
if(!$message) {
# no message so destroy the old popup
# curses cookery
echo(); # no input echo until enabled explicitly
curs_set(1); # turn the cursor on
&delwin($menu_popup);
&menu_redraw_backdrop();
} else {
# create a new popup
noecho(); # no input echo until enabled explicitly
curs_set(0); # turn the cursor off
while(length($message)>$menu_screen_cols-8) {
chop $message;
};
# Initialise menu pane and control variables
$menu_popup=newwin(3,$menu_screen_cols-6,($menu_screen_lines/2)-2,3);
bkgd($menu_popup,$menu_attributes{"popup"});
clear($menu_popup);
&border($menu_popup,0,0,0,0,0,0,0,0);
move($menu_popup,0,($menu_screen_cols-8-length($ptitle))/2);
addstr($menu_popup," $ptitle ");
move($menu_popup,1,($menu_screen_cols-6-length($message))/2);
addstr($menu_popup,$message);
&refresh($menu_popup);
&doupdate();
}
}
#**********
# MENU_SHOW
#
# Function: Pops up a text message with a button bar
# Used as a user confirmation advice before a process
# is performed
# Button bar defined according to current button settings
# Help screen is called directly
#
# Call format: &menu_show(message);
#
# Arguments: - message - a text message to be displayed;
# can be multiline (left-just) or single (centred), choice
# depends on size of window
#
# Returns: a simple string either YES or NO
#
# Notes: Uses Text::Wrap to fill the window if the text to be shown
# is longer than a line - this allows some formatting to be
# performed
# \n forces a line break
# Check docs for Text::wrap for more info
# At present only fills to current window depth and will lose
# any additional text; no scrolling supported yet
#
# Useful as a debugging tool for your own scripts to see
# what is going one since "print" will not work under
# Curses.
#
#**********
sub menu_show {
my ($temp_title,$message,$colour) = @_;
my ($attributes,$work,$x,$i,$j);
my ($menu_popup);
my (@b);
&menu_advice(" ");
if(!$colour) { $colour="ERROR"; }
SET_COLOR: for ($colour) {
/WARN/ && do {
$attributes=$menu_attributes{"warn"};
};
/HELP/ && do {
$attributes=$menu_attributes{"help"};
};
/ERROR/ && do {
$attributes=$menu_attributes{"error"};
};
};
if(!$message) {
# no message given so ignore the call
return("NO");
} else {
# create a popup with button bar
bkgd($menu_inlay,$attributes);
erase($menu_inlay);
&border($menu_inlay,0,0,0,0,0,0,0,0);
move($menu_inlay,0,($menu_inlay_cols-length($temp_title)-2)/2);
addstr($menu_inlay," $temp_title ");
&noutrefresh($menu_inlay);
# Initialise menu pane and control variables
# First define window and draw border
$menu_pane_y=$menu_inlay_y+1;
$menu_pane_x=$menu_inlay_x+1;
$menu_pane_lines=$menu_inlay_lines-3;
$menu_pane_cols=$menu_inlay_cols-2;
&noutrefresh($menu_inlay);
$menu_popup=newwin($menu_pane_lines-2,$menu_pane_cols-2,$menu_pane_y,$menu_pane_x+1);
bkgd($menu_popup,$attributes);
erase($menu_popup);
# curses cookery
cbreak(); # permits keystroke examination
noecho(); # no input echo until enabled explicitly
curs_set(0); # turn the cursor off
if(length($message)<$menu_pane_cols) {
move($menu_popup,$menu_pane_lines/2,($menu_pane_cols-length($message))/2);
addstr($menu_popup,$message);
&refresh($menu_popup);
} else {
$Text::Wrap::columns=$menu_pane_cols-2;
addstr($menu_popup,wrap("","",$message));
&refresh($menu_popup);
}
if($colour eq "HELP") {
# We have to do this since HELP can be called while in a menu
# when menu_show would otherwise trash the button labels
move($menu_inlay,$menu_inlay_lines-2,($menu_inlay_cols/2)-7);
&attrset($menu_inlay,$attributes|A_BOLD);
addstr($menu_inlay,"<Press any Key>");
&refresh($menu_inlay);
getch($menu_inlay);
} else {
do {
# Calculate position of buttons
DO_BUTTONS: for ($menu_buttons) {
/1/ && do {
$b[1]=$menu_inlay_cols/2;
};
/2/ && do {
$b[1]=$menu_inlay_cols/3;
$b[2]=$menu_inlay_cols-$b[1];
};
/3/ && do {
$b[1]=$menu_inlay_cols/4;
$b[2]=$menu_inlay_cols/2;
$b[3]=$menu_inlay_cols-$b[1];
};
}
# Draw buttons
$j=1;
for($i=1;$i<=3;$i++) {
$x=length($menu_button[$i]);
if($x>0) {
# Draw Okay button
if($menu_hot_button==$i) {
# Make it hot
move($menu_inlay,$menu_inlay_lines-2,$b[$j]-($x/2)-1);
&attrset($menu_inlay,$attributes|A_BOLD);
addstr($menu_inlay,"<$menu_button[$i]>");
} else {
# make it cool
move($menu_inlay,$menu_inlay_lines-2,$b[$j]-($x/2)-1);
&attrset($menu_inlay,$attributes);
addstr($menu_inlay,"<$menu_button[$i]>");
}
$j++;
}
}
&refresh($menu_inlay);
$work=&menu_key_seq($menu_inlay);
CONFIRM: for ($work) {
/TAB/ && do {
$menu_hot_button++;
do {
$menu_hot_button++;
if($menu_hot_button>3) { $menu_hot_button=1; }
} until (length($menu_button[$menu_hot_button])>0);
$work="";
last CONFIRM;
};
/BACK/ && do {
do {
$menu_hot_button--;
if($menu_hot_button<1) { $menu_hot_button=$menu_buttons; }
} until (length($menu_button[$menu_hot_button])>0);
$work="";
last CONFIRM;
};
/RET/ && do {
if($menu_hot_button==1) { $work="YES"; }
if($menu_hot_button==2) { $work="HELP"; }
if($menu_hot_button==3) { $work="NO"; }
last CONFIRM;
};
$work="";
};
} until ($work ne "");
}
# curses cookery
nocbreak(); # permits keystroke examination
echo(); # no input echo until enabled explicitly
curs_set(1); # turn the cursor on
&delwin($menu_popup);
&menu_redraw_backdrop();
}
$work;
}
# ##################################################################################
# End of Module
# ##################################################################################
1;
__END__
# Below is the stub of documentation for the module.
=head1 NAME
Cmenu - Perl extension for menuing and data entry in perl scripts
=head1 SYNOPSIS
use Cmenu;
use Curses;
use Text::Wrap;
&menu_initialise($main_title,$advice);
&menu_init($title,$sub-title,$topest,$menu_help);
&menu_item($item_text,$item_label,$item_style,$item_data,$item_pos)
&menu_item($item_text,$item_label,$item_style,$item_data,$item_pos)
...
&menu_item($item_text,$item_label,$item_style,$item_data,$item_pos)
$sel=&menu_display($advice,$start_item);
&menu_button_set($button,$button_text);
&menu_popup($title,$text);
...
&menu_popup();
&menu_show($title,$text,$colour);
&menu_terminate($message);
=head1 DESCRIPTION
CMENU is a Perl Module designed to provide functions for the
creation of menus in perl scripts.
It follows on from perlmenu but uses a Curses interface for
screen manipulation. It also uses the Text::Wrap module to
process large chunks of text for display. These two modules
should be loaded by user scripts.
The sequence of menu processing is as follows;
1. Initialise the module
loop
2. Define a menu structure
3. Define several menu options
( run in 0.569 second using v1.01-cache-2.11-cpan-39bf76dae61 )