230 lines
10 KiB
Brainfuck
Executable File
230 lines
10 KiB
Brainfuck
Executable File
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
|