XGSBOX ;SFISC/VYD - screen rectengular region primitives ;10/31/94 15:38
;;8.0;KERNEL;;Jul 10, 1995
FRAME(T,L,B,R,A,C) ;draw a border
;TOP,LEFT,BOTTOM,RIGHT,ATTRIBUTE,frame character
N %,%L2,%R2,M,S,X,Y ;M=middle S=string
N XGSAVATR
I B'>T N IOBLC,IOBRC S (IOBLC,IOBRC)=IOHL ;to draw horizontal line
I R'>L N IOTRC,IOBRC S (IOTRC,IOBRC)=IOVL ;to draw vertical line
S M=R-L-1
S %L2=L+1,%R2=R+1
;if frame character passed set frame parts to it, disable graphics
S:$L($G(C)) (IOBLC,IOBRC,IOHL,IOTLC,IOTRC,IOVL)=C
S XGSAVATR=XGCURATR ;save current screen attributes
W $$CHG^XGSA($G(A)_$S($L($G(C)):"",1:"G1")) ;turn on gr attr & leave on
S S=IOTLC_$TR($J("",M)," ",IOHL)_IOTRC
S $E(XGSCRN(T,0),%L2,%R2)=S
S $E(XGSCRN(T,1),%L2,%R2)=$TR($J("",(R-L+1))," ",XGCURATR)
W $$IOXY^XGS(T,L)_S ;top line with corners
F Y=T+1:1:B-1 D
. F X=%L2,%R2 S $E(XGSCRN(Y,0),X)=IOVL,$E(XGSCRN(Y,1),X)=XGCURATR
. W $$IOXY^XGS(Y,L)_IOVL_$$IOXY^XGS(Y,R)_IOVL
S S=IOBLC_$TR($J("",M)," ",IOHL)_IOBRC
S $E(XGSCRN(B,0),%L2,%R2)=S
S $E(XGSCRN(B,1),%L2,%R2)=$TR($J("",(R-L+1))," ",XGCURATR)
W $$IOXY^XGS(B,L)_S ;bottom line with corners
W $$SET^XGSA(XGSAVATR) ;restore previous attributes
D:$L($G(C)) GSET^%ZISS ;restore line drawing characters
S $Y=B,$X=R
Q
;
CLEAR(T,L,B,R) ;clear a portion of the screen
N %L2,%R2,I,M ;M=length of middle
S %L2=L+1,%R2=R+1,M=R-L+1
F I=T:1:B D
. S $E(XGSCRN(I,0),%L2,%R2)=$J("",M)
. S $E(XGSCRN(I,1),%L2,%R2)=$TR($J("",M)," ",XGCURATR)
. W $$IOXY^XGS(I,L)_$J("",M)
S $Y=B,$X=R
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXGSBOX 1586 printed Apr 09, 2024@21:09:43 Page 2
XGSBOX ;SFISC/VYD - screen rectengular region primitives ;10/31/94 15:38
+1 ;;8.0;KERNEL;;Jul 10, 1995
FRAME(T,L,B,R,A,C) ;draw a border
+1 ;TOP,LEFT,BOTTOM,RIGHT,ATTRIBUTE,frame character
+2 ;M=middle S=string
NEW %,%L2,%R2,M,S,X,Y
+3 NEW XGSAVATR
+4 ;to draw horizontal line
IF B'>T
NEW IOBLC,IOBRC
SET (IOBLC,IOBRC)=IOHL
+5 ;to draw vertical line
IF R'>L
NEW IOTRC,IOBRC
SET (IOTRC,IOBRC)=IOVL
+6 SET M=R-L-1
+7 SET %L2=L+1
SET %R2=R+1
+8 ;if frame character passed set frame parts to it, disable graphics
+9 if $LENGTH($GET(C))
SET (IOBLC,IOBRC,IOHL,IOTLC,IOTRC,IOVL)=C
+10 ;save current screen attributes
SET XGSAVATR=XGCURATR
+11 ;turn on gr attr & leave on
WRITE $$CHG^XGSA($GET(A)_$SELECT($LENGTH($GET(C)):"",1:"G1"))
+12 SET S=IOTLC_$TRANSLATE($JUSTIFY("",M)," ",IOHL)_IOTRC
+13 SET $EXTRACT(XGSCRN(T,0),%L2,%R2)=S
+14 SET $EXTRACT(XGSCRN(T,1),%L2,%R2)=$TRANSLATE($JUSTIFY("",(R-L+1))," ",XGCURATR)
+15 ;top line with corners
WRITE $$IOXY^XGS(T,L)_S
+16 FOR Y=T+1:1:B-1
Begin DoDot:1
+17 FOR X=%L2,%R2
SET $EXTRACT(XGSCRN(Y,0),X)=IOVL
SET $EXTRACT(XGSCRN(Y,1),X)=XGCURATR
+18 WRITE $$IOXY^XGS(Y,L)_IOVL_$$IOXY^XGS(Y,R)_IOVL
End DoDot:1
+19 SET S=IOBLC_$TRANSLATE($JUSTIFY("",M)," ",IOHL)_IOBRC
+20 SET $EXTRACT(XGSCRN(B,0),%L2,%R2)=S
+21 SET $EXTRACT(XGSCRN(B,1),%L2,%R2)=$TRANSLATE($JUSTIFY("",(R-L+1))," ",XGCURATR)
+22 ;bottom line with corners
WRITE $$IOXY^XGS(B,L)_S
+23 ;restore previous attributes
WRITE $$SET^XGSA(XGSAVATR)
+24 ;restore line drawing characters
if $LENGTH($GET(C))
DO GSET^%ZISS
+25 SET $Y=B
SET $X=R
+26 QUIT
+27 ;
CLEAR(T,L,B,R) ;clear a portion of the screen
+1 ;M=length of middle
NEW %L2,%R2,I,M
+2 SET %L2=L+1
SET %R2=R+1
SET M=R-L+1
+3 FOR I=T:1:B
Begin DoDot:1
+4 SET $EXTRACT(XGSCRN(I,0),%L2,%R2)=$JUSTIFY("",M)
+5 SET $EXTRACT(XGSCRN(I,1),%L2,%R2)=$TRANSLATE($JUSTIFY("",M)," ",XGCURATR)
+6 WRITE $$IOXY^XGS(I,L)_$JUSTIFY("",M)
End DoDot:1
+7 SET $Y=B
SET $X=R
+8 QUIT
