- DDGLIBW ;SFISC/MKO-WINDOW PRIMITIVES ;02:24 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.
- ;
- ; Area is defined as $Y^$X^height^width
- ; DDGLREF(wid)=$Y^$X^height^width
- ; DDGLREF(wid,$Y+1,"TXT")=string
- ; DDGLREF(wid,$Y+1,"ATT")=attributes (bold,underline,reverse,graphic)
- ;
- ; DDGLSCR array - keeps track of what windows are on the screen and
- ; the order in which they overlap
- ; Form of DDGLSCR array:
- ; DDGLSCR = # of elements
- ; DDGLSCR(n) = wid
- ; DDGLSCR("B",wid,n)= ""
- ;
- CREATE(I,A,B,N) ;
- G CREATE1^DDGLIBW1
- ;
- OPEN(I,N) ;
- G OPEN1^DDGLIBW1
- ;
- FOCUS(I,N) ;
- G FOCUS1^DDGLIBW1
- ;
- CLOSE(I,NC) ;
- G CLOSE1^DDGLIBW1
- ;
- CLEAR(I,A) ;
- ;Clear area A in window I
- G CLEAR1^DDGLIBW1
- ;
- EXIST(I) ;
- ;Does window I exist?
- Q $D(@DDGLREF@(I))#2
- ;
- CLOSEALL(N) ;
- ;Close all windows
- W:'$G(N) $P(DDGLCLR,DDGLDEL,2)
- K DDGLSCR
- Q
- ;
- DESTROY(I,NC) ;
- ;Destroy window I
- D CLOSE(I,$G(NC))
- K @DDGLREF@(I)
- Q
- ;
- DESTALL ;Destroy all windows
- K @DDGLREF,DDGLSCR
- Q
- ;
- WRITE(I,S,Y,X,A,N) ;
- ;Write str S in window I at $Y=R, $X=C, attr A
- ; If N=1, update buffer, but don't write
- N A1,A0,A9
- Q:$G(S)=""
- S:$G(I)="" I=-1
- S A9=$$AREA(I)
- Q:X'<$P(A9,U,4) Q:Y'<$P(A9,U,3)
- S S=$E(S,1,$P(A9,U,4)-X)
- ;
- S $E(@DDGLREF@(I,Y+1,"TXT"),X+1,X+$L(S))=S
- 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))
- S:$G(A)]"" $E(@DDGLREF@(I,Y+1,"ATT"),X+1,X+$L(S))=$TR($J("",$L(S))," ",$$CODE(A,.A1,.A0))
- ;
- I '$G(N) D
- . N DY,DX
- . S DY=Y+$P(A9,U),DX=X+$P(A9,U,2) X IOXY W $G(A1)_S_$G(A0)
- ;
- I $G(@DDGLREF@(I,Y+1,"TXT"))?." ",$G(@DDGLREF@(I,Y+1,"ATT"))?." " K @DDGLREF@(I,Y+1,"TXT"),@DDGLREF@(I,Y+1,"ATT")
- Q
- ;
- REPALL(A) ;
- ;Repaint absolute area A in all windows in DDGLSCR array
- N J
- I $G(A)="" D
- . W $P(DDGLCLR,DDGLDEL,2)
- . F J=1:1:$G(DDGLSCR) D REPAINT(DDGLSCR(J))
- E D
- . D CLEAR(-1,A)
- . F J=1:1:$G(DDGLSCR) D REPAINT(DDGLSCR(J),$$RELAREA(DDGLSCR(J),A))
- Q
- ;
- REPAINT(I,A) ;
- ;Repaint area A of window I
- N X,Y,H,W,R,C,T,X1,X2,A2,A1,A0,S,DY,DX,P
- I $D(A),A="" Q
- S:$G(I)="" I=-1
- S:'$D(A) A="0^0^"_IOSL_U_IOM
- ;
- S A2=$$AREA(I)
- S A=$P(A,U)+$P(A2,U)_U_($P(A,U,2)+$P(A2,U,2))_U_$P(A,U,3,4)
- S A=$$INTSECT^DDGLIBW1(A,A2)
- 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)
- ;
- 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
- S P=IOM-X-$P(A2,U,2)-1_""" """
- F R=Y+1:1:Y+H D
- . S S=""
- . S T=$E($G(@DDGLREF@(I,R,"TXT"))_$J("",X+W-$L($G(@DDGLREF@(I,R,"TXT")))),1,X+W)
- . S A=$E($G(@DDGLREF@(I,R,"ATT")),1,X+W)
- . S (X1,X2)=X+1 F D Q:$E(T,X2)=""
- .. S X1=X2,C=$E(A,X1)
- .. I C="" S X2=999 S S=S_$E(T,X1,X2) Q
- .. F X2=X1:1:$L(A)+1 Q:C'=$E(A,X2)
- .. D DECODE(C,.A1,.A0)
- .. S S=S_A1_$E(T,X1,X2-1)_A0
- . S DY=R-1+$P(A2,U),DX=X+$P(A2,U,2) X IOXY
- . W $S(S?@P:$P(DDGLCLR,DDGLDEL),1:S)
- Q
- ;
- BOX(I,A,C,N) ;
- ;Draw a box in window I representing area A
- ;If C=1 writes spaces within the box
- ;If N=1 write to buffer but not screen
- N Y,X,H,W,L,R,S,A1
- S:$G(I)="" I=-1
- S:$G(A)="" A=$$AREA(I)
- S:$G(N)="" N=0
- S A1=$$ABSAREA(I,A)
- S Y=$P(A,U),X=$P(A,U,2),H=$P(A,U,3),W=$P(A,U,4)
- Q:'H!'W
- S S=$J("",W-2),L=$TR(S," ",$P(DDGLGRA,DDGLDEL,3))
- D WRITE(I,$P(DDGLGRA,DDGLDEL,5)_$S(W>1:L_$P(DDGLGRA,DDGLDEL,6),1:""),Y,X,"G",N)
- F R=Y+1:1:Y+H-2 D
- . D WRITE(I,$P(DDGLGRA,DDGLDEL,4),R,X,"G",N)
- . I W>1 D
- .. I $G(C) D WRITE(I,S,R,X+1,"",N)
- .. D WRITE(I,$P(DDGLGRA,DDGLDEL,4),R,X+W-1,"G",N)
- D:H>1 WRITE(I,$P(DDGLGRA,DDGLDEL,7)_$S(W>1:L_$P(DDGLGRA,DDGLDEL,8),1:""),Y+H-1,X,"G",N)
- 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)
- ;
- CODE(A,A1,A0) ;
- ;Return code char for selected attr
- N I,C,T
- S C=0,(A1,A0)=""
- S T=$TR(A,"burg","BURG")
- F I=1:1:$L(A) D
- . S T=$T(@$E(A,I))
- . I T]"" D
- .. S C=C+$P(T,";",3)
- .. S A1=A1_$P(@$P(T,";",4),DDGLDEL,$P(T,";",5))
- .. S A0=A0_$P(@$P(T,";",4),DDGLDEL,$P(T,";",6))
- Q $C(C+32)
- ;
- DECODE(C,A1,A0) ;
- ;Given code char C, return codes to turn on/off attr
- N B,T
- S (A1,A0)="" Q:" "[$G(C)
- S C=$A(C)-32
- S B=1 F D Q:B>8
- . I C\B#2,$T(@B)]"" D
- .. S T=$T(@B+1)
- .. S A1=A1_$P(@$P(T,";",4),DDGLDEL,$P(T,";",5))
- .. S A0=A0_$P(@$P(T,";",4),DDGLDEL,$P(T,";",6))
- . S B=B*2
- Q
- ;
- 1 ;;
- B ;;1;DDGLVID;1;2
- 2 ;;
- U ;;2;DDGLVID;4;5
- 4 ;;
- R ;;4;DDGLVID;6;7
- 8 ;;
- G ;;8;DDGLGRA;1;2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGLIBW 5198 printed Jan 18, 2025@03:43:37 Page 2
- DDGLIBW ;SFISC/MKO-WINDOW PRIMITIVES ;02:24 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 ;
- +7 ; Area is defined as $Y^$X^height^width
- +8 ; DDGLREF(wid)=$Y^$X^height^width
- +9 ; DDGLREF(wid,$Y+1,"TXT")=string
- +10 ; DDGLREF(wid,$Y+1,"ATT")=attributes (bold,underline,reverse,graphic)
- +11 ;
- +12 ; DDGLSCR array - keeps track of what windows are on the screen and
- +13 ; the order in which they overlap
- +14 ; Form of DDGLSCR array:
- +15 ; DDGLSCR = # of elements
- +16 ; DDGLSCR(n) = wid
- +17 ; DDGLSCR("B",wid,n)= ""
- +18 ;
- CREATE(I,A,B,N) ;
- +1 GOTO CREATE1^DDGLIBW1
- +2 ;
- OPEN(I,N) ;
- +1 GOTO OPEN1^DDGLIBW1
- +2 ;
- FOCUS(I,N) ;
- +1 GOTO FOCUS1^DDGLIBW1
- +2 ;
- CLOSE(I,NC) ;
- +1 GOTO CLOSE1^DDGLIBW1
- +2 ;
- CLEAR(I,A) ;
- +1 ;Clear area A in window I
- +2 GOTO CLEAR1^DDGLIBW1
- +3 ;
- EXIST(I) ;
- +1 ;Does window I exist?
- +2 QUIT $DATA(@DDGLREF@(I))#2
- +3 ;
- CLOSEALL(N) ;
- +1 ;Close all windows
- +2 if '$GET(N)
- WRITE $PIECE(DDGLCLR,DDGLDEL,2)
- +3 KILL DDGLSCR
- +4 QUIT
- +5 ;
- DESTROY(I,NC) ;
- +1 ;Destroy window I
- +2 DO CLOSE(I,$GET(NC))
- +3 KILL @DDGLREF@(I)
- +4 QUIT
- +5 ;
- DESTALL ;Destroy all windows
- +1 KILL @DDGLREF,DDGLSCR
- +2 QUIT
- +3 ;
- WRITE(I,S,Y,X,A,N) ;
- +1 ;Write str S in window I at $Y=R, $X=C, attr A
- +2 ; If N=1, update buffer, but don't write
- +3 NEW A1,A0,A9
- +4 if $GET(S)=""
- QUIT
- +5 if $GET(I)=""
- SET I=-1
- +6 SET A9=$$AREA(I)
- +7 if X'<$PIECE(A9,U,4)
- QUIT
- if Y'<$PIECE(A9,U,3)
- QUIT
- +8 SET S=$EXTRACT(S,1,$PIECE(A9,U,4)-X)
- +9 ;
- +10 SET $EXTRACT(@DDGLREF@(I,Y+1,"TXT"),X+1,X+$LENGTH(S))=S
- +11 IF $GET(A)=""
- IF $DATA(@DDGLREF@(I,Y+1,"ATT"))#2
- SET $EXTRACT(@DDGLREF@(I,Y+1,"ATT"),X+1,X+$LENGTH(S))=$JUSTIFY("",$LENGTH(S))
- +12 if $GET(A)]""
- SET $EXTRACT(@DDGLREF@(I,Y+1,"ATT"),X+1,X+$LENGTH(S))=$TRANSLATE($JUSTIFY("",$LENGTH(S))," ",$$CODE(A,.A1,.A0))
- +13 ;
- +14 IF '$GET(N)
- Begin DoDot:1
- +15 NEW DY,DX
- +16 SET DY=Y+$PIECE(A9,U)
- SET DX=X+$PIECE(A9,U,2)
- XECUTE IOXY
- WRITE $GET(A1)_S_$GET(A0)
- End DoDot:1
- +17 ;
- +18 IF $GET(@DDGLREF@(I,Y+1,"TXT"))?." "
- IF $GET(@DDGLREF@(I,Y+1,"ATT"))?." "
- KILL @DDGLREF@(I,Y+1,"TXT"),@DDGLREF@(I,Y+1,"ATT")
- +19 QUIT
- +20 ;
- REPALL(A) ;
- +1 ;Repaint absolute area A in all windows in DDGLSCR array
- +2 NEW J
- +3 IF $GET(A)=""
- Begin DoDot:1
- +4 WRITE $PIECE(DDGLCLR,DDGLDEL,2)
- +5 FOR J=1:1:$GET(DDGLSCR)
- DO REPAINT(DDGLSCR(J))
- End DoDot:1
- +6 IF '$TEST
- Begin DoDot:1
- +7 DO CLEAR(-1,A)
- +8 FOR J=1:1:$GET(DDGLSCR)
- DO REPAINT(DDGLSCR(J),$$RELAREA(DDGLSCR(J),A))
- End DoDot:1
- +9 QUIT
- +10 ;
- REPAINT(I,A) ;
- +1 ;Repaint area A of window I
- +2 NEW X,Y,H,W,R,C,T,X1,X2,A2,A1,A0,S,DY,DX,P
- +3 IF $DATA(A)
- IF A=""
- QUIT
- +4 if $GET(I)=""
- SET I=-1
- +5 if '$DATA(A)
- SET A="0^0^"_IOSL_U_IOM
- +6 ;
- +7 SET A2=$$AREA(I)
- +8 SET A=$PIECE(A,U)+$PIECE(A2,U)_U_($PIECE(A,U,2)+$PIECE(A2,U,2))_U_$PIECE(A,U,3,4)
- +9 SET A=$$INTSECT^DDGLIBW1(A,A2)
- +10 SET Y=$PIECE(A,U)-$PIECE(A2,U)
- SET X=$PIECE(A,U,2)-$PIECE(A2,U,2)
- SET H=$PIECE(A,U,3)
- SET W=$PIECE(A,U,4)
- +11 ;
- +12 IF $DATA(@DDGLREF@(I))<9
- IF Y+$PIECE(A2,U)=0
- IF X+$PIECE(A2,U,2)=0
- IF H=IOSL
- IF W=IOM
- WRITE $PIECE(DDGLCLR,DDGLDEL,2)
- QUIT
- +13 SET P=IOM-X-$PIECE(A2,U,2)-1_""" """
- +14 FOR R=Y+1:1:Y+H
- Begin DoDot:1
- +15 SET S=""
- +16 SET T=$EXTRACT($GET(@DDGLREF@(I,R,"TXT"))_$JUSTIFY("",X+W-$LENGTH($GET(@DDGLREF@(I,R,"TXT")))),1,X+W)
- +17 SET A=$EXTRACT($GET(@DDGLREF@(I,R,"ATT")),1,X+W)
- +18 SET (X1,X2)=X+1
- FOR
- Begin DoDot:2
- +19 SET X1=X2
- SET C=$EXTRACT(A,X1)
- +20 IF C=""
- SET X2=999
- SET S=S_$EXTRACT(T,X1,X2)
- QUIT
- +21 FOR X2=X1:1:$LENGTH(A)+1
- if C'=$EXTRACT(A,X2)
- QUIT
- +22 DO DECODE(C,.A1,.A0)
- +23 SET S=S_A1_$EXTRACT(T,X1,X2-1)_A0
- End DoDot:2
- if $EXTRACT(T,X2)=""
- QUIT
- +24 SET DY=R-1+$PIECE(A2,U)
- SET DX=X+$PIECE(A2,U,2)
- XECUTE IOXY
- +25 WRITE $SELECT(S?@P:$PIECE(DDGLCLR,DDGLDEL),1:S)
- End DoDot:1
- +26 QUIT
- +27 ;
- BOX(I,A,C,N) ;
- +1 ;Draw a box in window I representing area A
- +2 ;If C=1 writes spaces within the box
- +3 ;If N=1 write to buffer but not screen
- +4 NEW Y,X,H,W,L,R,S,A1
- +5 if $GET(I)=""
- SET I=-1
- +6 if $GET(A)=""
- SET A=$$AREA(I)
- +7 if $GET(N)=""
- SET N=0
- +8 SET A1=$$ABSAREA(I,A)
- +9 SET Y=$PIECE(A,U)
- SET X=$PIECE(A,U,2)
- SET H=$PIECE(A,U,3)
- SET W=$PIECE(A,U,4)
- +10 if 'H!'W
- QUIT
- +11 SET S=$JUSTIFY("",W-2)
- SET L=$TRANSLATE(S," ",$PIECE(DDGLGRA,DDGLDEL,3))
- +12 DO WRITE(I,$PIECE(DDGLGRA,DDGLDEL,5)_$SELECT(W>1:L_$PIECE(DDGLGRA,DDGLDEL,6),1:""),Y,X,"G",N)
- +13 FOR R=Y+1:1:Y+H-2
- Begin DoDot:1
- +14 DO WRITE(I,$PIECE(DDGLGRA,DDGLDEL,4),R,X,"G",N)
- +15 IF W>1
- Begin DoDot:2
- +16 IF $GET(C)
- DO WRITE(I,S,R,X+1,"",N)
- +17 DO WRITE(I,$PIECE(DDGLGRA,DDGLDEL,4),R,X+W-1,"G",N)
- End DoDot:2
- End DoDot:1
- +18 if H>1
- DO WRITE(I,$PIECE(DDGLGRA,DDGLDEL,7)_$SELECT(W>1:L_$PIECE(DDGLGRA,DDGLDEL,8),1:""),Y+H-1,X,"G",N)
- +19 QUIT
- +20 ;
- 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 ;
- CODE(A,A1,A0) ;
- +1 ;Return code char for selected attr
- +2 NEW I,C,T
- +3 SET C=0
- SET (A1,A0)=""
- +4 SET T=$TRANSLATE(A,"burg","BURG")
- +5 FOR I=1:1:$LENGTH(A)
- Begin DoDot:1
- +6 SET T=$TEXT(@$EXTRACT(A,I))
- +7 IF T]""
- Begin DoDot:2
- +8 SET C=C+$PIECE(T,";",3)
- +9 SET A1=A1_$PIECE(@$PIECE(T,";",4),DDGLDEL,$PIECE(T,";",5))
- +10 SET A0=A0_$PIECE(@$PIECE(T,";",4),DDGLDEL,$PIECE(T,";",6))
- End DoDot:2
- End DoDot:1
- +11 QUIT $CHAR(C+32)
- +12 ;
- DECODE(C,A1,A0) ;
- +1 ;Given code char C, return codes to turn on/off attr
- +2 NEW B,T
- +3 SET (A1,A0)=""
- if " "[$GET(C)
- QUIT
- +4 SET C=$ASCII(C)-32
- +5 SET B=1
- FOR
- Begin DoDot:1
- +6 IF C\B#2
- IF $TEXT(@B)]""
- Begin DoDot:2
- +7 SET T=$TEXT(@B+1)
- +8 SET A1=A1_$PIECE(@$PIECE(T,";",4),DDGLDEL,$PIECE(T,";",5))
- +9 SET A0=A0_$PIECE(@$PIECE(T,";",4),DDGLDEL,$PIECE(T,";",6))
- End DoDot:2
- +10 SET B=B*2
- End DoDot:1
- if B>8
- QUIT
- +11 QUIT
- +12 ;
- 1 ;;
- B ;;1;DDGLVID;1;2
- 2 ;;
- U ;;2;DDGLVID;4;5
- 4 ;;
- R ;;4;DDGLVID;6;7
- 8 ;;
- G ;;8;DDGLGRA;1;2