| 1 | DDGLIBW ;SFISC/MKO-WINDOW PRIMITIVES ;02:24 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 | ; | 
|---|
| 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 | 
|---|