Return to DDGLIBW1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDGLIBW1.m, revision 1.1.1.1

1.1       snw         1: DDGLIBW1       ;SFISC/MKO-WINDOWING PRIMITIVES ;02:23 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: 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)