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 / USER