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

Subroutine MTF.SUB.B( menu.title, menu.items, menu.help, menu.mneumonic,
			menu.x.orig, menu.y.orig, menu.width, menu.choices,
			menu.actions, submenu.flag, exit.code)

******************************************************************************
*
*	Drive MOTIF like sub-menu
*
*	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. 
*	11/28/90 7760  DPB changed PTERM options before and after execute.
*	8/30/90  7403  DTM added menu.items to MTF.INPUT.B
*
*******************************************************************************

id = "%W%"

$include UNIVERSE.INCLUDE MTF.INCL.H

if not(inited) then stop UVREADMSG(075000,"")

if stk.top >= STACK.LIMIT then stop UVREADMSG(075001,STACK.LIMIT)

stk.top += 1
stk.orient(stk.top) = 1
stk.title(stk.top) = menu.title
stk.items(stk.top) = menu.items
stk.x.orig(stk.top) = menu.x.orig
stk.y.orig(stk.top) = menu.y.orig
stk.width(stk.top) = menu.width
stk.choices(stk.top) = menu.choices

cursor.location = 1

10: call *MTF.INPUT.B(VERTICAL, menu.x.orig, menu.y.orig, menu.width,
			menu.choices, submenu.flag, menu.help, cursor.location,
			menu.mneumonic, exit.code,menu.items)

BEGIN CASE
	CASE exit.code=DOWN.ARROW
		cursor.location += 1
		if cursor.location > menu.choices then cursor.location = 1
		goto 10:
	CASE exit.code=UP.ARROW
		cursor.location -= 1
		if cursor.location < 1 then cursor.location = menu.choices
		goto 10:
	CASE exit.code=RIGHT.ARROW
		if submenu.flag<cursor.location>
			then goto 20:
			else goto 100:
	CASE exit.code=ESCAPE
		goto 100:
	CASE exit.code=F.10
		goto 100:
	CASE exit.code=LEFT.ARROW
		goto 100:
	CASE exit.code#SEL.ACTION
		goto 10:
END CASE

20: * enter sub-menu

stk.cursor(stk.top) = cursor.location
print @(menu.x.orig + 1, menu.y.orig + cursor.location):'<':
print @(menu.x.orig + menu.width - 2, menu.y.orig + cursor.location):'>':

call *MTF.LOAD.B(menu.actions<cursor.location>, VERTICAL,
	menu.x.orig + menu.width, menu.y.orig + cursor.location, menu.flag,
	submenu.title, submenu.items, submenu.help, submenu.mneumonic,
	submenu.x.orig, submenu.y.orig, submenu.width, submenu.choices,
	submenu.actions, subsubmenu.flag)

if menu.flag # '1'
then
	if menu.flag = '0'
	then
		print @(-1)
		prompt saved.prompt
		pterm.option=0
		GOSUB pterm.set
		break on
		execute menu.actions<cursor.location>
		break off
		pterm.option=1
		GOSUB pterm.set
		sleep 2
		prompt ''
		call *MTF.REDRAW.B
	end
	else
		print @(0,LINES-1):menu.flag:
	end
	goto 10:
end

call *MTF.PAINT.B(VERTICAL, submenu.x.orig, submenu.y.orig, submenu.width,
		submenu.choices,submenu.items)

call *MTF.SUB.B( submenu.title, submenu.items, submenu.help, submenu.mneumonic,
			submenu.x.orig, submenu.y.orig, submenu.width,
			submenu.choices, submenu.actions, subsubmenu.flag,
			exit.code)

if exit.code = ESCAPE then goto 100:

call *MTF.ERASE.B(VERTICAL, submenu.x.orig, submenu.y.orig, submenu.width,
		submenu.choices)

if exit.code = F.10 or exit.code = RIGHT.ARROW then goto 100:

stk.cursor(stk.top) = 0
print @(menu.x.orig + 1, menu.y.orig + cursor.location):' ':
print @(menu.x.orig + menu.width - 2, menu.y.orig + cursor.location):' ':

call *MTF.FIXSCR.B(submenu.x.orig, submenu.y.orig, submenu.width,
		submenu.choices)

goto 10:

100: * pop menu stack and return
stk.top -= 1
return

pterm.set:
	IF pterm.option=0 THEN
		TTYGET tty$ ELSE NULL
		CRMODE.INLCR=0
		CRMODE.IGNCR=0
		CRMODE.ICRNL=1
		CRMODE.ONLCR=1
		CRMODE.OCRNL=0
		CRMODE.ONOCR=0
		CRMODE.ONLRET=0
		ECHO.ON=1
		TTYSET tty$ ELSE NULL
	END
	ELSE
		TTYGET tty$ ELSE NULL
		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
	END
	RETURN
end