*******************************************************************************
*
*	New System Admin - This routine, given the data structure for a menu
*		bar, will allow the user to activate it, and select items from
*		it.
*
*	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/20/96 18330 LDG Changed LEN() function to LENDP() for NLS DBCS.
*   05/13/91 8345  DTM changed print to tprint
*   03/14/91 7673  DTM Changed a few flow statements
*	11/05/90 7393  DPB Routine first created and admin'd.
*******************************************************************************

SUBROUTINE DO.MNU.BAR.B(menu.bar, action.code,form.size,form,temp.form)

$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H

EQU TKC TO 6		;* Top Key Count = # of keys used for top level menu.
EQU SKC TO 9		;* Sub Key Count = # of keys used in submenu.

DIM top.alpha(TKC)
DIM top.codes(TKC)
DIM sub.alpha(SKC)
DIM sub.codes(SKC)
input.code = ""
mnemos = ""
left.over = ""


GOSUB init

TTYGET tty$ ELSE NULL
tmptty=tty$
CRMODE.ICRNL=0
CRMODE.ONLCR=0
TTYSET tty$ ELSE NULL

label1:
    GOSUB hilight.item

label2:
    CALL *GET.TOKEN.B(25, 25, 75, TKC, mat top.alpha, mat top.codes, ESC.KEY,           MNEMONIC, 0, num.items, M.MNEMOS, left.over,input.code, mnemos)


label3:
    BEGIN CASE

    CASE input.code = ESCAPE
        action.code = -1
        GOSUB unlight.item
		GOTO end.stuff
        RETURN

    CASE input.code = RIGHT.ARROW
        GOSUB unlight.item
        item.no += 1
        IF item.no > num.items THEN
            item.no = 1
            END
        GOTO label1

    CASE input.code = LEFT.ARROW
        GOSUB unlight.item
        item.no -= 1
        IF item.no < 1 THEN
            item.no = num.items
            END
        GOTO label1

    CASE input.code = SEL.ACTION
        GOTO sub.menu
        GOTO label1

    CASE input.code = MNEMONIC
        GOSUB unlight.item
        item.no = mnemos
        GOSUB hilight.item
        input.code = SEL.ACTION
        GOTO sub.menu

    CASE input.code = F.1
		IF menu.bar<item.no+1,1,3> # "" THEN
			CALL *HELP.BOX.B(5,0,0,menu.bar<item.no+1,1,3>)
			GOSUB update.screen
		END
        GOTO label2

	CASE 1
		GOTO label2

    END CASE

RETURN

sub.menu:
    GOSUB init.submenu
    GOSUB draw.sub.menu
label5:
    GOSUB hi.sub.menu
label6:
    CALL *GET.TOKEN.B(25, 25, 75, SKC, mat sub.alpha, mat sub.codes,                    SUB.ESC.KEY, MNEMONIC, 0, sub.menu.num, sub.mnemos, left.over,                input.code, mnemos)


