tldm-universe/Ardent/UV/APP.PROGS/CINPUT.B
2024-09-09 17:51:08 -04:00

335 lines
9.9 KiB
Plaintext
Executable File

*******************************************************************************
*
* New System Admin - This is an input routine which recognizes special
* keys, and will return a special code if the key is pressed.
*
* 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.
* 10/30/96 19533 JC Fix special character handling when NLS on.
* 05/15/96 18330 LDG Changed LEN() function to LENDP() for NLS DBCS
* 10/18/91 8834 DPB Added -(length) option for wrapping field data.
* 06/14/91 8477 DTM Fixed input of newlines
* 05/13/91 8345 DTM changed print to tprint
* 4/25/91 8222 DTM Added inline editing capability
* 1/12/91 7818 DTM Changed function into CINPUT, modified NINPUT to all
* upper case/lower case translation.
*******************************************************************************
SUBROUTINE CINPUT(PRPT, DATA.BUFFER, SPECIAL.TYPE, LENGTH,case.value)
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
EQU SPECIAL.ERASE TO -2
EQU SPECIAL.RETURN TO -3
IF LENGTH # ABS(LENGTH) THEN wrap = 1 ELSE wrap = 0
LENGTH = ABS(LENGTH)
IF LENGTH <= 0 THEN LENGTH=1
SPECIAL = FALSE
if wrap = 1 AND (LENDP(DATA.BUFFER) > LENGTH)
THEN
y = LENDP(DATA.BUFFER)
z = DIV(LENGTH,2)
x = MOD(y,z)
SAVE = DATA.BUFFER[1,y-(x+z)]
DATA.BUFFER = DATA.BUFFER[y-(x+z)+1,y]
END
ELSE
SAVE = ""
END
TEST.BUFFER = ""
LEFT.OVER = ""
****************************************************************************
*If case.value=1 THEN change case on all input, UPPER case by default.
****************************************************************************
GOSUB INIT.LABEL:
PROMPT PRPT
TPRINT PRPT:
IF DATA.BUFFER # NULL THEN
TPRINT DATA.BUFFER:
END
START.LABEL:
CALL *GET.TA.BUF.B(1,1,0,0,INPUT.CHARACTER)
IF case.value=1 THEN
tmp.char=UPCASE(INPUT.CHARACTER)
IF tmp.char=INPUT.CHARACTER THEN
tmp.char=DOWNCASE(INPUT.CHARACTER)
END
INPUT.CHARACTER=tmp.char
END
SPECIAL.TYPE = ""
GOSUB CHECK.FOR.SPECIAL
IF SPECIAL = TRUE THEN
IF SPECIAL.TYPE = SPECIAL.ERASE THEN
IF LENDP(DATA.BUFFER) # 0 THEN
IF (SEQ(DATA.BUFFER[1]) >31 AND SEQ(DATA.BUFFER[1]) <127) THEN
TPRINT BACKSPACE:" ":BACKSPACE:
END
DATA.BUFFER = DATA.BUFFER[1,LENDP(DATA.BUFFER) - 1]
IF wrap = 1 THEN
IF LENDP(DATA.BUFFER) < DIV(LENGTH,2)
THEN
IF SAVE # "" THEN
TPRINT STR(BACKSPACE,LENDP(DATA.BUFFER)):STR(" ",LENDP(DATA.BUFFER)):STR(BACKSPACE,LENDP(DATA.BUFFER)):
DATA.BUFFER = SAVE[LENDP(SAVE)-DIV(LENGTH,2)+1,LENDP(SAVE)]:DATA.BUFFER
TPRINT DATA.BUFFER:
SAVE = SAVE[1,LENDP(SAVE)-DIV(LENGTH,2)]
END
END
END
END
GOTO START.LABEL
END
ELSE IF SPECIAL.TYPE = SPECIAL.RETURN THEN
SPECIAL.TYPE = 0
GOTO END.ROUTINE
END
ELSE GOTO END.ROUTINE
END
IF LENDP(DATA.BUFFER) < LENGTH THEN
TPRINT INPUT.CHARACTER:
DATA.BUFFER := INPUT.CHARACTER
END
ELSE
IF wrap = 1 THEN
X = DIV (LENDP(DATA.BUFFER),2)
SAVE := DATA.BUFFER[1,X]
DATA.BUFFER = DATA.BUFFER[X+1,LENDP(DATA.BUFFER)]
TPRINT STR(BACKSPACE,LENGTH):STR(" ",LENGTH):STR(BACKSPACE,LENGTH):
TPRINT DATA.BUFFER:INPUT.CHARACTER:
DATA.BUFFER := INPUT.CHARACTER
END
ELSE
TPRINT @SYS.BELL:
END
END
GOTO START.LABEL
CHECK.FOR.SPECIAL:
SPECIAL = TRUE
IF INPUT.CHARACTER = CARRIAGE.RETURN THEN
SPECIAL.TYPE = SPECIAL.RETURN
RETURN
END
FOR I = 1 TO 10
IF INPUT.CHARACTER[1,1] = MO.KEYS<I,1>[1,1] THEN
IF LEN(MO.KEYS<I,1>) = 1 AND LEN(INPUT.CHARACTER) = 1 THEN
TESTING = ""
INPUT TESTING,-1
IF TESTING = 1 THEN
INPUT.CHARACTER = ""
INPUTCLEAR
SPECIAL = FALSE
RETURN
END
SPECIAL.TYPE = MO.KEYS<I,2>
IF LEN(INPUT.CHARACTER) > 1 THEN
LEFT.OVER = INPUT.CHARACTER[LEN(INPUT.CHARACTER)-1]
TPRINT LEFT.OVER
END
GOTO LOOP.END
END
ELSE IF LEN(MO.KEYS<I,1>) > 1 THEN
IF LEN(INPUT.CHARACTER) = 1 THEN
TEST.BUFFER = INPUT.CHARACTER
CALL *GET.TA.BUF.B(0,LEN(MO.KEYS<I,1>)-1,25,100,INPUT.CHARACTER)
IF INPUT.CHARACTER = "" THEN
INPUT.CHARACTER = TEST.BUFFER
END
ELSE
TEST.BUFFER := INPUT.CHARACTER
IF TEST.BUFFER = MO.KEYS<I,1> THEN
SPECIAL.TYPE = MO.KEYS<I,2>
GOTO LOOP.END
END
ELSE
INPUT.CHARACTER = TEST.BUFFER
END
END
END
ELSE IF INPUT.CHARACTER[1,LEN(MO.KEYS<I,1>)] = MO.KEYS<I,1> THEN
SPECIAL.TYPE = MO.KEYS<I,2>
LEFT.OVER = INPUT.CHARACTER[LEN(INPUT.CHARACTER)-LEN(MO.KEYS<I,1>)]
TPRINT LEFT.OVER:
GOTO LOOP.END
END
END
END
NEXT I
LOOP.END:
IF SPECIAL.TYPE # "" THEN
BEGIN CASE
CASE SPECIAL.TYPE=ESCAPE
DATA.BUFFER = ""
SAVE = ""
CASE SPECIAL.TYPE=UP.ARROW
DATA.BUFFER = ""
SAVE = ""
CASE SPECIAL.TYPE=DOWN.ARROW
DATA.BUFFER = ""
SAVE = ""
CASE SPECIAL.TYPE=F.1
DATA.BUFFER = ""
SAVE = ""
CASE SPECIAL.TYPE=F.10
DATA.BUFFER = ""
SAVE = ""
CASE SPECIAL.TYPE=F.4
DATA.BUFFER = ""
SAVE = ""
CASE SPECIAL.TYPE=PREV.PAGE
DATA.BUFFER = ""
SAVE = ""
CASE SPECIAL.TYPE=NEXT.PAGE
DATA.BUFFER = ""
SAVE = ""
END CASE
RETURN
END
SPECIAL = FALSE
RETURN
INIT.LABEL:
IF MO.INITIALIZED # TRUE OR MO.TERM.TYPE # TERMINAL.NAME
THEN
TTYGET tty$ ELSE NULL
IF CC.ERASE # "" THEN
BKSP.KEY = CHAR(CC.ERASE)
IF ECHO.ERASE # ECHOE$BSB THEN
ECHO.ERASE = ECHOE$BSB
TTYSET tty$ ELSE NULL
END
END
IF BACKSPACE = "" THEN
BACKSPACE = CHAR(8)
END
MO.TERM.TYPE = TERMINAL.NAME
MO.INITIALIZED = TRUE
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.4"
KEY.FUNCTION.4=alt.record<i+1>
CASE alt.record<i>="ALT.F.10"
KEY.FUNCTION.10=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:
MO.KEYS<1,1>=CHAR(27)
MO.KEYS<2,1>=KEY.FUNCTION.1
IF KEY.FUNCTION.1 ='' THEN ;* set up default to be ? if not found
MO.KEYS<2,1>=char(63)
END
MO.KEYS<3,1>=KEY.MOVE.CURSOR.DOWN
MO.KEYS<4,1>=KEY.MOVE.CURSOR.UP
MO.KEYS<5,1>=KEY.MOVE.CURSOR.LEFT
MO.KEYS<6,1>=BKSP.KEY
MO.KEYS<7,1>=KEY.FUNCTION.10 ;* set up default to be control-T if not found
IF KEY.FUNCTION.10 = '' THEN
MO.KEYS<7,1>=char(20)
END
MO.KEYS<8,1>=KEY.PREVIOUS.PAGE
MO.KEYS<9,1>=KEY.NEXT.PAGE
MO.KEYS<10,1>=KEY.FUNCTION.4
MO.KEYS<1,2>=ESCAPE
MO.KEYS<2,2>=F.1
MO.KEYS<3,2>=DOWN.ARROW
MO.KEYS<4,2>=UP.ARROW
MO.KEYS<5,2>=SPECIAL.ERASE
MO.KEYS<6,2>=SPECIAL.ERASE
MO.KEYS<7,2>=F.10
MO.KEYS<8,2>=PREV.PAGE
MO.KEYS<9,2>=NEXT.PAGE
MO.KEYS<10,2>=F.4
FOR I = 1 TO 8
FOR J = I+1 TO 9
IF LEN(MO.KEYS<I,1>) < LEN(MO.KEYS<J,1>)
THEN
TEMP = MO.KEYS<I,1>
MO.KEYS<I,1> = MO.KEYS<J,1>
MO.KEYS<J,1> = TEMP
TEMP = MO.KEYS<I,2>
MO.KEYS<I,2> = MO.KEYS<J,2>
MO.KEYS<J,2> = TEMP
END
NEXT J
NEXT I
MO.KEYS<1,3> = LEN(MO.KEYS<1,1>)
END
TTYGET tty$ ELSE NULL
tmptty=""
tmptty=tty$
CRMODE.ICRNL=0
CRMODE.ONLCR=0
TTYSET tty$ ELSE NULL
RETURN
END.ROUTINE:
DATA.BUFFER = SAVE:DATA.BUFFER
CONVERT char(10) TO "" IN DATA.BUFFER
TTYGET tty$ ELSE NULL
tty$=tmptty
TTYSET tty$ ELSE NULL
RETURN
END