1: DDW5 ;SFISC/PD KELTZ-WRAP, BREAK, ILINE, XLINE ;01:23 PM 21 Dec 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: ;
5: WRAP ;Wrap at word boundary
6: S:$E(DDWN,DDWC,999)?1." " (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
7: I DDWC'>$L(DDWN) D WRAPI Q
8: I 'DDWRAP D POS(DDWRW,DDWRMAR+1,"R"),BREAK(1) Q
9: D WRAPW
10: Q
11: ;
12: WRAPI ;Cursor in middle
13: I $E(DDWN,DDWLMAR,999)'[" "!'DDWRAP D BREAK(-1),POS(DDWRW-1,"E","RN") Q
14: N DDWCSV,DDWI,DDWLST,DDWRMSV
15: S DDWI=$F(DDWN," ",DDWC)
16: I DDWI,DDWI-2'>DDWRMAR D
17: . S DDWCSV=DDWC
18: . S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
19: . D POS(DDWRW,DDWI,"R"),BREAK(-1),POS(DDWRW-1,DDWCSV,"RN")
20: . S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
21: E I DDWC=2 D
22: . D POS(DDWRW,DDWRMAR+1,"R"),BREAK(-1),POS(DDWRW-1,2,"RN")
23: E D
24: . S DDWLST=$$TR($E(DDWN,DDWC,999))
25: . S (DDWL(DDWRW),DDWN)=$E(DDWN,1,DDWC-1)
26: . S DDWRMSV=DDWRMAR,DDWRMAR=$$MIN(DDWRMAR,DDWC-2)
27: . D WRAPW
28: . W $E(DDWLST,1,IOM+DDWOFS-DDWC)
29: . S DDWL(DDWRW)=DDWN_DDWLST,DDWRMAR=DDWRMSV
30: . D POS(DDWRW,DDWC,"RN")
31: Q
32: ;
33: WRAPW ;Cursor at end
34: N DDWI,DDWS1,DDWS2,DDWTXT
35: S DDWTXT(1)=DDWN
36: D ADJMAR^DDW6(.DDWTXT,"","I")
37: ;
38: S DDWS1=$$SCR($L(DDWTXT(1))+1),DDWS2=$$SCR($L(DDWTXT(DDWTXT))+1)
39: I DDWS1=$P(DDWOFS,U,4),DDWS2=$P(DDWOFS,U,4),DDWTXT=2 D
40: . S (DDWN,DDWL(DDWRW))=DDWTXT(1)_DDWTXT(2)
41: . S DDWC=$L(DDWTXT(1))+1
42: . D POS(DDWRW,DDWC),BREAK(1)
43: ;
44: E D
45: . F DDWI=1:1:DDWTXT-1 D
46: .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
47: .. D ILINE
48: .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI+1)
49: .. I DDWS2=$P(DDWOFS,U,4) D
50: ... D CUP(DDWRW-1,1)
51: ... W $P(DDGLCLR,DDGLDEL)_$E(DDWTXT(DDWI),1+DDWOFS,IOM+DDWOFS)
52: ... D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
53: . D POS(DDWRW,"E","R")
54: Q
55: ;
56: BREAK(DDWFLAG) ;Break line, make new line current
57: ;Final cursor position:
58: ; 0:lmar of new line (used by <RET>)
59: ; 1:end of new line (used by Wrap)
60: ;-1:doesn't matter (used by Wrap)
61: N DDWRST
62: I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
63: S DDWRST=$E(DDWN,DDWC,999)
64: I DDWLMAR>1,DDWRST'?@(DDWLMAR-1_""" "".E") D
65: . S DDWRST=$J("",DDWLMAR-1)_$$LD(DDWRST)
66: S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
67: W $P(DDGLCLR,DDGLDEL)
68: D ILINE
69: S (DDWN,DDWL(DDWRW))=DDWRST
70: ;
71: I $G(DDWFLAG)=1 D
72: . I $$SCR($L(DDWN)+1)=$P(DDWOFS,U,4) D
73: .. D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
74: . D POS(DDWRW,"E","R")
75: ;
76: E I '$G(DDWFLAG) D
77: . I $P(DDWOFS,U,4)=1 D CUP(DDWRW,1) W $E(DDWN,1,IOM)
78: . D POS(DDWRW,DDWLMAR,"R")
79: ;
80: E D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
81: Q
82: ;
83: ILINE ;Insert line below current line, make that current
84: ;Column is unchanged
85: N DDWI,DDWX
86: I DDWRW<DDWMR D
87: . I DDWA+DDWMR'>DDWCNT D
88: .. S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWMR)
89: . F DDWI=DDWMR:-1:DDWRW+2 S DDWL(DDWI)=DDWL(DDWI-1)
90: . S DDWL(DDWRW+1)=""
91: . D CUP(DDWRW+1,1)
92: . ;
93: . I $P(DDGLED,DDGLDEL,3)]"" D
94: .. I $P(DDGLED,DDGLDEL,2)="" D
95: ... D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4) D CUP(DDWRW+1,1)
96: .. W $P(DDGLED,DDGLDEL,3)
97: . E D
98: .. S DDWX=IOTM
99: .. S IOTM=IOTM+DDWRW W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
100: .. D CUP(DDWRW+1,1) W $P(DDGLED,DDGLDEL)
101: .. W @$P(DDGLED,DDGLDEL,2)
102: . D POS(DDWRW+1,DDWC,"RN")
103: ;
104: E D
105: . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(1)
106: . F DDWI=1:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
107: . S DDWL(DDWMR)=""
108: . D SCRUP^DDW3(1)
109: S DDWCNT=DDWCNT+1
110: S $E(DDWBF,1,3)=111
111: Q
112: ;
113: XLINE(DDWFLAG,DDWNP) ;Delete current line
114: ;DDWFLAG:
115: ; 1:leave cursor on deleted line (used by Join)
116: ; 0:move cursor up one line if deleted line is last line
117: ; (used by PF1-D and DELBLK)
118: ; DDWNP = 1:don't bother printing, used by DELBLK
119: N DDWI,DDWX
120: I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
121: F DDWI=DDWRW:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
122: S DDWX="" S:DDWSTB DDWX=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
123: S DDWL(DDWMR)=DDWX
124: ;
125: D:'$G(DDWNP) XLINEP
126: ;
127: S DDWCNT=DDWCNT-1
128: I 'DDWCNT D
129: . S DDWCNT=1 D POS(1,DDWLMAR,"RN")
130: E I DDWA+DDWRW>DDWCNT,'$G(DDWFLAG) D
131: . D UP^DDWT1
132: E D POS(DDWRW,DDWC,"N")
133: S $E(DDWBF,1,3)=111
134: Q
135: ;
136: XLINEP ;Redisplay screen
137: I $P(DDGLED,DDGLDEL,4)]"" D
138: . W $P(DDGLED,DDGLDEL,4)
139: . I $P(DDGLED,DDGLDEL,2)="" D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3)
140: E I DDWRW<DDWMR D
141: . S DDWX=IOTM
142: . S IOTM=IOTM+DDWRW-1 W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
143: . D CUP(DDWMR,1) W $C(10)
144: . W @$P(DDGLED,DDGLDEL,2)
145: E D
146: . D CUP(DDWMR,1) W $P(DDGLCLR,DDGLDEL)
147: ;
148: I DDWL(DDWMR)'?." " D
149: . D CUP(DDWMR,1)
150: . W $E(DDWL(DDWMR),1+DDWOFS,IOM+DDWOFS)
151: Q
152: ;
153: TR(X) Q:$G(X)="" X
154: N I
155: F I=$L(X):-1:0 Q:$E(X,I)'=" "
156: Q $E(X,1,I)
157: ;
158: LD(X) Q:$G(X)="" X
159: N I
160: F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
161: Q $E(X,I,999)
162: ;
163: CUP(Y,X) ;
164: S DY=IOTM+Y-2,DX=X-1 X IOXY
165: Q
166: ;
167: POS(R,C,F) ;
168: N DDWX
169: S:$G(C)="E" C=$L($G(DDWL(R)))+1
170: S:$G(F)["N" DDWN=$G(DDWL(R))
171: S:$G(F)["R" DDWRW=R,DDWC=C
172: ;
173: S DDWX=C-DDWOFS
174: I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
175: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
176: Q
177: ;
178: SCR(C) ;
179: Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
180: ;
181: MIN(X,Y) ;
182: Q $S(X<Y:X,1:Y)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDW5.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