label7:
    BEGIN CASE

    CASE input.code = ESCAPE
        GOSUB clear.sub.menu
        GOSUB unlight.item
        action.code = -1
		GOTO end.stuff

    CASE input.code = SEL.ACTION
        GOSUB clear.sub.menu
        GOSUB unlight.item
        action.code = menu.bar<item.no+1, sub.menu.no+1,2>
		GOTO end.stuff

    CASE input.code = MNEMONIC
        GOSUB clear.sub.menu
        GOSUB unlight.item
        action.code = menu.bar<item.no+1, sub.menu.no+mnemos,2>
		GOTO end.stuff

    CASE input.code = F.1
		IF menu.bar<item.no+1,sub.menu.no+1,3> # "" THEN
			CALL *HELP.BOX.B(5,0,0,menu.bar<item.no+1,sub.menu.no+1,3>)
			GOSUB update.screen
			GOSUB draw.sub.menu
		END
        GOTO label5

    CASE input.code = F.10
        GOSUB clear.sub.menu
		GOSUB update.screen
        GOTO label2

    CASE input.code = RIGHT.ARROW
        GOSUB clear.sub.menu
        GOSUB unlight.item
        item.no += 1
        IF item.no > num.items THEN
            item.no = 1
            END
		GOSUB update.screen
        GOSUB hilight.item
        GOTO sub.menu

    CASE input.code = LEFT.ARROW
        GOSUB clear.sub.menu
        GOSUB unlight.item
        item.no -= 1
        IF item.no < 1 THEN
            item.no = num.items
            END
		GOSUB update.screen
        GOSUB hilight.item
        GOTO sub.menu

    CASE input.code = UP.ARROW
        GOSUB un.sub.menu
        sub.menu.no -= 1
        IF sub.menu.no < 1 THEN
            sub.menu.no = sub.menu.num
            END
        GOTO label5

    CASE input.code = DOWN.ARROW
        GOSUB un.sub.menu
        sub.menu.no += 1
        IF sub.menu.no > sub.menu.num THEN
            sub.menu.no = 1
            END
        GOTO label5

	CASE 1
		GOTO label6

    END CASE

RETURN
    
init.submenu:
    sub.menu.num = menu.bar<item.no+1,1,2>	;* # of items in submenu
    sub.menu.no = 1				;* Current item
    sub.menu.width = 0
    sub.mnemos = ""
    FOR I = 1 to sub.menu.num
        sub.mnemos<I>=menu.bar<item.no+1,sub.menu.no+I,1>[1,1]
        FOR J = 1 to LEN(menu.bar<item.no+1,sub.menu.no+I,1>)
            IF SEQ(menu.bar<item.no+1,sub.menu.no+I,1>[J,1]) >= 65 AND                       SEQ(menu.bar<item.no+1,sub.menu.no+I,1>[J,1]) <= 90 THEN
                sub.mnemos<I>=menu.bar<item.no+1,sub.menu.no+I,1>[J,1]
                END
        NEXT J
        IF LENDP(menu.bar<item.no+1,sub.menu.no + I,1>) > sub.menu.width THEN
            sub.menu.width = LENDP(menu.bar<item.no+1,sub.menu.no+I,1>)
            END
    NEXT I
    sub.menu.width += 4
    sub.menu.col = ((item.no*offset)-int(sub.menu.width/2))
    sub.menu.line = lineno+2
RETURN

draw.sub.menu:
    CALL *DRAW.BOX.B(lineno+2, sub.menu.col-1, sub.menu.num, sub.menu.width,1)
    FOR I = 1 TO sub.menu.num
        TPRINT @(sub.menu.col+2,sub.menu.line+I):menu.bar<item.no+1,I+1,1>:
    NEXT I
    RETURN

clear.sub.menu:
    CALL *DRAW.BOX.B(lineno+2, sub.menu.col-1, sub.menu.num, sub.menu.width,0)
    RETURN

hi.sub.menu:
        TPRINT @(sub.menu.col+sub.menu.width-1,sub.menu.line+sub.menu.no):
        CALL *INVERSE.B(0)
        TPRINT @(sub.menu.col,sub.menu.line+sub.menu.no):
        CALL *INVERSE.B(1)
        TPRINT " ":menu.bar<item.no+1,sub.menu.no+1,1>:STR(" ",sub.menu.width-(LENDP(menu.bar<item.no+1,sub.menu.no+1,1>)+3)):
        CALL *INVERSE.B(0)
RETURN


un.sub.menu:
        TPRINT @(sub.menu.col+sub.menu.width-1,sub.menu.line+sub.menu.no):
        CALL *INVERSE.B(0)
        TPRINT @(sub.menu.col,sub.menu.line+sub.menu.no):
        CALL *INVERSE.B(0)
        TPRINT " ":menu.bar<item.no+1,sub.menu.no+1,1>:STR(" ",sub.menu.width-(LENDP(menu.bar<item.no+1,sub.menu.no+1,1>)+3)):
        CALL *INVERSE.B(0)
