source: cprs/branches/tmg-cprs/m_files/TMGXSBOX.m@ 1706

Last change on this file since 1706 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 2.1 KB
Line 
1TMGXGSBOX ;SFISC/VYD - screen rectengular region primitives ;10/31/94 15:38
2 ;;8.0;KERNEL;;5/5/2007 by //kt
3 ;
4FRAME(T,L,B,R,A,C) ;draw a border
5 ;TOP,LEFT,BOTTOM,RIGHT,ATTRIBUTE,frame character
6 N %,%L2,%R2,M,S,X,Y ;M=middle S=string
7 N XGSAVATR
8 I B'>T N IOBLC,IOBRC S (IOBLC,IOBRC)=IOHL ;to draw horizontal line
9 I R'>L N IOTRC,IOBRC S (IOTRC,IOBRC)=IOVL ;to draw vertical line
10 S M=R-L-1
11 S %L2=L+1,%R2=R+1
12 ;if frame character passed set frame parts to it, disable graphics
13 S:$L($G(C)) (IOBLC,IOBRC,IOHL,IOTLC,IOTRC,IOVL)=C
14 S XGSAVATR=XGCURATR ;save current screen attributes
15 W $$CHG^XGSA($G(A)_$S($L($G(C)):"",1:"G1")) ;turn on gr attr & leave on
16 S S=IOTLC_$TR($J("",M)," ",IOHL)_IOTRC
17 S $E(XGSCRN(T,0),%L2,%R2)=S
18 S $E(XGSCRN(T,1),%L2,%R2)=$TR($J("",(R-L+1))," ",XGCURATR)
19 ;W $$IOXY^TMGXGS(T,L)_S ;top line with corners ;"//kt
20 DO CLIOXY^TMGXGS(T,L,S) ;top line with corners ;"//kt
21 F Y=T+1:1:B-1 D
22 . F X=%L2,%R2 S $E(XGSCRN(Y,0),X)=IOVL,$E(XGSCRN(Y,1),X)=XGCURATR
23 . ;W $$IOXY^TMGXGS(Y,L)_IOVL_$$IOXY^TMGXGS(Y,R)_IOVL ;"//kt
24 . DO CLIOXY^TMGXGS(Y,L,IOVL) DO CLIOXY^TMGXGS(Y,R,IOVL) ;"//kt
25 S S=IOBLC_$TR($J("",M)," ",IOHL)_IOBRC
26 S $E(XGSCRN(B,0),%L2,%R2)=S
27 S $E(XGSCRN(B,1),%L2,%R2)=$TR($J("",(R-L+1))," ",XGCURATR)
28 ;W $$IOXY^TMGXGS(B,L)_S ;bottom line with corners ;"//kt
29 DO CLIOXY^TMGXGS(B,L,S) ;bottom line with corners ;"//kt
30 W $$SET^XGSA(XGSAVATR) ;restore previous attributes
31 D:$L($G(C)) GSET^%ZISS ;restore line drawing characters
32 S $Y=B,$X=R
33 Q
34 ;
35CLEAR(T,L,B,R) ;clear a portion of the screen
36 N %L2,%R2,I,M ;M=length of middle
37 S %L2=L+1,%R2=R+1,M=R-L+1
38 F I=T:1:B D
39 . S $E(XGSCRN(I,0),%L2,%R2)=$J("",M)
40 . S $E(XGSCRN(I,1),%L2,%R2)=$TR($J("",M)," ",XGCURATR)
41 . ;W $$IOXY^TMGXGS(I,L)_$J("",M) ;"//kt
42 . DO CLIOXY^TMGXGS(I,L,$J("",M)) ;"//kt
43 S $Y=B,$X=R
44 Q
Note: See TracBrowser for help on using the repository browser.