XGSBOX.m

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