tldm-universe/Ardent/UV/APP.PROGS/SORT.BOX.B

*******************************************************************************
*
*	New System Admin - This routine creates a box on the screen which
*		allows the user to page through a large data structure, and
*		select an entry.
*
*	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.
*	02/28/94 12710 WLG Fix to initialize num.lines to 1 if less than 1.
*	06/07/91 8408  DTM Made changes for the HELP routines.
*	05/31/91 8408  DPB Made changes for the HELP routines.
*	05/16/91 7673  DTM Changed More to Page Up/Page Down for boxes
*	05/13/91 8345  DTM changed print to tprints
*	04/08/91 8043  DTM Fixed TTY parts...
*	12/07/90 7673  DTM Routine first created and admin'd.
*******************************************************************************

SUBROUTINE SORT.BOX.B(title, start.line, num.lines, narray, array.count,val.count,select.val,option,sort.crit)

$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
EQU KEYNUM TO 7
DIM str.array(KEYNUM)
DIM str.codes(KEYNUM)
IF select.val < 1 THEN select.val = 1
IF num.lines < 1 THEN num.lines = 1
mnemos.string=""
array=narray
num.sort=array.count
GOSUB back.init

IF sort.crit >= 1 THEN GOSUB sort.array
If sort.crit < 0 THEN 
	sort.crit =  -sort.crit
	sort.sel  = 1
END
GOSUB screen.init

loop1:
    GOSUB draw.page
loop2:
    GOSUB highlight.item
loop3:
    temp = ""
    mnemos = 0
    left.over = ""
    input.code = 0
    TPRINT CURSOR.INVISIBLE:

    CALL *GET.TOKEN.B(25, 75, 100, KEYNUM, mat str.array, mat str.codes,                ESC.KEY, MNEMONIC, 0, 0, temp, left.over, input.code, mnemos)
    TPRINT CURSOR.VISIBLE:

	IF input.code = 0 and mnemos = 0 THEN GOTO loop3
    BEGIN CASE
    CASE input.code = SEL.ACTION
        GOSUB blank.screen
		GOSUB figure.select
        GOTO End.stuff
    CASE input.code = ESCAPE
        select.val = -1
        GOSUB blank.screen
        GOTO End.stuff
    CASE input.code = DOWN.ARROW
        GOSUB unlight.item
        select.val += 1
        IF select.val > array.count THEN select.val = array.count
        GOSUB set.cur.line
        IF MOD((select.val-1), num.lines) = 0 THEN
*
*			If sorting and go to new page, clear input data
*
			IF sort.crit # 0 THEN
				sort.sel=1
				Enter.col-=LENDP(mnemos.string)
				TPRINT @(Enter.col,Enter.start):STR(" ",LENDP(mnemos.string)):
				mnemos.string=""
			END
            GOSUB set.cur.screen
            GOTO loop1
        END
        GOTO loop2
    CASE input.code = UP.ARROW
        GOSUB unlight.item
        select.val -= 1
        IF select.val < 1 THEN select.val = 1
        GOSUB set.cur.line
        IF MOD(select.val, num.lines) = 0 THEN
