Annotation of freem_fileman/DDW6.m, revision 1.1
1.1 ! snw 1: DDW6 ;SFISC/MKO-JOIN ;08:51 AM 31 Aug 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: ;
! 5: REFMT ;Reformat
! 6: N DDWRFMT
! 7: I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
! 8: D POS(DDWRW,DDWLMAR,"R")
! 9: S DDWRFMT=0 F D JOIN Q:DDWRFMT
! 10: Q
! 11: ;
! 12: JOIN ;Join
! 13: N DDWI,DDWSCR,DDWNSV,DDWLL,DDWTXT,DDWTXT0
! 14: I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
! 15: ;
! 16: ;Get current line
! 17: S:DDWN?." " (DDWN,DDWL(DDWRW))=$J("",DDWLMAR-1)
! 18: S (DDWTXT(1),DDWNSV)=DDWN
! 19: ;
! 20: ;Get next line
! 21: I DDWRW=DDWMR S:DDWSTB DDWTXT(2)=^TMP("DDW1",$J,DDWSTB)
! 22: E S:DDWA+DDWRW<DDWCNT DDWTXT(2)=DDWL(DDWRW+1)
! 23: ;
! 24: I $G(DDWTXT(2))?." " D Q:$G(DDWRFMT)
! 25: . I $L(DDWN)>DDWRMAR S:$D(DDWTXT(2))#2 DDWLL=DDWTXT(2)
! 26: . E I $D(DDWRFMT) S DDWRFMT=1
! 27: ;
! 28: ;Adjust
! 29: S DDWTXT0=$O(DDWTXT(""),-1)
! 30: D ADJMAR(.DDWTXT,"","I")
! 31: S:$D(DDWLL) DDWTXT=DDWTXT+1,DDWTXT(DDWTXT)=DDWLL
! 32: S (DDWN,DDWL(DDWRW))=DDWTXT(1)
! 33: ;
! 34: ;Delete next line
! 35: I DDWTXT0>1,DDWTXT=1 D
! 36: . I DDWRW=DDWMR S DDWSTB=DDWSTB-1,DDWCNT=DDWCNT-1,$E(DDWBF,1,3)=111
! 37: . E D POS(DDWRW+1,DDWC,"RN"),XLINE^DDW5(1),POS(DDWRW-1,DDWC,"RN")
! 38: ;
! 39: ;DDWSCR: curr scr = final scr
! 40: I DDWTXT=1,'$D(DDWRFMT) D
! 41: . S DDWSCR=$$SCR($L(DDWTXT(1))+1)=$P(DDWOFS,U,4)
! 42: E D
! 43: . S DDWSCR=$$SCR(DDWLMAR)=$P(DDWOFS,U,4)
! 44: ;
! 45: I DDWSCR,$L(DDWNSV)'=$L(DDWN) D
! 46: . D CUP(DDWRW,$$MIN($L(DDWNSV),$L(DDWN))+1-DDWOFS)
! 47: . W $P(DDGLCLR,DDGLDEL)_$E(DDWN,$L(DDWNSV)+1,IOM+DDWOFS)
! 48: ;
! 49: I DDWTXT=1 D
! 50: . I '$D(DDWRFMT) D
! 51: .. D POS(DDWRW,"E","RN")
! 52: . E D POS(DDWRW,DDWLMAR,"RN")
! 53: E D JOIN2
! 54: Q
! 55: ;
! 56: JOIN2 ;Join produced >1 lines
! 57: D POS(DDWRW,DDWLMAR,"R")
! 58: ;
! 59: I DDWTXT0=2 D
! 60: . I DDWRW<DDWMR S DDWL(DDWRW+1)=DDWTXT(2)
! 61: . E S ^TMP("DDW1",$J,DDWSTB)=DDWTXT(2)
! 62: . ;
! 63: . I DDWRW<DDWMR D
! 64: .. S DDWRW=DDWRW+1
! 65: .. I DDWSCR D
! 66: ... D CUP(DDWRW,1)
! 67: ... W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWRW),1+DDWOFS,IOM+DDWOFS)
! 68: . E D MVFWD^DDW3(1)
! 69: ;
! 70: F DDWI=DDWTXT0+1:1:DDWTXT D
! 71: . D ILINE^DDW5
! 72: . S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
! 73: . D CUP(DDWRW,1)
! 74: . W $P(DDGLCLR,DDGLDEL)_$E(DDWN,1+DDWOFS,IOM+DDWOFS)
! 75: ;
! 76: D POS(DDWRW-($D(DDWLL)#2),DDWLMAR,"RN")
! 77: Q
! 78: ;
! 79: ADJMAR(DDWT,DDWW,DDWFLG) ;Adjust length of text in DDWT array
! 80: ; DDWT = Text array
! 81: ; DDWW = Width
! 82: ;DDWFLG = I:First line $L=DDWRMAR, subsequent $L=DDWRMAR-DDWLMAR+1
! 83: ;
! 84: N DDWJ
! 85: S DDWJ=1
! 86: I $G(DDWFLG)["I" S DDWW=DDWRMAR
! 87: E I '$D(DDWW) S DDWW=DDWRMAR-DDWLMAR+1
! 88: ;
! 89: F Q:'$D(DDWT(DDWJ)) D AMLOOP
! 90: S DDWT=$O(DDWT(""),-1)
! 91: I DDWLMAR>1 F DDWJ=$G(DDWFLG)["I"+1:1:DDWT D
! 92: . S DDWT(DDWJ)=$J("",DDWLMAR-1)_DDWT(DDWJ)
! 93: Q
! 94: ;
! 95: AMLOOP ;Process DDWT(DDWJ)
! 96: I $L(DDWT(DDWJ))>DDWW F D Q:$L(DDWT(DDWJ))'>DDWW
! 97: . N DDWK,DDWFST,DDWLST
! 98: . F DDWK=$O(DDWT(""),-1)+1:-1:DDWJ+2 S DDWT(DDWK)=DDWT(DDWK-1)
! 99: . D SLICE(DDWT(DDWJ),DDWW,.DDWFST,.DDWLST)
! 100: . S DDWT(DDWJ)=DDWFST,DDWT(DDWJ+1)=DDWLST
! 101: . D AMINCJ
! 102: ;
! 103: E I $L(DDWT(DDWJ))=DDWW!'$D(DDWT(DDWJ+1)) D
! 104: . I DDWRAP,$D(DDWT(DDWJ+1)) S DDWT(DDWJ+1)=$$LD(DDWT(DDWJ+1))
! 105: . D AMINCJ
! 106: ;
! 107: E I 'DDWRAP D
! 108: . N DDWK S DDWK=DDWW-$L(DDWT(DDWJ))
! 109: . S DDWT(DDWJ)=DDWT(DDWJ)_$E(DDWT(DDWJ+1),1,DDWK)
! 110: . S DDWT(DDWJ+1)=$E(DDWT(DDWJ+1),DDWK+1,999)
! 111: . D:DDWT(DDWJ+1)="" AMSHIFT(.DDWT,DDWJ+1)
! 112: ;
! 113: E D
! 114: . N DDWD,DDWI
! 115: . S DDWT(DDWJ+1)=$$LD(DDWT(DDWJ+1))
! 116: . S:DDWT(DDWJ)'?.E1" " DDWT(DDWJ)=DDWT(DDWJ)_" "
! 117: . S DDWD=0 F DDWI=1:1:$L(DDWT(DDWJ+1)," ") D Q:DDWD
! 118: .. I $L(DDWT(DDWJ))+$L($P(DDWT(DDWJ+1)," "))>DDWW S DDWD=1 Q
! 119: .. ;
! 120: .. S DDWT(DDWJ)=DDWT(DDWJ)_$P(DDWT(DDWJ+1)," ")
! 121: .. S:$L(DDWT(DDWJ))<DDWW DDWT(DDWJ)=DDWT(DDWJ)_" "
! 122: .. S DDWT(DDWJ+1)=$P(DDWT(DDWJ+1)," ",2,999)
! 123: . ;
! 124: . S DDWT(DDWJ)=$$TR(DDWT(DDWJ)),DDWT(DDWJ+1)=$$LD(DDWT(DDWJ+1))
! 125: . I DDWT(DDWJ+1)="" D
! 126: .. D AMSHIFT(.DDWT,DDWJ+1)
! 127: . E D:DDWI=1 AMINCJ
! 128: Q
! 129: ;
! 130: AMSHIFT(DDWT,DDWJ) ;Delete DDWT(DDWJ) and shift up
! 131: N DDWI
! 132: F DDWI=DDWJ:1:$O(DDWT(""),-1)-1 S DDWT(DDWI)=DDWT(DDWI+1)
! 133: K DDWT($O(DDWT(""),-1))
! 134: Q
! 135: ;
! 136: AMINCJ ;Incr DDWJ
! 137: I DDWJ=1,$G(DDWFLG)["I" S DDWW=DDWRMAR-DDWLMAR+1
! 138: S DDWJ=DDWJ+1
! 139: Q
! 140: ;
! 141: SLICE(DDWN,DDWW,DDWFST,DDWRST) ;
! 142: ;Out: DDWFST=first part of text, $L<=DDWRMAR (trailing bl removed)
! 143: ; DDWRST=remaining part (lead blanks removed)
! 144: N DDWI,DDWX
! 145: S:'$G(DDWW) DDWW=DDWRMAR
! 146: ;
! 147: I 'DDWRAP S DDWFST=$E(DDWN,1,DDWW),DDWLST=$E(DDWN,DDWW+1,999) Q
! 148: ;
! 149: F DDWI=$L(DDWN," "):-1:1 Q:$L($P(DDWN," ",1,DDWI))'>DDWW
! 150: S:$E(DDWN,1,DDWI)?." " DDWI=999
! 151: S DDWFST=$$TR($P(DDWN," ",1,DDWI))
! 152: S:$L(DDWFST)>DDWW DDWFST=$E(DDWFST,1,DDWW)
! 153: S DDWRST=$$LD($E(DDWN,$L(DDWFST)+1,999))
! 154: Q
! 155: ;
! 156: TR(X) Q:$G(X)="" X
! 157: N I
! 158: F I=$L(X):-1:0 Q:$E(X,I)'=" "
! 159: Q $E(X,1,I)
! 160: ;
! 161: LD(X) Q:$G(X)="" X
! 162: N I
! 163: F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
! 164: Q $E(X,I,999)
! 165: ;
! 166: CUP(Y,X) ;
! 167: S DY=IOTM+Y-2,DX=X-1 X IOXY
! 168: Q
! 169: ;
! 170: POS(R,C,F) ;Pos cursor
! 171: N DDWX
! 172: S:$G(C)="E" C=$L($G(DDWL(R)))+1
! 173: S:$G(F)["N" DDWN=$G(DDWL(R))
! 174: S:$G(F)["R" DDWRW=R,DDWC=C
! 175: ;
! 176: S DDWX=C-DDWOFS
! 177: I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
! 178: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
! 179: Q
! 180: ;
! 181: SCR(C) ;Screen number
! 182: Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
! 183: ;
! 184: MIN(X,Y) ;
! 185: Q $S(X<Y:X,1:Y)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDW6.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman