SUBROUTINE MULTI.WINDOW(COR,INLIST,OUTLIST,PL,MULTI,N,TITLE,DTYPE,INSERT.OK)
* variable dtype setup as follows:
* 0 = attributes, 1 = sub-valued, 2 = multi-sub-valued
* if multi then multiple selections are allowed during the call
* else the position where the single selection was found is returned in multi
* data itself is always returned in outlist
* n = dcount of inlist delimiters
*
PLACE = DTYPE + 1
GOSUB 300
IF INSERT.OK THEN IMSG = " 'I'nsert," ELSE IMSG = ''
XIT.MSG = " or 'E'xit "
SCOL = COR<1,1>
SROW = COR<1,2>
ECOL = COR<1,3>
EROW = COR<1,4>
WIDTH = ECOL-SCOL
DEPTH = EROW - SROW
GIVE.POS = MULTI<2>
JUST.DISPLAY = MULTI<3>
DELETE.FROM.LIST = MULTI<4>
DELETE.ANYWAY = MULTI<5>
HAVE.FRAME = MULTI<6>
N.OFFSET = MULTI<7> + 0
DO.NOT.CENTER = MULTI<8>
MULTI = MULTI<1>
JUST = 'L#':WIDTH
IF NOT(HAVE.FRAME) THEN
IF DO.NOT.CENTER THEN
WHERE = 1
END ELSE
CALL CENTERED(TITLE,WHERE,WIDTH)
END
BORDER = STR('-',WIDTH+1)
FOR J = SROW TO EROW
PRINT @(SCOL,J):'|' JUST:'|'
NEXT J
PRINT @(SCOL,SROW-1):BORDER
PRINT @(WHERE+SCOL,SROW):TITLE
PRINT @(WHERE+SCOL,SROW+1):STR('_',LEN(TITLE))
PRINT @(SCOL,J):BORDER
END ; * the first time through, they want the frame
SROW = SROW + 2
DEPTH = EROW - SROW
EQU DELETE.WORD TO " 'D'elete,"
SEL = 'T'
DONE = 0
LOOP
EMSG = ''
OUTLIST = TRIM(OUTLIST,CHAR(253))
IF JUST.DISPLAY THEN
SEL = 'T'
DONE = 1
END ELSE
IF OUTLIST = '' THEN UMSG = '' ELSE UMSG = DELETE.WORD
IF UMSG = '' AND DELETE.FROM.LIST THEN UMSG = DELETE.WORD
IF SEL = '' THEN
PRINT PL:'Enter selection or':IMSG:UMSG:" 'T'op, 'F'orward, 'B'ack":XIT.MSG:
INPUT SEL,3:_
END
SEL = OCONV(SEL,'MCU')
END
BEGIN CASE
CASE SEL[1,1] = 'F' OR SEL = ''
IF LSEL < N THEN
FSEL = LSEL + 1
LSEL = LSEL + DEPTH
GOSUB 100
END ELSE EMSG = 'You are viewing the last page'
CASE SEL[1,1] = 'E'
DONE = 1
CASE NUM(SEL)
IF INT(SEL) = SEL AND SEL > 0 AND SEL <= N THEN
APOS = SEL
GOSUB 200
LOCATE(SEL,OUTLIST,1;CVAL) THEN
EMSG = 'Choice ':TRIM(SEL):' already included in list'
END ELSE
OUTLIST<1,CVAL> = SEL
IF GIVE.POS THEN OUTLIST<2,CVAL> = APOS
GOSUB 400
GOSUB 100
IF NOT(MULTI) THEN
MULTI = APOS
DONE = 1
END
END
END ELSE EMSG = TRIM(SEL):' is invalid'
CASE SEL[1,1] = 'T'
FSEL = 1
LSEL = DEPTH
GOSUB 100
CASE SEL[1,1] = 'B'
IF (LSEL - (DEPTH+1)) > 0 THEN
FSEL = FSEL - DEPTH
LSEL = LSEL - DEPTH
GOSUB 100
END ELSE EMSG = 'You are viewing the first page'
CASE SEL = 'I' AND INSERT.OK
PRINT PL:'Enter item to insert or <RETURN> ':
INPUT ADD.ITEM:
IF ADD.ITEM # '' THEN
GOSUB 300
IF DTYPE THEN
LOCATE(ADD.ITEM,INLIST,TO.USE<1>,TO.USE<2>;APOS) ELSE GOSUB 500
END ELSE
LOCATE(ADD.ITEM,INLIST;APOS) ELSE GOSUB 500
END
END ; * else nothing was chosen
CASE (SEL[1,1] = 'D' AND OUTLIST # '') OR (SEL[1,1] = 'D' AND DELETE.FROM.LIST)
PRINT PL:'Enter choice to delete or <RETURN> ':
INPUT SEL,3:_
IF NUM(SEL) AND SEL # '' THEN
GOSUB 200
LOCATE(SEL,OUTLIST,1;DPOS) ELSE DPOS = 0
IF DPOS THEN
OUTLIST = DELETE(OUTLIST,1,DPOS,0)
IF GIVE.POS THEN OUTLIST = DELETE(OUTLIST,2,DPOS,0)
END
GOSUB 300
IF DTYPE THEN
LOCATE(SEL,INLIST,TO.USE<1>,TO.USE<2>;APOS) THEN GOSUB 400 ELSE APOS = 0
END ELSE
LOCATE(SEL,INLIST;APOS) THEN GOSUB 400 ELSE APOS = 0
END
IF APOS AND DELETE.FROM.LIST THEN
TO.USE<PLACE> = APOS
INLIST = DELETE(INLIST,TO.USE<1>,TO.USE<2>,TO.USE<3>)
N = N - 1
END
IF DPOS OR DELETE.ANYWAY THEN GOSUB 100 ELSE EMSG = 'Choice ':
TRIM(SEL):' is not included in list'
END ELSE SEL = ''
CASE 1
EMSG = TRIM(SEL):' is invalid'
END CASE
UNTIL DONE DO
IF EMSG = '' THEN SEL = '' ELSE GOSUB 900
REPEAT
RETURN
100 * print page
CTR = 1
FOR I = FSEL TO LSEL
IF I <= N THEN
SEL = I
GOSUB 200
LOCATE(SEL,OUTLIST,1;IPOS) THEN TAKEN = '*' ELSE TAKEN = ''
SEL = '| ':(I+N.OFFSET) 'R#3 ':TAKEN 'L#2':SEL
END ELSE SEL = '| '
PRINT @(SCOL,SROW+CTR):SEL JUST
CTR = CTR + 1
NEXT I
SEL = ''
RETURN
200 * where is the choice?
TO.USE<PLACE> = SEL
SEL = INLIST<TO.USE<1>,TO.USE<2>,TO.USE<3>>
RETURN
300 * are we dealing with am/vm/svm?
TO.USE = 1
TO.USE<3> = 0
IF DTYPE = 2 THEN TO.USE<2> = 1 ELSE TO.USE<2> = 0
RETURN
400 * determine current page
SPOT = MOD(APOS,DEPTH)
IF SPOT THEN
FSEL = (APOS-SPOT)+1
LSEL = (FSEL+DEPTH)-1
END ELSE
LSEL = APOS
FSEL = (LSEL-DEPTH)+1
END
RETURN
500 * insert new item
TO.USE<PLACE> = APOS
INLIST = INSERT(INLIST,TO.USE<1>,TO.USE<2>,TO.USE<3>,ADD.ITEM)
N = N + 1
OUTLIST<1,-1> = ADD.ITEM
GOSUB 400
GOSUB 100
IF NOT(MULTI) THEN
MULTI = APOS
DONE = 1
END
RETURN
900 * error handling
PRINT PL:EMSG:', please re-enter ':
INPUT SEL,3:_
RETURN
END
|
