tldm-universe/Ardent/UV/BP/MTF.MENU.B
2024-09-09 17:51:08 -04:00

274 lines
7.9 KiB
Plaintext
Executable File

******************************************************************************
*
* Drive MOTIF like menu system, top level module
*
* 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.
* 05/15/96 18330 LDG Changed LEN() function to LENDP() for NLS DBCS.
* 07/09/91 8502 DTM Fixed input of <F4> key
* 05/13/91 8345 DTM Changed print to tprint
* 02/7/91 7673 DTM Added final changes for FCS
* 09/05/90 7393 DPB Added return to alphastrings as SEL.ACTION
* 08/30/90 7403 DTM Added menu.items to MTF.INPUT.B parameter list
* 08/15/90 7367 DPB Moved drawing character definitions to MTF.INCL.H
* 08/13/90 7365 DPB Removed sort routine, and made it a global subr.
* 06/28/90 7236 JWT New MOTIF like new capability
*
*******************************************************************************
id = "%W%"
$include UNIVERSE.INCLUDE MTF.INCL.H
inited=0
dim command(10)
stk.top = 0
left.over = ''
* verify minimum terminfo set here
GOSUB key.bind
if ERASE.SCREEN = ''
then stop UVREADMSG(075014,"")
if MOVE.CURSOR.TO.ADDRESS = ''
then stop UVREADMSG(075014,"")
* set up input alphabet
alphastrings(1) = KEY.MOVE.CURSOR.RIGHT ; alphacodes(1) = RIGHT.ARROW
alphastrings(2) = KEY.MOVE.CURSOR.LEFT ; alphacodes(2) = LEFT.ARROW
alphastrings(3) = KEY.MOVE.CURSOR.DOWN ; alphacodes(3) = DOWN.ARROW
alphastrings(4) = KEY.MOVE.CURSOR.UP ; alphacodes(4) = UP.ARROW
alphastrings(5) = KEY.FUNCTION.1 ; alphacodes(5) = F.1
alphastrings(6) = KEY.FUNCTION.10 ; alphacodes(6) = F.10
alphastrings(7) = ' ' ; alphacodes(7) = SEL.ACTION
alphastrings(8) = char(27) ; alphacodes(8) = ESCAPE
alphastrings(9) = CARRIAGE.RETURN ; alphacodes(9) = SEL.ACTION
alphastrings(10) = KEY.FUNCTION.4 ; alphacodes(10) = F.4
call *TOKEN.SORT.B(10, mat alphastrings, mat alphacodes)
* find menu in VOC file
open 'VOC' to voc.file
else stop UVREADMSG(073005,"VOC")
work = trim(@sentence)
matparse command from work , ' '
if inmat() < 2
then stop UVREADMSG(075016,"")
call *MTF.LOAD.B(command(2), HORIZONTAL, 0, 1, menu.flag, menu.title,
menu.items, menu.help, menu.mneumonic, menu.x.orig,
menu.y.orig, menu.width, menu.choices, menu.actions,
submenu.flag)
if menu.flag # 1
then
if menu.flag = '0'
then stop UVREADMSG(075017,command(2))
else stop menu.flag
end
if sum(submenu.flag) # menu.choices
then stop UVREADMSG(075018,"")
dim submenu.items(menu.choices), submenu.help(menu.choices),
submenu.mneumonic(menu.choices), submenu.x.orig(menu.choices),
submenu.y.orig(menu.choices), submenu.width(menu.choices),
submenu.choices(menu.choices), submenu.actions(menu.choices),
subsubmenu.flag(menu.choices), submenu.title(menu.choices)
for i = 1 to menu.choices
call *MTF.LOAD.B(menu.actions<i>, VERTICAL, menu.width<i,1>, 2,
d1, s10, s1, s2, s3, s4, s5, s6, s7, s8, s9)
if d1 # 1
then stop UVREADMSG(075018,"")
submenu.items(i) = s1
submenu.help(i) = s2
submenu.mneumonic(i) = s3
submenu.x.orig(i) = s4
submenu.y.orig(i) = s5
submenu.width(i) = s6
submenu.choices(i) = s7
submenu.actions(i) = s8
subsubmenu.flag(i) = s9
submenu.title(i) = s10
next i
inited = 1
stk.top = 1
stk.orient(1) = HORIZONTAL
stk.title(1) = menu.title
stk.items(1) = menu.items
stk.x.orig(1) = menu.x.orig
stk.y.orig(1) = menu.y.orig
stk.width(1) = menu.width
stk.choices(1) = menu.choices
cursor.location = 1
title.pos = (COLUMNS - lendp(menu.title)) / 2
if VIDEO.SPACES then title.pos -= 1
saved.prompt = system(26)
break off
prompt ''
TTYGET tty$ ELSE NULL
tmptty=tty$
CRMODE.INLCR=0
CRMODE.IGNCR=0
CRMODE.ICRNL=0
CRMODE.ONLCR=0
CRMODE.OCRNL=0
CRMODE.ONOCR=0
CRMODE.ONLRET=0
ECHO.ON=0
TTYSET tty$ ELSE NULL
tprint @(-1):
tprint @(title.pos+lendp(menu.title)+1,0):@(-16):@(title.pos,0):@(-15):menu.title:@(-16)
help.msg="<Space> or mnemonics to select, <F1> for help, arrows, <esc> to exit, or <F10>"
tprint @(0,LINES-1):@(-4):help.msg:
call *MTF.PAINT.B(HORIZONTAL, menu.x.orig, menu.y.orig,
menu.width, menu.choices, menu.items)
F10: call *MTF.INPUT.B(HORIZONTAL, menu.x.orig, menu.y.orig, menu.width,
menu.choices, submenu.flag, menu.help, cursor.location,
menu.mneumonic, input.code,menu.items)
if input.code = ESCAPE
then
TTYGET tty$ ELSE NULL
tty$=tmptty
TTYSET tty$ ELSE NULL
prompt saved.prompt
break on
inited=0
stop @(-1)
end
if input.code = RIGHT.ARROW
then
cursor.location += 1
if cursor.location > menu.choices then cursor.location = 1
goto F10:
end
if input.code = LEFT.ARROW
then
cursor.location -= 1
if cursor.location < 1 then cursor.location = menu.choices
goto F10:
end
if input.code # UP.ARROW and input.code # SEL.ACTION then goto F10:
20: * enter sub-menu
stk.cursor(1) = cursor.location
tprint @(menu.width<cursor.location,1>,menu.y.orig):'<':
tprint @(menu.width<cursor.location,2>,menu.y.orig):'>':
call *MTF.PAINT.B(VERTICAL, submenu.x.orig(cursor.location),
submenu.y.orig(cursor.location), submenu.width(cursor.location),
submenu.choices(cursor.location),submenu.items(cursor.location))
call *MTF.SUB.B(submenu.title(cursor.location), submenu.items(cursor.location),
submenu.help(cursor.location),
submenu.mneumonic(cursor.location),
submenu.x.orig(cursor.location),
submenu.y.orig(cursor.location),
submenu.width(cursor.location),
submenu.choices(cursor.location),
submenu.actions(cursor.location),
subsubmenu.flag(cursor.location), exit.code)
call *MTF.ERASE.B(VERTICAL, submenu.x.orig(cursor.location),
submenu.y.orig(cursor.location), submenu.width(cursor.location),
submenu.choices(cursor.location))
tprint @(menu.width<cursor.location,1>,menu.y.orig):' ':
tprint @(menu.width<cursor.location,2>,menu.y.orig):' ':
if exit.code = LEFT.ARROW
then
cursor.location -= 1
if cursor.location < 1 then cursor.location = menu.choices
goto 20:
end
if exit.code = RIGHT.ARROW
then
cursor.location += 1
if cursor.location > menu.choices then cursor.location = 1
goto 20:
end
if exit.code = ESCAPE
then
TTYGET tty$ ELSE NULL
tty$=tmptty
TTYSET tty$ ELSE NULL
prompt saved.prompt
break on
inited=0
stop @(-1)
end
tprint @(0,LINES-1):@(-4):help.msg:
goto F10:
key.bind:
if KEY.MOVE.CURSOR.RIGHT = ''
THEN stop UVREADMSG(075010,"")
if KEY.MOVE.CURSOR.LEFT = ''
then stop UVREADMSG(075011,"")
if KEY.MOVE.CURSOR.DOWN = ''
then stop UVREADMSG(075012,"")
if KEY.MOVE.CURSOR.UP = ''
then stop UVREADMSG(075013,"")
if KEY.FUNCTION.1 = ''
THEN KEY.FUNCTION.1 = char(63) ;* if no function keys, then set to ?
if KEY.FUNCTION.10 = ''
THEN KEY.FUNCTION.10 = char(20) ;* if no function keys, then set to ^T
if KEY.FUNCTION.4 = ''
THEN KEY.FUNCTION.4 = "*"
OPEN "","INCLUDE" TO alt.key.file ELSE RETURN
alt.record=""
READ alt.record FROM alt.key.file,"ALT.MTF.KEYS" ELSE RETURN
alt.rec.count=COUNT(alt.record,@FM)+1
FOR i=1 TO alt.rec.count STEP 2
BEGIN CASE
CASE alt.record<i>="ALT.RT.ARROW"
KEY.MOVE.CURSOR.RIGHT=alt.record<i+1>
CASE alt.record<i>="ALT.LT.ARROW"
KEY.MOVE.CURSOR.LEFT=alt.record<i+1>
CASE alt.record<i>="ALT.UP.ARROW"
KEY.MOVE.CURSOR.UP=alt.record<i+1>
CASE alt.record<i>="ALT.DN.ARROW"
KEY.MOVE.CURSOR.DOWN=alt.record<i+1>
CASE alt.record<i>="ALT.F.1"
KEY.FUNCTION.1=alt.record<i+1>
CASE alt.record<i>="ALT.F.10"
KEY.FUNCTION.10=alt.record<i+1>
END CASE
NEXT i
CLOSE alt.record
RETURN
end