Annotation of freem_fileman/DDGLIBW.m, revision 1.1.1.1
1.1 snw 1: DDGLIBW ;SFISC/MKO-WINDOW PRIMITIVES ;02:24 PM 13 Jul 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: ;
5: ; Area is defined as $Y^$X^height^width
6: ; DDGLREF(wid)=$Y^$X^height^width
7: ; DDGLREF(wid,$Y+1,"TXT")=string
8: ; DDGLREF(wid,$Y+1,"ATT")=attributes (bold,underline,reverse,graphic)
9: ;
10: ; DDGLSCR array - keeps track of what windows are on the screen and
11: ; the order in which they overlap
12: ; Form of DDGLSCR array:
13: ; DDGLSCR = # of elements
14: ; DDGLSCR(n) = wid
15: ; DDGLSCR("B",wid,n)= ""
16: ;
17: CREATE(I,A,B,N) ;
18: G CREATE1^DDGLIBW1
19: ;
20: OPEN(I,N) ;
21: G OPEN1^DDGLIBW1
22: ;
23: FOCUS(I,N) ;
24: G FOCUS1^DDGLIBW1
25: ;
26: CLOSE(I,NC) ;
27: G CLOSE1^DDGLIBW1
28: ;
29: CLEAR(I,A) ;
30: ;Clear area A in window I
31: G CLEAR1^DDGLIBW1
32: ;
33: EXIST(I) ;
34: ;Does window I exist?
35: Q $D(@DDGLREF@(I))#2
36: ;
37: CLOSEALL(N) ;
38: ;Close all windows
39: W:'$G(N) $P(DDGLCLR,DDGLDEL,2)
40: K DDGLSCR
41: Q
42: ;
43: DESTROY(I,NC) ;
44: ;Destroy window I
45: D CLOSE(I,$G(NC))
46: K @DDGLREF@(I)
47: Q
48: ;
49: DESTALL ;Destroy all windows
50: K @DDGLREF,DDGLSCR
51: Q
52: ;
53: WRITE(I,S,Y,X,A,N) ;
54: ;Write str S in window I at $Y=R, $X=C, attr A
55: ; If N=1, update buffer, but don't write
56: N A1,A0,A9
57: Q:$G(S)=""
58: S:$G(I)="" I=-1
59: S A9=$$AREA(I)
60: Q:X'<$P(A9,U,4) Q:Y'<$P(A9,U,3)
61: S S=$E(S,1,$P(A9,U,4)-X)
62: ;
63: S $E(@DDGLREF@(I,Y+1,"TXT"),X+1,X+$L(S))=S
64: I $G(A)="",$D(@DDGLREF@(I,Y+1,"ATT"))#2 S $E(@DDGLREF@(I,Y+1,"ATT"),X+1,X+$L(S))=$J("",$L(S))
65: S:$G(A)]"" $E(@DDGLREF@(I,Y+1,"ATT"),X+1,X+$L(S))=$TR($J("",$L(S))," ",$$CODE(A,.A1,.A0))
66: ;
67: I '$G(N) D
68: . N DY,DX
69: . S DY=Y+$P(A9,U),DX=X+$P(A9,U,2) X IOXY W $G(A1)_S_$G(A0)
70: ;
71: I $G(@DDGLREF@(I,Y+1,"TXT"))?." ",$G(@DDGLREF@(I,Y+1,"ATT"))?." " K @DDGLREF@(I,Y+1,"TXT"),@DDGLREF@(I,Y+1,"ATT")
72: Q
73: ;
74: REPALL(A) ;
75: ;Repaint absolute area A in all windows in DDGLSCR array
76: N J
77: I $G(A)="" D
78: . W $P(DDGLCLR,DDGLDEL,2)
79: . F J=1:1:$G(DDGLSCR) D REPAINT(DDGLSCR(J))
80: E D
81: . D CLEAR(-1,A)
82: . F J=1:1:$G(DDGLSCR) D REPAINT(DDGLSCR(J),$$RELAREA(DDGLSCR(J),A))
83: Q
84: ;
85: REPAINT(I,A) ;
86: ;Repaint area A of window I
87: N X,Y,H,W,R,C,T,X1,X2,A2,A1,A0,S,DY,DX,P
88: I $D(A),A="" Q
89: S:$G(I)="" I=-1
90: S:'$D(A) A="0^0^"_IOSL_U_IOM
91: ;
92: S A2=$$AREA(I)
93: S A=$P(A,U)+$P(A2,U)_U_($P(A,U,2)+$P(A2,U,2))_U_$P(A,U,3,4)
94: S A=$$INTSECT^DDGLIBW1(A,A2)
95: S Y=$P(A,U)-$P(A2,U),X=$P(A,U,2)-$P(A2,U,2),H=$P(A,U,3),W=$P(A,U,4)
96: ;
97: I $D(@DDGLREF@(I))<9,Y+$P(A2,U)=0,X+$P(A2,U,2)=0,H=IOSL,W=IOM W $P(DDGLCLR,DDGLDEL,2) Q
98: S P=IOM-X-$P(A2,U,2)-1_""" """
99: F R=Y+1:1:Y+H D
100: . S S=""
101: . S T=$E($G(@DDGLREF@(I,R,"TXT"))_$J("",X+W-$L($G(@DDGLREF@(I,R,"TXT")))),1,X+W)
102: . S A=$E($G(@DDGLREF@(I,R,"ATT")),1,X+W)
103: . S (X1,X2)=X+1 F D Q:$E(T,X2)=""
104: .. S X1=X2,C=$E(A,X1)
105: .. I C="" S X2=999 S S=S_$E(T,X1,X2) Q
106: .. F X2=X1:1:$L(A)+1 Q:C'=$E(A,X2)
107: .. D DECODE(C,.A1,.A0)
108: .. S S=S_A1_$E(T,X1,X2-1)_A0
109: . S DY=R-1+$P(A2,U),DX=X+$P(A2,U,2) X IOXY
110: . W $S(S?@P:$P(DDGLCLR,DDGLDEL),1:S)
111: Q
112: ;
113: BOX(I,A,C,N) ;
114: ;Draw a box in window I representing area A
115: ;If C=1 writes spaces within the box
116: ;If N=1 write to buffer but not screen
117: N Y,X,H,W,L,R,S,A1
118: S:$G(I)="" I=-1
119: S:$G(A)="" A=$$AREA(I)
120: S:$G(N)="" N=0
121: S A1=$$ABSAREA(I,A)
122: S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
123: Q:'H!'W
124: S S=$J("",W-2),L=$TR(S," ",$P(DDGLGRA,DDGLDEL,3))
125: D WRITE(I,$P(DDGLGRA,DDGLDEL,5)_$S(W>1:L_$P(DDGLGRA,DDGLDEL,6),1:""),Y,X,"G",N)
126: F R=Y+1:1:Y+H-2 D
127: . D WRITE(I,$P(DDGLGRA,DDGLDEL,4),R,X,"G",N)
128: . I W>1 D
129: .. I $G(C) D WRITE(I,S,R,X+1,"",N)
130: .. D WRITE(I,$P(DDGLGRA,DDGLDEL,4),R,X+W-1,"G",N)
131: D:H>1 WRITE(I,$P(DDGLGRA,DDGLDEL,7)_$S(W>1:L_$P(DDGLGRA,DDGLDEL,8),1:""),Y+H-1,X,"G",N)
132: Q
133: ;
134: ABSAREA(I,A) ;
135: ;Given relative area A in window I, return absolute area
136: N X,Y,H,W,X1,Y1
137: S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
138: S A=$$AREA(I)
139: S Y1=Y+$P(A,U),X1=X+$P(A,U,2)
140: S:Y1+H>IOSL H=IOSL-Y1 S:X1+W>IOM W=IOM-X1
141: Q Y1_U_X1_U_H_U_W
142: ;
143: RELAREA(I,A) ;
144: ;Given absolute area A in window I, return relative area
145: N X,Y,H,W,X1,Y1
146: S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
147: S A=$$AREA(I)
148: S Y1=Y-$P(A,U),X1=X-$P(A,U,2)
149: Q Y1_U_X1_U_H_U_W
150: ;
151: AREA(I) ;Return the coord and area of window I
152: Q $S($D(@DDGLREF@(I))#2:@DDGLREF@(I),1:"0^0^"_IOSL_U_IOM)
153: ;
154: CODE(A,A1,A0) ;
155: ;Return code char for selected attr
156: N I,C,T
157: S C=0,(A1,A0)=""
158: S T=$TR(A,"burg","BURG")
159: F I=1:1:$L(A) D
160: . S T=$T(@$E(A,I))
161: . I T]"" D
162: .. S C=C+$P(T,";",3)
163: .. S A1=A1_$P(@$P(T,";",4),DDGLDEL,$P(T,";",5))
164: .. S A0=A0_$P(@$P(T,";",4),DDGLDEL,$P(T,";",6))
165: Q $C(C+32)
166: ;
167: DECODE(C,A1,A0) ;
168: ;Given code char C, return codes to turn on/off attr
169: N B,T
170: S (A1,A0)="" Q:" "[$G(C)
171: S C=$A(C)-32
172: S B=1 F D Q:B>8
173: . I C\B#2,$T(@B)]"" D
174: .. S T=$T(@B+1)
175: .. S A1=A1_$P(@$P(T,";",4),DDGLDEL,$P(T,";",5))
176: .. S A0=A0_$P(@$P(T,";",4),DDGLDEL,$P(T,";",6))
177: . S B=B*2
178: Q
179: ;
180: 1 ;;
181: B ;;1;DDGLVID;1;2
182: 2 ;;
183: U ;;2;DDGLVID;4;5
184: 4 ;;
185: R ;;4;DDGLVID;6;7
186: 8 ;;
187: G ;;8;DDGLGRA;1;2
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>