Annotation of freem_fileman/DDW3.m, revision 1.1.1.1
1.1 snw 1: DDW3 ;SFISC/MKO-TOP, BOTTOM, SCROLL ;09:19 AM 23 Jun 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: ;
5: TOP N DDWI
6: I DDWA=0 D POS(1,1,"RN") Q
7: D SHFTUP(1),POS(1,1,"RN")
8: Q
9: ;
10: SHFTUP(DDWFL) ;
11: N DDWSH
12: S DDWSH=DDWA+1-DDWFL
13: D:DDWSH>DDWMR MSG^DDW("Repositioning ...")
14: ;
15: F DDWI=DDWMR:-1:$$MAX(1,DDWMR-DDWSH+1) D:DDWI+DDWA'>DDWCNT
16: . S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWI)
17: . ;
18: I $E(DDWBF,2) F DDWI=DDWA:-1:DDWFL+DDWMR D
19: . S DDWSTB=DDWSTB+1
20: . S ^TMP("DDW1",$J,DDWSTB)=^TMP("DDW",$J,DDWI)
21: E S DDWSTB=$$MAX(DDWCNT-DDWFL+1-DDWMR,0)
22: ;
23: S DDWA=DDWFL-1
24: I DDWSH>DDWMR D
25: . F DDWI=1:1:DDWMR S DDWL(DDWI)=^TMP("DDW",$J,DDWFL+DDWI-1)
26: . I $P(DDWOFS,U,4)=1 D
27: .. D CUP(1,1)
28: .. F DDWI=1:1:DDWMR W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))_$S(DDWI<DDWMR:$C(13,10),1:"")
29: . D MSG^DDW()
30: E D
31: . F DDWI=DDWMR:-1:DDWSH+1 S DDWL(DDWI)=DDWL(DDWI-DDWSH)
32: . F DDWI=DDWSH:-1:1 S DDWL(DDWI)=^TMP("DDW",$J,DDWFL+DDWI-1)
33: . D:$P(DDWOFS,U,4)=1 SCRDN(DDWSH)
34: ;
35: S:'DDWA $E(DDWBF,2)=0
36: Q
37: ;
38: BOT N DDWI
39: I DDWSTB=0 D POS($$MIN(DDWMR,DDWCNT-DDWA),"E","RN") Q
40: D SHFTDN($$MAX(1,DDWCNT-DDWMR+1))
41: D POS(DDWMR,"E","RN")
42: Q
43: ;
44: SHFTDN(DDWFL,DDWCOL) ;
45: N DDWNSTB,DDWSH
46: S DDWSH=DDWFL-DDWA-1,DDWNSTB=DDWCNT-DDWFL+1
47: D:DDWSH>DDWMR MSG^DDW("Repositioning ...")
48: ;
49: F DDWI=1:1:$$MIN(DDWSH,DDWMR) D
50: . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(DDWI)
51: ;
52: I $E(DDWBF,3) F DDWI=DDWSTB:-1:DDWNSTB+1 D
53: . S DDWA=DDWA+1
54: . S ^TMP("DDW",$J,DDWA)=^TMP("DDW1",$J,DDWI)
55: E S DDWA=DDWFL-1
56: ;
57: I DDWSH>DDWMR D
58: . F DDWI=1:1:DDWMR S DDWL(DDWI)=$S(DDWNSTB-DDWI+1>0:^TMP("DDW1",$J,DDWNSTB-DDWI+1),1:"")
59: . I $P(DDWOFS,U,4)=$$SCR($S($D(DDWCOL):DDWCOL,1:$L(DDWL(DDWMR))+1)) D
60: .. D CUP(1,1)
61: .. F DDWI=1:1:DDWMR W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))_$S(DDWI<DDWMR:$C(13,10),1:"")
62: . D MSG^DDW()
63: E D
64: . F DDWI=1:1:DDWMR-DDWSH S DDWL(DDWI)=DDWL(DDWI+DDWSH)
65: . F DDWI=DDWMR-DDWSH+1:1:DDWMR S DDWL(DDWI)=$S(DDWNSTB-DDWI+1>0:^TMP("DDW1",$J,DDWNSTB-DDWI+1),1:"")
66: . D:$P(DDWOFS,U,4)=$$SCR($L(DDWL(DDWMR))+1) SCRUP(DDWSH)
67: ;
68: S DDWSTB=$$MAX(0,DDWNSTB-DDWMR)
69: S:'DDWSTB $E(DDWBF,3)=0
70: Q
71: ;
72: MVFWD(DDWNUM) ;
73: N DDWI
74: F DDWI=1:1:DDWNUM S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(DDWI)
75: F DDWI=1:1:DDWMR-DDWNUM S DDWL(DDWI)=DDWL(DDWI+DDWNUM)
76: F DDWI=DDWMR-DDWNUM+1:1:DDWMR D
77: . S DDWL(DDWI)=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
78: D SCRUP(DDWNUM)
79: Q
80: ;
81: SCRUP(DDWNUM) ;
82: N DDWI
83: D CUP(DDWMR,1)
84: F DDWI=DDWMR-DDWNUM+1:1:DDWMR D
85: . I $P(DDGLED,DDGLDEL,2)]"" W $C(10)
86: . E D
87: .. D CUP(1,1) W $P(DDGLED,DDGLDEL,4)
88: .. D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3)
89: . I DDWL(DDWI)'?." " D
90: .. D CUP(DDWMR,1)
91: .. W $$LINE(DDWI,$G(DDWMARK))
92: D POS(DDWMR,DDWC,"RN")
93: Q
94: ;
95: MVBCK(DDWNUM) ;
96: N DDWI
97: F DDWI=DDWMR:-1:DDWMR-DDWNUM+1 D:DDWI+DDWA'>DDWCNT
98: . S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWI)
99: F DDWI=DDWMR:-1:DDWNUM+1 S DDWL(DDWI)=DDWL(DDWI-DDWNUM)
100: F DDWI=DDWNUM:-1:1 S DDWL(DDWI)=^TMP("DDW",$J,DDWA),DDWA=DDWA-1
101: D SCRDN(DDWNUM)
102: Q
103: ;
104: SCRDN(DDWNUM) ;
105: N DDWI
106: D CUP(1,1)
107: F DDWI=DDWNUM:-1:1 D
108: . I $P(DDGLED,DDGLDEL,2)]"" W $P(DDGLED,DDGLDEL)
109: . E D
110: .. D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4)
111: .. D CUP(1,1) W $P(DDGLED,DDGLDEL,3)
112: . I DDWL(DDWI)'?." " D
113: .. D CUP(1,1)
114: .. W $$LINE(DDWI,$G(DDWMARK))
115: D POS(1,DDWC,"RN")
116: Q
117: ;
118: ERR ;
119: W $C(7)
120: Q
121: ;
122: CUP(Y,X) ;
123: S DY=IOTM+Y-2,DX=X-1 X IOXY
124: Q
125: ;
126: POS(R,C,F) ;Pos cursor based on char pos C
127: N DDWX
128: S:$G(C)="E" C=$L($G(DDWL(R)))+1
129: S:$G(F)["N" DDWN=$G(DDWL(R))
130: S:$G(F)["R" DDWRW=R,DDWC=C
131: ;
132: S DDWX=C-DDWOFS
133: I DDWX>IOM!(DDWX<1) D SHIFT(C,.DDWOFS)
134: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
135: Q
136: ;
137: SHIFT(C,DDWOFS) ;
138: N DDWI,N,M,S
139: S N=$P(DDWOFS,U,2),M=$P(DDWOFS,U,3)
140: S S=$$SCR(C)
141: S DDWOFS=S-1*M_U_N_U_M_U_S
142: D RULER
143: F DDWI=1:1:$$MIN(DDWMR,DDWCNT) D
144: . S DY=IOTM+DDWI-2,DX=0 X IOXY
145: . W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))
146: Q
147: ;
148: RULER ;Write ruler
149: D CUP(DDWMR+1,1)
150: W $P(DDGLCLR,DDGLDEL)_$E(DDWRUL,1+DDWOFS,IOM+DDWOFS)
151: I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
152: . D CUP(DDWMR+1,DDWLMAR-DDWOFS) W "<"
153: I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
154: . D CUP(DDWMR+1,DDWRMAR-DDWOFS) W ">"
155: Q
156: ;
157: LINE(DDWI,DDWMARK) ;
158: N DDWX
159: S DDWX=$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
160: Q:$G(DDWMARK)="" DDWX
161: ;
162: N DDWR1,DDWC1,DDWR2,DDWC2
163: S DDWR1=$P(DDWMARK,U,1),DDWC1=$P(DDWMARK,U,2)
164: S DDWR2=$P(DDWMARK,U,3),DDWC2=$P(DDWMARK,U,4)
165: ;
166: I DDWI'<(DDWR1-DDWA),DDWI'>(DDWR2-DDWA) D
167: . N DDWX1,DDWX2
168: . S DDWX1=$S(DDWI=(DDWR1-DDWA):DDWC1,1:1)
169: . S DDWX2=$S(DDWI=(DDWR2-DDWA):DDWC2,1:999)
170: . S DDWX=$E(DDWL(DDWI),1+DDWOFS,DDWX1-1)_$P(DDGLVID,DDGLDEL,6)_$E(DDWL(DDWI),$$MAX(DDWX1,1+DDWOFS),$$MIN(DDWX2,IOM+DDWOFS))_$P(DDGLVID,DDGLDEL,10)_$E(DDWL(DDWI),$$MAX(DDWX2+1,1+DDWOFS),IOM+DDWOFS)
171: Q DDWX
172: ;
173: SCR(C) ;
174: Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
175: ;
176: MIN(X,Y) ;
177: Q $S(X<Y:X,1:Y)
178: ;
179: MAX(X,Y) ;
180: Q $S(X>Y:X,1:Y)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDW3.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman