- XGSBOX ;SFISC/VYD - screen rectengular region primitives ;10/31/94 15:38 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XGSBOX ;SFISC/VYD - screen rectengular region primitives ;10/31/94 15:38 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;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
