******************************************************************************
*
*	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