548 lines
14 KiB
Plaintext
Executable File
548 lines
14 KiB
Plaintext
Executable File
*******************************************************************************
|
|
*
|
|
* 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
|