*
*			If sorting and go to new page, clear input data
*
			IF sort.crit # 0 THEN
				sort.sel=1
				Enter.col-=LENDP(mnemos.string)
				TPRINT @(Enter.col,Enter.start):STR(" ",LENDP(mnemos.string)):
				mnemos.string=""
			END
            GOSUB set.cur.screen
            GOTO loop1
        END
        GOTO loop2
    CASE input.code = PREV.PAGE
        IF select.val = 1 THEN GOTO loop3
        GOSUB unlight.item
        select.val -= num.lines
        IF select.val < 1 THEN select.val = 1
		IF sort.crit # 0 THEN
			sort.sel=1
			Enter.col-=LENDP(mnemos.string)
			TPRINT @(Enter.col,Enter.start):STR(" ",LENDP(mnemos.string)):
			mnemos.string=""
		END
        GOSUB set.cur.line
        GOSUB set.cur.screen
        GOTO loop1
    CASE input.code = NEXT.PAGE
        IF select.val = array.count THEN GOTO loop3
        GOSUB unlight.item
        select.val += num.lines
        IF select.val > array.count THEN select.val = array.count
		IF sort.crit # 0 THEN
			sort.sel=1
			Enter.col-=LENDP(mnemos.string)
			TPRINT @(Enter.col,Enter.start):STR(" ",LENDP(mnemos.string)):
			mnemos.string=""
		END
        GOSUB set.cur.line
        GOSUB set.cur.screen
        GOTO loop1
	CASE input.code = 0
		IF sort.crit = 0 THEN GOTO loop3
		IF invert THEN
			tmp.char=UPCASE(mnemos)
			IF tmp.char=mnemos THEN tmp.char=DOWNCASE(mnemos)
			mnemos=tmp.char
		END
		temp.len=LENDP(mnemos.string)
		tmp.sel=select.val
		IF mnemos=BKSP.KEY THEN
			IF temp.len > 0 THEN
				TPRINT @(Enter.col-1,Enter.start):" ":
				Enter.col -=1
				sort.sel -= 2
				mnemos.string=mnemos.string[1,temp.len-1]
				temp.len -=1
				IF temp.len<1 OR mnemos.string="" THEN
					sort.sel=1
					GOSUB unlight.item
					select.val=1
					GOSUB set.cur.line
					IF cur.screen # int((select.val-1)/num.lines) THEN
            			GOSUB set.cur.screen
            			GOTO loop1
            		END
					GOTO loop2
				END
				select.val-=10
				IF select.val < 1 THEN select.val = 1
				GOSUB find.value
				select.val=tmp.sel
				IF new.select.val # tmp.sel THEN
        			GOSUB unlight.item
					select.val=new.select.val
					GOSUB set.cur.line
					IF cur.screen # int((select.val-1)/num.lines) THEN
            			GOSUB set.cur.screen
            			GOTO loop1
            		END
					GOTO loop2
				END
				ELSE
					GOTO loop3
				END
			END
			ELSE 
				TPRINT @(Enter.col,Enter.start):char(7):
				GOTO loop3
			END
		END
		ELSE
			mnemos.string:=mnemos
			GOSUB find.value
			IF find.error = 1 THEN
				TPRINT @(Enter.col,Enter.start):char(7):
				mnemos.string=mnemos.string[1,temp.len]
				GOTO loop3
			END
			ELSE
				TPRINT @(Enter.col,Enter.start):mnemos:
				Enter.col += 1
				IF tmp.sel # new.select.val THEN
        			GOSUB unlight.item
					select.val=new.select.val
					GOSUB set.cur.line
					IF cur.screen # int((select.val-1)/num.lines) THEN
            			GOSUB set.cur.screen
            			GOTO loop1
            		END
					GOTO loop2
				END
				ELSE
					GOTO loop3
				END
			END
		END
		GOTO loop1
    END CASE
	GOTO End.stuff
	RETURN

hilight.titles:
    TPRINT@(start.col+width+1,start.line-1):
    CALL *INVERSE.B(0)
    TPRINT@(start.col-2,start.line-1):
    CALL *INVERSE.B(1)
    TPRINT@(start.col-1,start.line-1):STR(" ",width+2):
    FOR J = 1 to val.count
        TPRINT@(start.col+val.widths<J>+((J-1)*tab), start.line-1):
        TPRINT title<J+1>:
    NEXT J
    TPRINT@(start.col+width+1,start.line-1):
    CALL *INVERSE.B(0)    
	RETURN

highlight.item:
    IF option # 1 THEN
*
*		Print inverse off bit
*
    	TPRINT@(start.col+width+1,start.line+(cur.line-1)):
    	CALL *INVERSE.B(0)
*
*		Print inverse on bit
*
    	TPRINT@(start.col-2,start.line+(cur.line-1)):
    	CALL *INVERSE.B(1)
		TPRINT @(start.col-1,start.line+ (cur.line-1)):STR(" ",width+2):
*
*		Print data
*
    	FOR J = 1 to val.count
       	TPRINT @(start.col+val.widths<J>+((J-1)*tab),start.line+(cur.line-1)):
        TPRINT array<select.val,J>:
    	NEXT J
    	TPRINT@(start.col+width+1,start.line+(cur.line-1)):
    	CALL *INVERSE.B(0)
    END
	RETURN

unlight.item:
    IF option # 1 THEN
    	TPRINT@(start.col-2,start.line+(cur.line-1)):" ":
    	TPRINT @(start.col-1,start.line+ (cur.line-1)):STR(" ",width+2):
    	FOR J = 1 to val.count
        TPRINT @(start.col+val.widths<J>+((J-1)*tab),start.line+(cur.line-1)):
        TPRINT array<select.val,J>:
    	NEXT J
    	TPRINT@(start.col+width+1,start.line+(cur.line-1)):" ":
    END
	RETURN

*
*	Draw data within box, including the PageUp/PageDown logic
*
draw.page:
	FOR I = 1 TO num.lines
    	TPRINT @(start.col-1,start.line+ (I-1)):STR(" ",width+2):
    	FOR J = 1 TO val.count
        TPRINT @(start.col+val.widths<J>+((J-1)*tab), start.line + ( I - 1)):
        TPRINT array<I+(cur.screen*num.lines),J>:
    	NEXT J
	NEXT I
	IF cur.screen < max.screen THEN
		IF cur.screen < 1 THEN
    		IF r.tee = "+" THEN
           		TPRINT @(28,start.line+num.lines):r.tee:
				TPRINT "     Page Down     ":l.tee:
    		END
    		ELSE
        		TPRINT @(28,start.line+num.lines):LINEDRAW.BEGIN:
				TPRINT r.tee:"     Page Down     ":l.tee:LINEDRAW.END:
    		END
			RETURN
		END
    	IF r.tee = "+" THEN
        	TPRINT @(28,start.line+num.lines):r.tee:
			TPRINT " Page Up/Page Down ":l.tee:
    	END
    	ELSE
        	TPRINT @(28,start.line+num.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+num.lines):STR(h.line,9):
			END
			ELSE
				TPRINT @(28,start.line+num.lines):LINEDRAW.BEGIN:
				TPRINT STR(h.line,9):LINEDRAW.END:
			END
			RETURN
		END
    	IF r.tee = '+' THEN
        	TPRINT @(28,start.line+num.lines):r.tee:
			TPRINT "     Page Up       ":l.tee:
    	END
    	ELSE
        	TPRINT @(28,start.line+num.lines):LINEDRAW.BEGIN:
			TPRINT r.tee:"     Page Up       ":l.tee:LINEDRAW.END:
    	END
	END
	RETURN

screen.init:
    IF select.val > array.count THEN
        select.val = array.count
    END
    max.screen = int((array.count-1)/num.lines)
    GOSUB set.cur.screen
    GOSUB set.cur.line
    GOSUB set.key.array

*
*	Set initial widths based on width of title headings
*
    val.widths = ""
    IF title<1>=0 THEN
        FOR I = 1 to val.count
            val.widths<I> = LENDP(title<I+1>)
        NEXT I
    END
    ELSE 
        FOR I = 1 to val.count
            val.widths<I> = 0
        NEXT I
    END
    
*
*	Set final field widths based on max values for any indivual field
*
    FOR I = 1 to array.count
        FOR J = 1 to val.count
            IF LENDP(array<I,J>) > val.widths<J> THEN
                val.widths<J> = LENDP(array<I,J>)
            END
        NEXT J
    NEXT I
    
*
*	Determine actual minimum width
*
    width = SUM(val.widths)
    
    IF width < 50 AND val.count < 3 THEN
        width = width + (8*(val.count-1))
        tab = 8
    END
    ELSE
        width = width + (4*(val.count-1))
        tab = 4
    END

    IF title<1> # 0 THEN
        IF width < LENDP(title) THEN
            width = LENDP(title)
        END
    END
    
	IF width < 19  THEN width = 19

*
*	Determine starting location of box
*
    start.col = 40 - int((width/2)+ 2)

    
    FOR I = val.count to 2 STEP -1
        val.widths<I> = val.widths<I-1>
    NEXT I

    val.widths<1> = 0
    
    FOR I = 2 to val.count
        val.widths<I> = val.widths<I>+val.widths<I-1>
    NEXT I
    
    TPRINT @(start.col-3,start.line-1):lu.corner:
