tldm-universe/Ardent/UV/BP/MTF.INPUT.B

230 lines
10 KiB
Plaintext
Raw Permalink Normal View History

2024-09-09 21:51:08 +00:00
Subroutine MTF.INPUT.B(orientation, menu.x.orig, menu.y.orig, menu.width,
menu.choices, submenu.flag, menu.help, cursor.location,
menu.mnemonic, input.code,menu.items)
******************************************************************************
*
* Menu input function
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Ardent Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
* Maintenence log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description........................................
* 10/14/98 23801 SAP Change copyrights.
* 07/09/91 8502 DTM Fixed input of <F4> key
* 05/13/91 8345 DTM Changed print to tprint
* 2/7/91 7673 DTM Final changes for FCS
* 8/30/90 7403 DTM Revised reverse video screen routines
* 8/13/90 7366 DPB Changed the delay time for escape sequences.
* 6/28/90 7236 DSC New MOTIF-like capability
*******************************************************************************
* This subroutine manipulates the highlighted cursor location on an
* MOTIF menu object which has already been painted on the terminal
* screen, and accepting and interpreting user input for navigation
* and other MOTIF standard commands.
* Commands for HELP and for moving cursor are handled internally;
* commands that require manipulation of menus (as opposed to within
* this one menu) are passed back to the calling routine.
* Arguments to the function are:
* orientation - is the menu horizontal (menubar) or vertical.
*
* menu.x.orig - the x (horizontal) anchor point for the menu.
*
* menu.y.orig - the y (vertical) anchor point for the menu.
*
* menu.width - for vertical menus, the width of the menu;
* for horizontal menus, a dynamic array of horizontal
* start and end points.
*
* menu.choices - number of menu elements.
*
* submenu.flag - dynamic array, True for those elements of a
* vertically oriented menu which have cascading sub-menus.
*
* menu.help - dynamic array of help messages for each
* menu element respectively.
*
* cursor.location - the currently chosen element. This argument
* is modified and passed back to the calling routine.
*
* menu.mnemonic - dynamic array of mnemonic letters for each
* menu element respectively.
*
* input.code - the code corresponding to the user input which
* caused return to the calling routine.
*
* menu.items - dynamic array of menu choices to paint on
* screen
* Mnemonics are translated to motion to the selected item followed by
* a select.
* If the orientation is HORIZONTAL this routine assumes the menu
* is the top-level menu bar; otherwise the orientation is VERTICAL
* and this routine assumes the menu is a second-level or deeper menu.
* These choices, and the presence or absence of cascaders at a given
* point determine which of the arrow keys are return events, motion
* events, or errors.
* Here are some arbitrary choices we've made in design:
* - Motion in the direction of orientation will WRAP to first or last
* item, no boundary problem, never land in title area (of 2nd level menu)
* - Downward or Rightward motion will navigate To lower level menu
* (this event will return to the calling routine for handling).
* - Select (<Space> per the Motif style guide) will navigate To lower
* level menu.
* - Left from a vertical menu is always a return -- it may mean return
* to previous menu from a cascaded menu, or it may mean go to sibling
* from a second level menu
* - There is not a symmetric right functionality. Right arrow means
* go to a cascading menu if there is one, but is an error if there
* isn't one. There is no 'go to right sibling' functionality in
* the calling driver.
id = "%W%"
$include UNIVERSE.INCLUDE MTF.INCL.H
* Times to wait for more characters, and granularity interval
equ DELAY.INTERVAL to 25 ;* 25 millisecond nap unit
equ ESC.DELAY.TIME to 100 ;* Delay to determine if singleton Escape
* Half-second. WORK: Is it enough?
* DPB 8/13/90: Nope, too long!
equ SEQ.DELAY.TIME to 75 ;* Delay for next char in sequence
* Where should we put the start and end of the highlight bar?
* This is the space for the Magic Cookie if it exists, otherwise the
* driver has left blanks or brackets there.
equ LEFT.COOKIE lit 'if orientation = VERTICAL then (menu.x.orig + 1) else (menu.width<cursor.location,1>)'
equ RIGHT.COOKIE lit 'if orientation = VERTICAL then (menu.x.orig + menu.width - 2) else (menu.width<cursor.location,2>)'
equ CUR.LINE lit 'if orientation = VERTICAL then (menu.y.orig + cursor.location) else (menu.y.orig)'
equ WRITE.POS lit 'if orientation = VERTICAL then (menu.x.orig) else (menu.width<cursor.location,1>)'
* Standard strings to emphasize or de-emphasize the current selection
* iv.begin and iv.end are from common, typically @(13) and @(14)
* Modified EMPH.STRING and DE.EMPH.STRING to handle strange Magic Cookie
* problem and the differences it caused on different terminals - DTM
equ EMPH.STRING lit "@(RIGHT.COOKIE,CUR.LINE):iv.end:@(LEFT.COOKIE,CUR.LINE):iv.begin:@(WRITE.POS,CUR.LINE):menu.items<cursor.location>:@(RIGHT.COOKIE,CUR.LINE):iv.end:@(LEFT.COOKIE,CUR.LINE):iv.begin"
equ DE.EMPH.STRING lit "@(LEFT.COOKIE,CUR.LINE):iv.end:@(WRITE.POS,CUR.LINE):menu.items<cursor.location>"
* Here are error messages for bad navigation keys, and help messages
equ BAD.NAV to UVREADMSG(075024,"")
equ HELP.ERR.LUD to BAD.NAV:UVREADMSG(075025,"") ;* No cascade
equ HELP.ERR.LRD to BAD.NAV:UVREADMSG(075026,"") ;* Menubar
equ NO.HELP to UVREADMSG(075027,"")
equ HELP.BAD.TOKEN to UVREADMSG(075028,"")
equ HELP.ESCAPE to UVREADMSG(075029,"")
equ ESCAPE.MUST.BE.ALONE to UVREADMSG(075030,"")
mnemos=""
* Initialization - always clear out help area on entry
help.area.needs.clearing = 1
* Main loop: highlight current.selection, take an input token,
* make appropriate action, de-highlight
loop
tprint EMPH.STRING:
call *GET.TOKEN.B(DELAY.INTERVAL, SEQ.DELAY.TIME, ESC.DELAY.TIME,
CNT.OF.ALPHA, mat alphastrings, mat alphacodes,
ESCAPE, MNEMONIC, UNKNOWN, menu.choices, menu.mnemonic,
left.over, input.code, mnemos)
* Help area could have been used by a previous iteration or a pending Escape
if help.area.needs.clearing then gosub clear.help
* The current token to do is in input.code
* Check for tokens which always return
if input.code = SEL.ACTION or input.code = F.10 or input.code = ESCAPE or input.code = LEFT.ARROW or input.code = MNEMONIC or input.code = RIGHT.ARROW
then goto exit.point
* Check for tokens which always return when orientation is HORIZONTAL
* (Calling routine must adjust current selection and sub-menus)
if (orientation = HORIZONTAL) and (input.code = RIGHT.ARROW or input.code = LEFT.ARROW or input.code = DOWN.ARROW)
then goto exit.point
* Handle other tokens
begin case
* case input.code = RIGHT.ARROW
* * Got to a cascading menu if one is there
* if submenu.flag<cursor.location> then goto exit.point
* * Logic: we're not in menu-bar and there's no cascader to
* * go to, thus error.
* help.msg = HELP.ERR.LUD
* gosub show.help
case input.code = DOWN.ARROW
tprint DE.EMPH.STRING:
cursor.location += 1
if cursor.location > menu.choices then cursor.location = 1
case input.code = UP.ARROW
if orientation = HORIZONTAL
then
help.msg = HELP.ERR.LRD
gosub show.help
end
else
tprint DE.EMPH.STRING:
cursor.location -= 1
if cursor.location < 1 then cursor.location = menu.choices
end
case input.code = F.1 ;* HELP
help.msg = menu.help<cursor.location>
if help.msg = "" then help.msg = NO.HELP
gosub show.help
case input.code = F.4
goto exit.point
case input.code = UNKNOWN
if mnemos = alphastrings(ESCAPE)
then help.msg = ESCAPE.MUST.BE.ALONE
* Of course that message will only flash, as it only occurs
* when there is some other character in the type-ahead buffer,
* but this Escape plus that character don't match anything.
* Following might be overkill, but it
* avoids printing non-printables
else
seq.mnemos = seq(mnemos) ;* register int
if seq.mnemos > 32 and seq.mnemos <= 126
then help.msg = mnemos:HELP.BAD.TOKEN
else
if seq.mnemos > 127
then help.msg = "^?":HELP.BAD.TOKEN
else help.msg = "^":char(seq.mnemos+32):HELP.BAD.TOKEN
end
end
gosub show.help
end case
repeat ;* forever
clear.help:
* Always print Help at bottom line
tprint @(0,LINES-1):@(-4):
help.area.needs.clearing = 0
return
show.help:
tprint @(0,LINES-1):@(-4):help.msg:
help.area.needs.clearing = 1
* WORK: Do we want a delay here, or just keep this up until next keystroke
return
exit.point:
tprint DE.EMPH.STRING:
if input.code = MNEMONIC
then
* Combines jump to here and select
cursor.location = mnemos
input.code = SEL.ACTION
end
return