274 lines
7.9 KiB
Plaintext
274 lines
7.9 KiB
Plaintext
|
******************************************************************************
|
||
|
|
*
|
||
|
|
* 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
|