The GETDSP function
**************************************************************
* GETDSPC *
* This file is used to compile the GETDSP routine *
* *
* Author: Trevor D. Seeney, SENTINEX Inc. *
**************************************************************
A R GET CLRL(*NO)
A B 1919 B 1 2
A R PUT KEEP ASSUME
A B 1919 B 1 2
**************************************************************
* GETDSPX *
* This file is used during the execution of GETDSP *
* *
* Author: Trevor D. Seeney, SENTINEX Inc. *
**************************************************************
A R GET USRDFN
A R PUT KEEP ASSUME
A B 1919 B 1 2
/* ***************************************************************** */
/* * GETDSP * */
/* * This program captures the screen image into a variable * */
/* * * */
/* * Author: Trevor D. Seeney, SENTINEX Inc. * */
/* ***************************************************************** */
PGM
DCL VAR(&CTL) TYPE(*CHAR) LEN(7) +
VALUE(X'00021000730462')
DCLF FILE(GETDSPC)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSG) TYPE(*CHAR) LEN(200)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(200)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGL) TYPE(*CHAR) LEN(10)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
/* * Create a data area to store the image * */
CHKOBJ OBJ(QTEMP/GETDSP) OBJTYPE(*DTAARA)
MONMSG MSGID(CPF9800) EXEC(DO)
RCVMSG MSGTYPE(*EXCP)
CRTDTAARA DTAARA(QTEMP/GETDSP) TYPE(*CHAR) LEN(1920)
ENDDO
/* * Capture the image * */
OVRDSPF FILE(GETDSPC) TOFILE(GETDSPX) LVLCHK(*NO)
CHGVAR VAR(%SST(&B 1 7)) VALUE(&CTL)
SNDRCVF RCDFMT(GET)
CHGDTAARA DTAARA(QTEMP/GETDSP (1 1919)) VALUE(&B)
CHGDTAARA DTAARA(QTEMP/GETDSP (1920 1)) VALUE(X'20')
RETURN
ERROR:
MSGD: RCVMSG MSGTYPE(*DIAG) MSG(&MSG) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGL)
IF COND(&MSGID *NE ' ') THEN(DO)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGL/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO CMDLBL(MSGD)
ENDDO
RCVMSG MSGTYPE(*EXCP) MSG(&MSG) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGL)
IF COND(&MSGID *NE ' ') THEN(SNDPGMMSG +
MSGID(&MSGID) MSGF(&MSGL/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE))
ENDPGM
Using GETDSP
The CL program code that follows will use GETDSP
to roll the current contents of the screen upwards, one
line at a time with wrap around, until the first line is
back at the top of the display.
QCLSRC
source:
The RollUp Program
/* ***************************************************************** */
/* * This program rolls the screen up * */
/* * * */
/* * Author: Trevor D. Seeney, SENTINEX Inc. * */
/* ***************************************************************** */
PGM
/* * Working variables * */
DCLF FILE(GETDSPC)
DCL VAR(&CTL) TYPE(*CHAR) LEN(7) +
VALUE(X'00021000730462')
DCL VAR(&C) TYPE(*CHAR) LEN(1920)
DCL VAR(&I) TYPE(*DEC) LEN(2 0)
/* * Standard Error Handling Declaratives * */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSG) TYPE(*CHAR) LEN(200)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(200)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGL) TYPE(*CHAR) LEN(10)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
/* * Get Screen Image * */
OVRDSPF FILE(GETDSPC) TOFILE(GETDSPX) +
WAITRCD(5) LVLCHK(*NO)
CHGVAR VAR(%SST(&B 1 7)) VALUE(&CTL)
SNDRCVF RCDFMT(GET)
CHGVAR VAR(%SST(&C 1 1919)) VALUE(&B)
REPEAT:
CHGVAR VAR(&B) VALUE(%SST(&C 2 1919))
AGAIN:
/* * Perform Screen Modification * */
SNDF RCDFMT(PUT)
SLOW
CHGVAR VAR(&C) VALUE( %SST(&C 81 1840) || +
%SST(&C 1 80))
CHGVAR VAR(&B) VALUE(%SST(&C 2 1919))
CHGVAR VAR(&I) VALUE(&I + 1)
IF COND(&I *LT 24) THEN(GOTO CMDLBL(AGAIN))
/* * Wait for user response, if none then repeat * */
SNDRCVF RCDFMT(PUT) WAIT(*NO)
WAIT
MONMSG MSGID(CPF0889) EXEC(DO)
RCVMSG MSGTYPE(*EXCP)
CHGVAR VAR(&I) VALUE(0)
GOTO CMDLBL(REPEAT)
ENDDO
RETURN
/* * Standard Error Handling * */
ERROR:
MSGD: RCVMSG MSGTYPE(*DIAG) MSG(&MSG) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGL)
IF COND(&MSGID *NE ' ') THEN(DO)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGL/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO CMDLBL(MSGD)
ENDDO
RCVMSG MSGTYPE(*EXCP) MSG(&MSG) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGL)
IF COND(&MSGID *NE ' ') THEN(SNDPGMMSG +
MSGID(&MSGID) MSGF(&MSGL/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE))
ENDPGM
|