*
*	Print box
*
	TPRINT STR(h.line,width+4):ru.corner:
    TPRINT @(start.col-3,start.line+num.lines):ll.corner:
	TPRINT STR(h.line,width+4):rl.corner:
    
    FOR I = 0 to num.lines-1
        TPRINT @(start.col-3,start.line +I):v.line:STR(" ",width+4):v.line:
    NEXT I

    IF title # "" THEN
        IF title<1> # 0 THEN
            TPRINT @(start.col-2+(int(width/2)-int(LENDP(title)/2))+LENDP(title)+3,start.line-1):
            CALL *INVERSE.B(0)
            TPRINT @(start.col-2+(int(width/2)-int(LENDP(title)/2)),start.line-1):
            CALL *INVERSE.B(1)
            TPRINT " ":title:" ":
            CALL *INVERSE.B(0)
        END
        ELSE
            gosub hilight.titles:
        END
    END
*
*	If using selection box, then draw box and determine starting locations
*
	IF sort.crit # 0 THEN
		CALL *DRAW.BOX.B(start.line+num.lines,start.col-3,1,width+4,1)
		TPRINT @(start.col-3,start.line+num.lines):l.tee:
		TPRINT @(start.col+width+2,start.line+num.lines):r.tee:
		TPRINT @(start.col-3+1,start.line+num.lines+1):"?":
		Enter.start=start.line+num.lines+1
		Enter.col=start.col-1
	END
	RETURN

blank.screen:
    FOR I = 0 to num.lines+1
        TPRINT @(start.col-3,start.line-1+I):STR(" ",width+6):
    NEXT I
	IF sort.crit # 0 THEN
		CALL *DRAW.BOX.B(start.line+num.lines,start.col-3,1,width+4,0)
	END
	RETURN

set.cur.screen:
    cur.screen = int((select.val-1)/num.lines)
	RETURN

set.cur.line:
    cur.line = mod(select.val,num.lines)
    IF cur.line = 0 THEN
        cur.line = num.lines
    END
	RETURN

set.key.array:
    str.array(1) = CHAR(27)
    str.array(2) = KEY.MOVE.CURSOR.UP
    str.array(3) = " "
    str.array(4) = KEY.MOVE.CURSOR.DOWN
    str.array(5) = KEY.PREVIOUS.PAGE
    str.array(6) = KEY.NEXT.PAGE
    str.array(7) = CARRIAGE.RETURN
    str.codes(1) = ESCAPE
    str.codes(2) = UP.ARROW
    str.codes(3) = SEL.ACTION
    str.codes(4) = DOWN.ARROW
    str.codes(5) = PREV.PAGE
    str.codes(6) = NEXT.PAGE
    str.codes(7) = SEL.ACTION

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

    FOR I = 1 to KEYNUM
        IF str.codes(I) = ESCAPE then ESC.KEY = I
    NEXT I

RETURN

find.value:
	find.error=0
	FOR i=select.val TO num.sort
		IF array<i,sort.crit>[1,sort.sel]=mnemos.string THEN
			sort.sel +=1
		   	new.select.val=i
			RETURN
		END
	NEXT i
	find.error=1
	RETURN

sort.array:
	sort.sel=1
	tmp.array=""
	FLAG=num.sort
	LOOP 
	UNTIL FLAG=0 DO
		num.sort = FLAG - 1
		FLAG=0
		FOR j=1 TO num.sort 
			IF array<j,sort.crit> > array<j+1,sort.crit> THEN
				tmp.array=array<j>
				array<j>=array<j+1>
				array<j+1>=tmp.array
				FLAG=j
			END
		NEXT j
	REPEAT
	num.sort=array.count
	RETURN

back.init:
	TTYGET tty$ ELSE NULL
* Set things up so that CR can also select
	tmptty=tty$
	CRMODE.ICRNL=0
	CRMODE.ONLCR=0
	invert=CASE.INVERT
	IF CC.ERASE # "" THEN
		BKSP.KEY = CHAR(CC.ERASE)
		IF ECHO.ERASE # ECHOE$BSB THEN
			ECHO.ERASE = ECHOE$BSB
		END
		IF BACKSPACE = "" THEN
			BACKSPACE = CHAR(8)
		END
	END
	TTYSET tty$ ELSE NULL
	RETURN

figure.select:
	IF sort.crit=0 THEN RETURN
	FOR i=1 to num.sort
		IF array<select.val,sort.crit>=narray<i,sort.crit> THEN
			select.val=i
			RETURN
		END
	NEXT i
	RETURN

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