How to find the screensize when at the READY prompt?
I could assume everyone is using 24x80, or create my fields always on the first line of the screen, but if anyone has a clue as how to find out the real geometry, I'd would love to see you share it with all of us.
Joined: 30 Nov 2013 Posts: 917 Location: The Universe
In Rexx you have SYSVAR(SYSLTERM) and SYSVAR(SYSWTERM). In CLIST you have &SYSLTERM and &SYSWTERM. I'm not so sure how useful screen geometry would be useful at the READY prompt, but here's a mini command processor. In Rexx or CLIST the output can be OUTTRAPed.
Code:
GEOMETRY RSECT Establish program CSECT
GEOMETRY AMODE 31 Establish program AMODE
GEOMETRY RMODE ANY Establish program RMODE
PUSH PRINT
PRINT NOGEN
IKJCPPL , Define TSO CPPL
RCBUF EQU 6+((CPPLCBUF-CPPL)/4) Define registers
RPSCB EQU 6+((CPPLPSCB-CPPL)/4) containing CPPL
RECT EQU 6+((CPPLECT-CPPL)/4) data
RUPT EQU 6+((CPPLUPT-CPPL)/4)
SPACE 1
IKJIOPL , Define TSO IOPL
IOPLSIZE EQU *-IOPL
EJECT
WA DSECT Define the work area
SAVEAREA DS 9D Establish 72 byte save area
MYIOPL DS XL(IOPLSIZE),0D Storage for the IOPL
DWORK DS D Double word work area
PUTLPB PUTLINE MF=L PUTLINE parameter block
OLD DS 2A PUTLINE Output Line Descriptor
ECB DS F ECB for PUTLINE
MSG DS 2AL2,CL80 Message build area
WORK DS C' NNN',0D Conversion work area
WASIZE EQU *-WA Work area size
POP PRINT
EJECT
GEOMETRY RSECT Return to program CSECT
USING WA,11 Establish work area addressability
USING *,12 Establishprogram addressability
SAVE (14,12),,* Save registers
LR 12,15 Prepare program base register
LM 6,9,0(1) Load CPPL into regs 6 through 9
LA 5,WASIZE Load work area length
GETMAIN RU,LV=(5) Get storage for the work area
SR 15,15 Set reg 15 = 0
LR 4,1 Copy work area address to reg 4 and
LR 11,1 reg 11
MVCL 4,14 Clear the work area
LA 15,SAVEAREA Load addr of the save area
ST 13,4(,15) Add save area to the
ST 15,8(,13) save area chain
LR 13,15 Establish new save area pointer
GTSIZE , Get the terminal geometry
LTR 0,0 Test if 2D
BNZ FMTSCRN Br if so
* ----+----1----+----2----+
MVC MSG+4(25),=C'GEO002I THE LINE SIZE IS '
LA 14,MSG+4+25
CVD 1,DWORK
MVC WORK,=X'40202120'
LA 1,WORK+L'WORK-1
EDMK WORK,DWORK+6
LR 0,1
LA 1,WORK+L'WORK
SR 1,0
LR 15,1
MVCL 14,0
B WRITELN
* ----+----1----+----2--
FMTSCRN MVC MSG+4(22),=C'GEO001I THE SCREEN IS '
LA 14,MSG+4+22
LR 2,1 Copy line size to reg 2
CVD 0,DWORK Convert lines on screen
MVC WORK,=X'40202120'
LA 1,WORK+L'WORK-1
EDMK WORK,DWORK+6
LR 0,1
LA 1,WORK+L'WORK
SR 1,0
LR 15,1
MVCL 14,0
MVC 0(3,14),=C' X '
LA 14,3(,14)
CVD 2,DWORK Convert screen width
MVC WORK,=X'40202120'
LA 1,WORK+L'WORK-1
EDMK WORK,DWORK+6
LR 0,1
LA 1,WORK+L'WORK
SR 1,0
LR 15,1
MVCL 14,0
WRITELN LA 1,MSG Compute the line size
SR 14,1
STH 14,0(,1)
LA 0,1 Prepare the PUTLINE
STM 0,1,OLD Output Line Descriptor
PUTLINE MF=(E,MYIOPL),PARM=PUTLPB,OUTPUT=OLD, Write the ->
UPT=(RUPT),ECT=(RECT),ECB=ECB completed line
L 13,4(,13) Load addr of the higher save area
LA 0,WASIZE Free the work area
FREEMAIN RU,LV=(0),A=(11)
RETURN (14,12),T,RC=0 Restore registers & return
DC 0D'0'
LTORG ,
DC 0D'0'
END GEOMETRY
Joined: 07 Feb 2009 Posts: 1306 Location: Vilnius, Lithuania
Steve,
The reason I need this is to enforce the "FirstName LastName" rule for "that" system. If I detect that a user doesn't have a valid name, I want to use data stream programming to force them to enter a valid name and it would be nice to do that in two lines.
I'm sure you could come up with something far more sophisticated, but I'll be sitting in Vilnius from Sunday for at least three weeks and I need to keep myself busy...
