*******************************************************************************
*
*	New System Admin - This module allows the user to create a box on the
*		screen which contains some text (Which you can page through),
*		and from 1 to 4 buttons.
*
*	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.
*	01/17/92 8963  TMC fix dealing with lines >= width
*	06/19/91 8408  DPB Fixed number of lines bug for HELP routines.
*	06/12/91 7673  DTM Added More functionality for HELP routines
*	05/31/91 8408  DPB Added @FM feature for HELP routines
*	05/13/91 8345  DTM changed print to tprint
*	03/05/91 7673  DTM Fixed error conditions
*	11/05/90 7393  DPB Routine first created and admin'd.
*******************************************************************************

SUBROUTINE CHOICE.BOX.B(start.line, max.lines, width, textstr.orig,                                                  Button.Array,  selvalue,helpstring)

$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
EQU KEYNUM TO 7
DIM string.array(KEYNUM)
DIM string.codes(KEYNUM)
Default.list=0

textstr=textstr.orig

Help.number=0
IF width < 25 THEN width = 25
start.col = 39-int(width/2)
text.start = start.col
IF LENDP(textstr) < width THEN text.start = (39-int(LENDP(textstr)/2)) -1

IF Button.Array="" THEN 
	selvalue=-2
	RETURN
END

IF selvalue > Button.Array<1> OR selvalue <= 0 THEN selvalue=1

IF Button.Array<1> > 4 OR NUM(Button.Array<1>) = 0 THEN
    selvalue = -2
    RETURN
END

FOR i=2 to Button.Array<1>+1
	IF UPCASE(Button.Array<i>)="HELP" THEN Help.number=i-1
NEXT i
TPRINT CURSOR.INVISIBLE:
GOSUB screen.init
GOSUB light.label
GOSUB key.init

TTYGET tty$ ELSE NULL
tmptty=""
tmptty=tty$
CRMODE.ICRNL=0
CRMODE.ONLCR=0
TTYSET tty$ ELSE NULL
looplabel1:
left.over=""
    CALL *GET.TOKEN.B(25, 75, 100, KEYNUM, mat string.array, mat string.codes,          ESC.KEY, MNEMONIC, 0, Button.Array<1>, MNEMOS, left.over, input.code,          mnemos)


