1 | DDGLIBW1 ;SFISC/MKO-WINDOWING PRIMITIVES ;02:23 PM 13 Jul 1994
|
---|
2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | CREATE(I,A,B,N) ;
|
---|
5 | CREATE1 ;Create window I of area A and draw border (if B)
|
---|
6 | ;N = nn; first n=1 means don't give the window focus
|
---|
7 | ; second n=1 means don't write to screen
|
---|
8 | ;
|
---|
9 | S:$G(I)="" I=-1
|
---|
10 | S:$G(A)="" A="0^0^"_IOSL_U_IOM
|
---|
11 | K @DDGLREF@(I) S @DDGLREF@(I)=A
|
---|
12 | D:$G(B) BOX^DDGLIBW(I,"0^0^"_$P(A,U,3,4),1,$G(N))
|
---|
13 | D:$G(N)<9 FOCUS(I,$G(N)!$G(B))
|
---|
14 | Q
|
---|
15 | ;
|
---|
16 | OPEN(I,N) ;
|
---|
17 | OPEN1 ;Open window I
|
---|
18 | G FOCUS1
|
---|
19 | ;
|
---|
20 | FOCUS(I,N) ;
|
---|
21 | FOCUS1 ;Give focus to window I
|
---|
22 | ;If N=1; don't paint window
|
---|
23 | Q:$D(@DDGLREF@(I))[0
|
---|
24 | Q:$G(DDGLSCR(+$G(DDGLSCR)))=I
|
---|
25 | ;
|
---|
26 | I '$D(DDGLSCR("B",I)) D
|
---|
27 | . S DDGLSCR=$G(DDGLSCR)+1,DDGLSCR(DDGLSCR)=I,DDGLSCR("B",I,DDGLSCR)=""
|
---|
28 | E D
|
---|
29 | . N M,N
|
---|
30 | . S DDGLSCR(DDGLSCR+1)=I
|
---|
31 | . S M=$O(DDGLSCR("B",I,""))
|
---|
32 | . F N=M:1:DDGLSCR D
|
---|
33 | .. K DDGLSCR("B",DDGLSCR(N),N)
|
---|
34 | .. S DDGLSCR(N)=DDGLSCR(N+1)
|
---|
35 | .. S DDGLSCR("B",DDGLSCR(N),N)=""
|
---|
36 | . K DDGLSCR(DDGLSCR+1)
|
---|
37 | D:'$G(N) REPAINT^DDGLIBW(I)
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | CLOSE(I,NC) ;
|
---|
41 | CLOSE1 ;Close window I
|
---|
42 | N A,M,N,W
|
---|
43 | S M=$O(DDGLSCR("B",I,""))
|
---|
44 | Q:M=""
|
---|
45 | ;
|
---|
46 | I '$G(NC) D
|
---|
47 | . S A=$$AREA(I)
|
---|
48 | . D CLEAR(I,"0^0^"_$P(A,U,3,4))
|
---|
49 | . F N=1:1:DDGLSCR D:N'=M
|
---|
50 | .. S W=DDGLSCR(N)
|
---|
51 | .. D REPAINT^DDGLIBW(W,$$RELAREA(W,$$INTSECT($$AREA(W),A)))
|
---|
52 | ;
|
---|
53 | F N=M:1:DDGLSCR-1 D
|
---|
54 | . K DDGLSCR("B",DDGLSCR(N),N)
|
---|
55 | . S DDGLSCR(N)=DDGLSCR(N+1)
|
---|
56 | . S DDGLSCR("B",DDGLSCR(N),N)=""
|
---|
57 | K DDGLSCR("B",DDGLSCR(DDGLSCR),DDGLSCR),DDGLSCR(DDGLSCR)
|
---|
58 | S DDGLSCR=DDGLSCR-1
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | CLEAR(I,A) ;
|
---|
62 | CLEAR1 ;Clear area A in window I
|
---|
63 | N Y,X,H,W,S,DY,DX
|
---|
64 | S:$G(I)="" I=-1 S:$G(A)="" A=$$AREA(I)
|
---|
65 | S A=$$ABSAREA(I,A)
|
---|
66 | S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
|
---|
67 | I Y=0,X=0,H=IOSL,W=IOM W $P(DDGLCLR,DDGLDEL,2) Q
|
---|
68 | S DX=X,S=$S(IOM-X=W:$P(DDGLCLR,DDGLDEL),1:$J("",W))
|
---|
69 | F DY=Y:1:Y+H-1 X IOXY W S
|
---|
70 | Q
|
---|
71 | ;
|
---|
72 | ABSAREA(I,A) ;
|
---|
73 | ;Given relative area A in window I, return absolute area
|
---|
74 | N X,Y,H,W,X1,Y1
|
---|
75 | S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
|
---|
76 | S A=$$AREA(I)
|
---|
77 | S Y1=Y+$P(A,U),X1=X+$P(A,U,2)
|
---|
78 | S:Y1+H>IOSL H=IOSL-Y1 S:X1+W>IOM W=IOM-X1
|
---|
79 | Q Y1_U_X1_U_H_U_W
|
---|
80 | ;
|
---|
81 | RELAREA(I,A) ;
|
---|
82 | ;Given absolute area A in window I, return relative area
|
---|
83 | N X,Y,H,W,X1,Y1
|
---|
84 | S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
|
---|
85 | S A=$$AREA(I)
|
---|
86 | S Y1=Y-$P(A,U),X1=X-$P(A,U,2)
|
---|
87 | Q Y1_U_X1_U_H_U_W
|
---|
88 | ;
|
---|
89 | AREA(I) ;Return the coord and area of window I
|
---|
90 | Q $S($D(@DDGLREF@(I))#2:@DDGLREF@(I),1:"0^0^"_IOSL_U_IOM)
|
---|
91 | ;
|
---|
92 | INTSECT(A1,A2) ;
|
---|
93 | ;Return the intersection of areas 1 and 2
|
---|
94 | N A,X1,Y1,H1,W1,X2,Y2,H2,W2
|
---|
95 | S Y1=$P(A1,U),X1=$P(A1,U,2),H1=$P(A1,U,3),W1=$P(A1,U,4)
|
---|
96 | S Y2=$P(A2,U),X2=$P(A2,U,2),H2=$P(A2,U,3),W2=$P(A2,U,4)
|
---|
97 | S A=""
|
---|
98 | S $P(A,U)=$$MAX(Y1,Y2),$P(A,U,2)=$$MAX(X1,X2)
|
---|
99 | S $P(A,U,3)=$$LEN(Y1,H1,Y2,H2)
|
---|
100 | S $P(A,U,4)=$$LEN(X1,W1,X2,W2)
|
---|
101 | Q:'$P(A,U,3)!'$P(A,U,4) ""
|
---|
102 | Q A
|
---|
103 | ;
|
---|
104 | MAX(X,Y) ;
|
---|
105 | ;Return the max of X and Y
|
---|
106 | Q $S(X>Y:X,1:Y)
|
---|
107 | ;
|
---|
108 | LEN(C1,L1,C2,L2) ;
|
---|
109 | ;Return intersection length of two lines
|
---|
110 | ; C = position along X or Y axis
|
---|
111 | ; L = length of line
|
---|
112 | Q:C1'>C2 $S(C1+L1'<(C2+L2):L2,C1+L1>C2:L1-C2+C1,1:0)
|
---|
113 | Q $S(C2+L2'<(C1+L1):L1,C2+L2>C1:L2-C1+C2,1:0)
|
---|