RETURN


hilight.item:
    tprint @(((item.no*offset)-int(LENDP(menu.bar<item.no+1,1,1>)/2)-2)+3+LENDP(menu.bar<item.no+1,1,1>),lineno):
    CALL *INVERSE.B(0)
    tprint @((item.no*offset)-int(LENDP(menu.bar<item.no+1,1,1>)/2)-2,lineno):
    CALL *INVERSE.B(1)
    tprint " ":menu.bar<item.no+1,1,1>:" ":
    CALL *INVERSE.B(0)
RETURN

unlight.item:
    tprint @((item.no*offset)-int(LENDP(menu.bar<item.no+1,1,1>)/2)-2,lineno):
    tprint "  ":menu.bar<item.no+1,1,1>:"  ":
    CALL *INVERSE.B(0)
RETURN

init:
    num.items = menu.bar<1,1>
    offset = int(80/(num.items+1))
    lineno= menu.bar<1,2>
    item.no = action.code
    IF item.no > num.items THEN item.no = 1
    GOSUB init.top.menu
RETURN

init.top.menu:

	OPEN "","INCLUDE" TO alt.key.file ELSE GOTO end.loop
	alt.record=""
	READ alt.record FROM alt.key.file,"ALT.MTF.KEYS" ELSE GOTO end.loop
	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
end.loop:
    top.alpha(1) = KEY.MOVE.CURSOR.RIGHT
    top.alpha(2) = KEY.MOVE.CURSOR.LEFT
    top.alpha(3) = " "
    top.alpha(4) = CHAR(27)
    top.alpha(5) = CARRIAGE.RETURN
    top.alpha(6) = KEY.FUNCTION.1
    top.codes(1) = RIGHT.ARROW
    top.codes(2) = LEFT.ARROW
    top.codes(3) = SEL.ACTION
    top.codes(4) = ESCAPE
    top.codes(5) = SEL.ACTION
    top.codes(6) = F.1

    CALL *TOKEN.SORT.B(TKC, mat top.alpha, mat top.codes)
    ESC.KEY = 0
    FOR I = 1 TO TKC
        IF top.codes(I) = ESCAPE then ESC.KEY = I
    NEXT I

    M.MNEMOS = ""
    FOR I = 1 TO menu.bar<1,1>
        M.MNEMOS<I> = menu.bar<I+1,1,1>[1,1]
    NEXT I

    sub.alpha(1) = KEY.MOVE.CURSOR.RIGHT
    sub.alpha(2) = KEY.MOVE.CURSOR.LEFT
    sub.alpha(3) = KEY.MOVE.CURSOR.UP
    sub.alpha(4) = KEY.MOVE.CURSOR.DOWN
    sub.alpha(5) = " "
    sub.alpha(6) = CHAR(27)
    sub.alpha(7) = KEY.FUNCTION.1
    sub.alpha(8) = KEY.FUNCTION.10
    sub.alpha(9) = CARRIAGE.RETURN

    sub.codes(1) = RIGHT.ARROW
    sub.codes(2) = LEFT.ARROW
    sub.codes(3) = UP.ARROW
    sub.codes(4) = DOWN.ARROW
    sub.codes(5) = SEL.ACTION
    sub.codes(6) = ESCAPE
    sub.codes(7) = F.1
    sub.codes(8) = F.10
    sub.codes(9) = SEL.ACTION

    CALL *TOKEN.SORT.B(SKC, mat sub.alpha, mat sub.codes)
    SUB.ESC.KEY = 0
    FOR I = 1 TO SKC
        IF sub.codes(I) = ESCAPE then SUB.ESC.KEY = I
    NEXT I
    
RETURN

update.screen:
	IF form.size # 0 THEN
		CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
	END
	RETURN

end.stuff:
	TTYGET tty$ ELSE NULL
	tty$=tmptty
	TTYSET tty$ ELSE NULL
	RETURN
END