looplabel2:
    BEGIN CASE

    CASE input.code = ESCAPE
        selvalue = -1
        GOSUB cleanup
		GOTO end.stuff

    CASE input.code = NEXT.PAGE
        IF ((cur.screen+1)*(box.lines-2)) < numlines THEN
            GOSUB Blank.Page
            cur.screen += 1
            GOSUB Draw.Page
            END

    CASE input.code = PREV.PAGE
        IF (cur.screen -1) >= 0 THEN
            GOSUB Blank.Page
            cur.screen -= 1
            GOSUB Draw.Page
            END

    CASE input.code = SEL.ACTION
        selvalue = item.no -1
		IF UPCASE(Button.Array<selvalue+2>) = "MORE" THEN
			input.code = NEXT.PAGE
			GOTO looplabel2
		END
		IF selvalue=Help.number-1 THEN 
			IF helpstring # "" THEN
				CALL *HELP.BOX.B(start.line+3,start.col+3,0,helpstring)
    			CALL *DRAW.BOX.B(start.line, start.col, box.lines, width, 1)
    			GOSUB Draw.Page
    			GOSUB Do.Labels
				GOSUB light.label
				GOTO looplabel1
			END
		END
        GOSUB cleanup
		GOTO end.stuff

    CASE input.code = RIGHT.ARROW
        IF ((item.no +1) > Button.Array<1> AND Button.Array<1> # 1) THEN
            GOSUB unlight.label
            item.no = 1
            GOSUB light.label
            END
        ELSE IF Button.Array<1> # 1 THEN
            GOSUB unlight.label
            item.no += 1
            GOSUB light.label
            END

    CASE input.code = LEFT.ARROW
        IF ((item.no -1) < 1 AND Button.Array<1> # 1) THEN
            GOSUB unlight.label
            item.no = Button.Array<1>
            GOSUB light.label
            END
        ELSE IF Button.Array<1> # 1 THEN
            GOSUB unlight.label
            item.no -= 1
            GOSUB light.label
            END

    CASE input.code = MNEMONIC
        item.no = mnemos
        input.code = SEL.ACTION
        GOTO looplabel2

	CASE 1
		GOTO looplabel1
    END CASE
    GOTO looplabel1

TPRINT CURSOR.VISIBLE:
GOTO end.stuff
RETURN

*
* Everything after this point is support routines.
*

cleanup:
    CALL *DRAW.BOX.B(start.line, start.col, box.lines, width, 0)
    TPRINT CURSOR.VISIBLE:
RETURN

Draw.Page:
    FOR I = 1 to box.lines-2
        TPRINT @(text.start+2, start.line+I):tstr<I+cur.screen*(box.lines-2)>:
    NEXT I

    IF cur.screen < max.screen THEN
	IF cur.screen < 1 THEN
        	IF r.tee = "+" THEN
           		TPRINT @(28,start.line+1+box.lines):r.tee:
			TPRINT "     Page Down     ":l.tee:
        	END
        	ELSE
                	TPRINT @(28,start.line+1+box.lines):LINEDRAW.BEGIN:
                        TPRINT r.tee:"     Page Down     ":l.tee:LINEDRAW.END:
        	END
                RETURN
        END
	IF r.tee = "+" THEN
        	TPRINT @(28,start.line+1+box.lines):r.tee:
		TPRINT " Page Up/Page Down ":l.tee:
    	END
    	ELSE
        	TPRINT @(28,start.line+1+box.lines):LINEDRAW.BEGIN:
                TPRINT r.tee:" Page Up/Page Down ":l.tee:LINEDRAW.END:
    	END
    END
    ELSE
        IF cur.screen < 1 AND max.screen < 1 THEN
                IF h.line = '-' THEN
                        TPRINT @(28,start.line+1+box.lines):STR(h.line,9):
                END
                ELSE
                        TPRINT @(28,start.line+1+box.lines):LINEDRAW.BEGIN:
                        TPRINT STR(h.line,9):LINEDRAW.END:
                END
                RETURN
        END
    	IF r.tee = '+' THEN
        	TPRINT @(28,start.line+1+box.lines):r.tee:
		TPRINT "     Page Up       ":l.tee:
    	END
    	ELSE
        	TPRINT @(28,start.line+1+box.lines):LINEDRAW.BEGIN:
                TPRINT r.tee:"     Page Up       ":l.tee:LINEDRAW.END:
    	END
    END
 

RETURN

Blank.Page:
    FOR I = 1 to box.lines-2
        TPRINT@(text.start+2, start.line+I):STR(" ",LENDP(tstr<I+cur.screen*(box.lines-2)>)):
    NEXT I
RETURN

light.label:
    If item.no <= int(Button.Array<1>/2) THEN
        spacing = 0 - ((int(Button.Array<1>/2)+1) - item.no)
        END
    ELSE 
        spacing = (item.no - (int(Button.Array<1>/2)))
        END
    TPRINT @(start.col + spacing - 1 +((item.no*Offset) - int (LENDP(Button.Array<item.no+1>)/2)) + LENDP(Button.Array<item.no+1>)+1, start.line + box.lines):
    CALL *INVERSE.B(0)
    TPRINT @(start.col + spacing - 1 +((item.no*Offset) - int (LENDP(Button.Array<item.no+1>)/2)), start.line + box.lines):
    CALL *INVERSE.B(1)
    TPRINT Button.Array<item.no+1>:
    CALL *INVERSE.B(0)
RETURN

unlight.label:
    If item.no <= int(Button.Array<1>/2) THEN
        spacing = 0 - ((int(Button.Array<1>/2)+1) - item.no)
        END
    ELSE 
        spacing = (item.no - (int(Button.Array<1>/2)))
        END
    TPRINT @(start.col + spacing - 1 +((item.no*Offset) - int (LENDP(Button.Array<item.no+1>)/2)) + LENDP(Button.Array<item.no+1>)+1, start.line + box.lines):
    CALL *INVERSE.B(0)
    TPRINT @(start.col + spacing - 1 +((item.no*Offset) - int (LENDP(Button.Array<item.no+1>)/2)), start.line + box.lines):
    CALL *INVERSE.B(0)
    TPRINT Button.Array<item.no+1>:
    CALL *INVERSE.B(0)
RETURN


Do.Labels:
    FOR I = 1 to Button.Array<1>
        IF I <= int(Button.Array<1>/2) THEN
            spacing = 0 - ((int(Button.Array<1>/2)+1) - I)
            END
        ELSE 
            spacing = (I - (int(Button.Array<1>/2)))
            END
        TPRINT @(start.col + spacing + ((I*Offset) - int (LENDP(Button.Array<I+1>)/2)), start.line + box.lines):Button.Array<I+1>:
    NEXT I

RETURN

UnDo.Labels:
    FOR I = 1 to Button.Array<1>
        IF I <= int(Button.Array<1>/2) THEN
            spacing = 0 - ((int(Button.Array<1>/2)+1) - I)
            END
        ELSE 
            spacing = (I - (int(Button.Array<1>/2)))
            END
        TPRINT @(start.col + spacing + ((I*Offset) - int (LENDP(Button.Array<I+1>)/2)), start.line + box.lines):STR(" ",LENDP(Button.Array<I+1>)):
    NEXT I

RETURN

screen.init:
    GOSUB format.labels
    GOSUB format.text
    CALL *DRAW.BOX.B(start.line, start.col, box.lines, width, 1)
    GOSUB Draw.Page
    GOSUB Do.Labels
    RETURN

format.text:
    cur.screen = 0
    tstr = ""
    numlines = 0
loop1:
    numlines += 1    
    temp = INDEX(textstr,@FM,1)
    IF ((temp <= width) AND (temp # 0)) THEN
        tstr<numlines> = textstr[1,temp-1]
        textstr = textstr[temp+1, LENDP(textstr)]
        GOTO loop1
        END
    IF LENDP(textstr) > width THEN
        temp = width-1
        LOOP UNTIL textstr[temp,1] = ' ' OR temp <= 0 DO
            temp -= 1
        REPEAT
        IF temp < width - int(width/4) THEN temp = width-1
        tstr<numlines> = textstr[1,temp]
        textstr = textstr[temp+1, LENDP(textstr)]
        GOTO loop1
        END
    ELSE
        IF LENDP(textstr) > 0 THEN
            tstr<numlines> = textstr
            END
        IF numlines < max.lines -2 THEN
            box.lines = numlines+2
            END
        ELSE
            box.lines = max.lines
            END
        max.screen = INT((numlines-1)/(box.lines-2))
        RETURN
        END

format.labels:
    item.no = selvalue
    IF selvalue < 0 THEN
        item.no = 1
        END
    IF selvalue > 4 THEN
        item.no =4
        END
    IF Button.Array<1> = 0 THEN
        Button.Array<1> = 3
        Button.Array<2> = "Ok"
		Button.Array<3> = "Cancel"
		Button.Array<4> = "Help"
		Help.number=3
		Default.list=1
        END
    button.width = 0
    FOR I = 1 to Button.Array<1>
        button.width += LENDP(Button.Array<I+1>) + 2
    NEXT I
    If width < button.width THEN width = button.width
    Offset = int(width/(Button.Array<1>+1))
    RETURN

key.init:
	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.PAGE.UP"
				KEY.PREVIOUS.PAGE=alt.record<i+1>
			CASE alt.record<i>="ALT.PAGE.DOWN"
				KEY.NEXT.PAGE=alt.record<i+1>
		END CASE
	NEXT i
	CLOSE alt.record
end.loop:
    string.array(1) = CHAR(27)
    string.array(2) = KEY.PREVIOUS.PAGE
    string.array(3) = KEY.NEXT.PAGE
    string.array(4) = " "
    string.array(5) = CARRIAGE.RETURN
    string.array(6) = KEY.MOVE.CURSOR.RIGHT
    string.array(7) = KEY.MOVE.CURSOR.LEFT
    string.codes(1) = ESCAPE
    string.codes(2) = PREV.PAGE
    string.codes(3) = NEXT.PAGE
    string.codes(4) = SEL.ACTION
    string.codes(5) = SEL.ACTION
    string.codes(6) = RIGHT.ARROW
    string.codes(7) = LEFT.ARROW

    CALL *TOKEN.SORT.B(KEYNUM, mat string.array, mat string.codes)

    FOR I = 1 to KEYNUM
        IF string.codes(I) = ESCAPE THEN ESC.KEY = I
    NEXT I

    MNEMOS = ""
    FOR I = 1 TO Button.Array<1>
        FOR J = 1 to LENDP(Button.Array<I+1>)
            IF Button.Array<I+1>[J,1] = UPCASE(Button.Array<I+1>[J,1]) THEN
                MNEMOS<I> = Button.Array<I+1>[J,1]
                GOTO out
                END
        NEXT J
out:
    NEXT I
RETURN
end.stuff:
	TTYGET tty$ ELSE NULL
	tty$=tmptty
	TTYSET tty$ ELSE NULL
	RETURN

END