DDGLIBW1 ;SFISC/MKO-WINDOWING PRIMITIVES ;02:23 PM 13 Jul 1994
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
CREATE(I,A,B,N) ;
CREATE1 ;Create window I of area A and draw border (if B)
;N = nn; first n=1 means don't give the window focus
; second n=1 means don't write to screen
;
S:$G(I)="" I=-1
S:$G(A)="" A="0^0^"_IOSL_U_IOM
K @DDGLREF@(I) S @DDGLREF@(I)=A
D:$G(B) BOX^DDGLIBW(I,"0^0^"_$P(A,U,3,4),1,$G(N))
D:$G(N)<9 FOCUS(I,$G(N)!$G(B))
Q
;
OPEN(I,N) ;
OPEN1 ;Open window I
G FOCUS1
;
FOCUS(I,N) ;
FOCUS1 ;Give focus to window I
;If N=1; don't paint window
Q:$D(@DDGLREF@(I))[0
Q:$G(DDGLSCR(+$G(DDGLSCR)))=I
;
I '$D(DDGLSCR("B",I)) D
. S DDGLSCR=$G(DDGLSCR)+1,DDGLSCR(DDGLSCR)=I,DDGLSCR("B",I,DDGLSCR)=""
E D
. N M,N
. S DDGLSCR(DDGLSCR+1)=I
. S M=$O(DDGLSCR("B",I,""))
. F N=M:1:DDGLSCR D
.. K DDGLSCR("B",DDGLSCR(N),N)
.. S DDGLSCR(N)=DDGLSCR(N+1)
.. S DDGLSCR("B",DDGLSCR(N),N)=""
. K DDGLSCR(DDGLSCR+1)
D:'$G(N) REPAINT^DDGLIBW(I)
Q
;
CLOSE(I,NC) ;
CLOSE1 ;Close window I
N A,M,N,W
S M=$O(DDGLSCR("B",I,""))
Q:M=""
;
I '$G(NC) D
. S A=$$AREA(I)
. D CLEAR(I,"0^0^"_$P(A,U,3,4))
. F N=1:1:DDGLSCR D:N'=M
.. S W=DDGLSCR(N)
.. D REPAINT^DDGLIBW(W,$$RELAREA(W,$$INTSECT($$AREA(W),A)))
;
F N=M:1:DDGLSCR-1 D
. K DDGLSCR("B",DDGLSCR(N),N)
. S DDGLSCR(N)=DDGLSCR(N+1)
. S DDGLSCR("B",DDGLSCR(N),N)=""
K DDGLSCR("B",DDGLSCR(DDGLSCR),DDGLSCR),DDGLSCR(DDGLSCR)
S DDGLSCR=DDGLSCR-1
Q
;
CLEAR(I,A) ;
CLEAR1 ;Clear area A in window I
N Y,X,H,W,S,DY,DX
S:$G(I)="" I=-1 S:$G(A)="" A=$$AREA(I)
S A=$$ABSAREA(I,A)
S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
I Y=0,X=0,H=IOSL,W=IOM W $P(DDGLCLR,DDGLDEL,2) Q
S DX=X,S=$S(IOM-X=W:$P(DDGLCLR,DDGLDEL),1:$J("",W))
F DY=Y:1:Y+H-1 X IOXY W S
Q
;
ABSAREA(I,A) ;
;Given relative area A in window I, return absolute area
N X,Y,H,W,X1,Y1
S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
S A=$$AREA(I)
S Y1=Y+$P(A,U),X1=X+$P(A,U,2)
S:Y1+H>IOSL H=IOSL-Y1 S:X1+W>IOM W=IOM-X1
Q Y1_U_X1_U_H_U_W
;
RELAREA(I,A) ;
;Given absolute area A in window I, return relative area
N X,Y,H,W,X1,Y1
S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
S A=$$AREA(I)
S Y1=Y-$P(A,U),X1=X-$P(A,U,2)
Q Y1_U_X1_U_H_U_W
;
AREA(I) ;Return the coord and area of window I
Q $S($D(@DDGLREF@(I))#2:@DDGLREF@(I),1:"0^0^"_IOSL_U_IOM)
;
INTSECT(A1,A2) ;
;Return the intersection of areas 1 and 2
N A,X1,Y1,H1,W1,X2,Y2,H2,W2
S Y1=$P(A1,U),X1=$P(A1,U,2),H1=$P(A1,U,3),W1=$P(A1,U,4)
S Y2=$P(A2,U),X2=$P(A2,U,2),H2=$P(A2,U,3),W2=$P(A2,U,4)
S A=""
S $P(A,U)=$$MAX(Y1,Y2),$P(A,U,2)=$$MAX(X1,X2)
S $P(A,U,3)=$$LEN(Y1,H1,Y2,H2)
S $P(A,U,4)=$$LEN(X1,W1,X2,W2)
Q:'$P(A,U,3)!'$P(A,U,4) ""
Q A
;
MAX(X,Y) ;
;Return the max of X and Y
Q $S(X>Y:X,1:Y)
;
LEN(C1,L1,C2,L2) ;
;Return intersection length of two lines
; C = position along X or Y axis
; L = length of line
Q:C1'>C2 $S(C1+L1'<(C2+L2):L2,C1+L1>C2:L1-C2+C1,1:0)
Q $S(C2+L2'<(C1+L1):L1,C2+L2>C1:L2-C1+C2,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGLIBW1 3326 printed Oct 16, 2024@18:43:13 Page 2
DDGLIBW1 ;SFISC/MKO-WINDOWING PRIMITIVES ;02:23 PM 13 Jul 1994
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
CREATE(I,A,B,N) ;
CREATE1 ;Create window I of area A and draw border (if B)
+1 ;N = nn; first n=1 means don't give the window focus
+2 ; second n=1 means don't write to screen
+3 ;
+4 if $GET(I)=""
SET I=-1
+5 if $GET(A)=""
SET A="0^0^"_IOSL_U_IOM
+6 KILL @DDGLREF@(I)
SET @DDGLREF@(I)=A
+7 if $GET(B)
DO BOX^DDGLIBW(I,"0^0^"_$PIECE(A,U,3,4),1,$GET(N))
+8 if $GET(N)<9
DO FOCUS(I,$GET(N)!$GET(B))
+9 QUIT
+10 ;
OPEN(I,N) ;
OPEN1 ;Open window I
+1 GOTO FOCUS1
+2 ;
FOCUS(I,N) ;
FOCUS1 ;Give focus to window I
+1 ;If N=1; don't paint window
+2 if $DATA(@DDGLREF@(I))[0
QUIT
+3 if $GET(DDGLSCR(+$GET(DDGLSCR)))=I
QUIT
+4 ;
+5 IF '$DATA(DDGLSCR("B",I))
Begin DoDot:1
+6 SET DDGLSCR=$GET(DDGLSCR)+1
SET DDGLSCR(DDGLSCR)=I
SET DDGLSCR("B",I,DDGLSCR)=""
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 NEW M,N
+9 SET DDGLSCR(DDGLSCR+1)=I
+10 SET M=$ORDER(DDGLSCR("B",I,""))
+11 FOR N=M:1:DDGLSCR
Begin DoDot:2
+12 KILL DDGLSCR("B",DDGLSCR(N),N)
+13 SET DDGLSCR(N)=DDGLSCR(N+1)
+14 SET DDGLSCR("B",DDGLSCR(N),N)=""
End DoDot:2
+15 KILL DDGLSCR(DDGLSCR+1)
End DoDot:1
+16 if '$GET(N)
DO REPAINT^DDGLIBW(I)
+17 QUIT
+18 ;
CLOSE(I,NC) ;
CLOSE1 ;Close window I
+1 NEW A,M,N,W
+2 SET M=$ORDER(DDGLSCR("B",I,""))
+3 if M=""
QUIT
+4 ;
+5 IF '$GET(NC)
Begin DoDot:1
+6 SET A=$$AREA(I)
+7 DO CLEAR(I,"0^0^"_$PIECE(A,U,3,4))
+8 FOR N=1:1:DDGLSCR
if N'=M
Begin DoDot:2
+9 SET W=DDGLSCR(N)
+10 DO REPAINT^DDGLIBW(W,$$RELAREA(W,$$INTSECT($$AREA(W),A)))
End DoDot:2
End DoDot:1
+11 ;
+12 FOR N=M:1:DDGLSCR-1
Begin DoDot:1
+13 KILL DDGLSCR("B",DDGLSCR(N),N)
+14 SET DDGLSCR(N)=DDGLSCR(N+1)
+15 SET DDGLSCR("B",DDGLSCR(N),N)=""
End DoDot:1
+16 KILL DDGLSCR("B",DDGLSCR(DDGLSCR),DDGLSCR),DDGLSCR(DDGLSCR)
+17 SET DDGLSCR=DDGLSCR-1
+18 QUIT
+19 ;
CLEAR(I,A) ;
CLEAR1 ;Clear area A in window I
+1 NEW Y,X,H,W,S,DY,DX
+2 if $GET(I)=""
SET I=-1
if $GET(A)=""
SET A=$$AREA(I)
+3 SET A=$$ABSAREA(I,A)
+4 SET Y=$PIECE(A,U)
SET X=$PIECE(A,U,2)
SET H=$PIECE(A,U,3)
SET W=$PIECE(A,U,4)
+5 IF Y=0
IF X=0
IF H=IOSL
IF W=IOM
WRITE $PIECE(DDGLCLR,DDGLDEL,2)
QUIT
+6 SET DX=X
SET S=$SELECT(IOM-X=W:$PIECE(DDGLCLR,DDGLDEL),1:$JUSTIFY("",W))
+7 FOR DY=Y:1:Y+H-1
XECUTE IOXY
WRITE S
+8 QUIT
+9 ;
ABSAREA(I,A) ;
+1 ;Given relative area A in window I, return absolute area
+2 NEW X,Y,H,W,X1,Y1
+3 SET Y=$PIECE(A,U)
SET X=$PIECE(A,U,2)
SET H=$PIECE(A,U,3)
SET W=$PIECE(A,U,4)
+4 SET A=$$AREA(I)
+5 SET Y1=Y+$PIECE(A,U)
SET X1=X+$PIECE(A,U,2)
+6 if Y1+H>IOSL
SET H=IOSL-Y1
if X1+W>IOM
SET W=IOM-X1
+7 QUIT Y1_U_X1_U_H_U_W
+8 ;
RELAREA(I,A) ;
+1 ;Given absolute area A in window I, return relative area
+2 NEW X,Y,H,W,X1,Y1
+3 SET Y=$PIECE(A,U)
SET X=$PIECE(A,U,2)
SET H=$PIECE(A,U,3)
SET W=$PIECE(A,U,4)
+4 SET A=$$AREA(I)
+5 SET Y1=Y-$PIECE(A,U)
SET X1=X-$PIECE(A,U,2)
+6 QUIT Y1_U_X1_U_H_U_W
+7 ;
AREA(I) ;Return the coord and area of window I
+1 QUIT $SELECT($DATA(@DDGLREF@(I))#2:@DDGLREF@(I),1:"0^0^"_IOSL_U_IOM)
+2 ;
INTSECT(A1,A2) ;
+1 ;Return the intersection of areas 1 and 2
+2 NEW A,X1,Y1,H1,W1,X2,Y2,H2,W2
+3 SET Y1=$PIECE(A1,U)
SET X1=$PIECE(A1,U,2)
SET H1=$PIECE(A1,U,3)
SET W1=$PIECE(A1,U,4)
+4 SET Y2=$PIECE(A2,U)
SET X2=$PIECE(A2,U,2)
SET H2=$PIECE(A2,U,3)
SET W2=$PIECE(A2,U,4)
+5 SET A=""
+6 SET $PIECE(A,U)=$$MAX(Y1,Y2)
SET $PIECE(A,U,2)=$$MAX(X1,X2)
+7 SET $PIECE(A,U,3)=$$LEN(Y1,H1,Y2,H2)
+8 SET $PIECE(A,U,4)=$$LEN(X1,W1,X2,W2)
+9 if '$PIECE(A,U,3)!'$PIECE(A,U,4)
QUIT ""
+10 QUIT A
+11 ;
MAX(X,Y) ;
+1 ;Return the max of X and Y
+2 QUIT $SELECT(X>Y:X,1:Y)
+3 ;
LEN(C1,L1,C2,L2) ;
+1 ;Return intersection length of two lines
+2 ; C = position along X or Y axis
+3 ; L = length of line
+4 if C1'>C2
QUIT $SELECT(C1+L1'<(C2+L2):L2,C1+L1>C2:L1-C2+C1,1:0)
+5 QUIT $SELECT(C2+L2'<(C1+L1):L1,C2+L2>C1:L2-C1+C2,1:0)
