183 lines
4.7 KiB
Mathematica
183 lines
4.7 KiB
Mathematica
DDW5 ;SFISC/PD KELTZ-WRAP, BREAK, ILINE, XLINE ;01:23 PM 21 Dec 1994
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
WRAP ;Wrap at word boundary
|
|
S:$E(DDWN,DDWC,999)?1." " (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
|
|
I DDWC'>$L(DDWN) D WRAPI Q
|
|
I 'DDWRAP D POS(DDWRW,DDWRMAR+1,"R"),BREAK(1) Q
|
|
D WRAPW
|
|
Q
|
|
;
|
|
WRAPI ;Cursor in middle
|
|
I $E(DDWN,DDWLMAR,999)'[" "!'DDWRAP D BREAK(-1),POS(DDWRW-1,"E","RN") Q
|
|
N DDWCSV,DDWI,DDWLST,DDWRMSV
|
|
S DDWI=$F(DDWN," ",DDWC)
|
|
I DDWI,DDWI-2'>DDWRMAR D
|
|
. S DDWCSV=DDWC
|
|
. S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
|
|
. D POS(DDWRW,DDWI,"R"),BREAK(-1),POS(DDWRW-1,DDWCSV,"RN")
|
|
. S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
|
|
E I DDWC=2 D
|
|
. D POS(DDWRW,DDWRMAR+1,"R"),BREAK(-1),POS(DDWRW-1,2,"RN")
|
|
E D
|
|
. S DDWLST=$$TR($E(DDWN,DDWC,999))
|
|
. S (DDWL(DDWRW),DDWN)=$E(DDWN,1,DDWC-1)
|
|
. S DDWRMSV=DDWRMAR,DDWRMAR=$$MIN(DDWRMAR,DDWC-2)
|
|
. D WRAPW
|
|
. W $E(DDWLST,1,IOM+DDWOFS-DDWC)
|
|
. S DDWL(DDWRW)=DDWN_DDWLST,DDWRMAR=DDWRMSV
|
|
. D POS(DDWRW,DDWC,"RN")
|
|
Q
|
|
;
|
|
WRAPW ;Cursor at end
|
|
N DDWI,DDWS1,DDWS2,DDWTXT
|
|
S DDWTXT(1)=DDWN
|
|
D ADJMAR^DDW6(.DDWTXT,"","I")
|
|
;
|
|
S DDWS1=$$SCR($L(DDWTXT(1))+1),DDWS2=$$SCR($L(DDWTXT(DDWTXT))+1)
|
|
I DDWS1=$P(DDWOFS,U,4),DDWS2=$P(DDWOFS,U,4),DDWTXT=2 D
|
|
. S (DDWN,DDWL(DDWRW))=DDWTXT(1)_DDWTXT(2)
|
|
. S DDWC=$L(DDWTXT(1))+1
|
|
. D POS(DDWRW,DDWC),BREAK(1)
|
|
;
|
|
E D
|
|
. F DDWI=1:1:DDWTXT-1 D
|
|
.. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
|
|
.. D ILINE
|
|
.. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI+1)
|
|
.. I DDWS2=$P(DDWOFS,U,4) D
|
|
... D CUP(DDWRW-1,1)
|
|
... W $P(DDGLCLR,DDGLDEL)_$E(DDWTXT(DDWI),1+DDWOFS,IOM+DDWOFS)
|
|
... D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
|
|
. D POS(DDWRW,"E","R")
|
|
Q
|
|
;
|
|
BREAK(DDWFLAG) ;Break line, make new line current
|
|
;Final cursor position:
|
|
; 0:lmar of new line (used by <RET>)
|
|
; 1:end of new line (used by Wrap)
|
|
;-1:doesn't matter (used by Wrap)
|
|
N DDWRST
|
|
I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
|
|
S DDWRST=$E(DDWN,DDWC,999)
|
|
I DDWLMAR>1,DDWRST'?@(DDWLMAR-1_""" "".E") D
|
|
. S DDWRST=$J("",DDWLMAR-1)_$$LD(DDWRST)
|
|
S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
|
|
W $P(DDGLCLR,DDGLDEL)
|
|
D ILINE
|
|
S (DDWN,DDWL(DDWRW))=DDWRST
|
|
;
|
|
I $G(DDWFLAG)=1 D
|
|
. I $$SCR($L(DDWN)+1)=$P(DDWOFS,U,4) D
|
|
.. D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
|
|
. D POS(DDWRW,"E","R")
|
|
;
|
|
E I '$G(DDWFLAG) D
|
|
. I $P(DDWOFS,U,4)=1 D CUP(DDWRW,1) W $E(DDWN,1,IOM)
|
|
. D POS(DDWRW,DDWLMAR,"R")
|
|
;
|
|
E D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
|
|
Q
|
|
;
|
|
ILINE ;Insert line below current line, make that current
|
|
;Column is unchanged
|
|
N DDWI,DDWX
|
|
I DDWRW<DDWMR D
|
|
. I DDWA+DDWMR'>DDWCNT D
|
|
.. S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWMR)
|
|
. F DDWI=DDWMR:-1:DDWRW+2 S DDWL(DDWI)=DDWL(DDWI-1)
|
|
. S DDWL(DDWRW+1)=""
|
|
. D CUP(DDWRW+1,1)
|
|
. ;
|
|
. I $P(DDGLED,DDGLDEL,3)]"" D
|
|
.. I $P(DDGLED,DDGLDEL,2)="" D
|
|
... D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4) D CUP(DDWRW+1,1)
|
|
.. W $P(DDGLED,DDGLDEL,3)
|
|
. E D
|
|
.. S DDWX=IOTM
|
|
.. S IOTM=IOTM+DDWRW W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
|
|
.. D CUP(DDWRW+1,1) W $P(DDGLED,DDGLDEL)
|
|
.. W @$P(DDGLED,DDGLDEL,2)
|
|
. D POS(DDWRW+1,DDWC,"RN")
|
|
;
|
|
E D
|
|
. S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(1)
|
|
. F DDWI=1:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
|
|
. S DDWL(DDWMR)=""
|
|
. D SCRUP^DDW3(1)
|
|
S DDWCNT=DDWCNT+1
|
|
S $E(DDWBF,1,3)=111
|
|
Q
|
|
;
|
|
XLINE(DDWFLAG,DDWNP) ;Delete current line
|
|
;DDWFLAG:
|
|
; 1:leave cursor on deleted line (used by Join)
|
|
; 0:move cursor up one line if deleted line is last line
|
|
; (used by PF1-D and DELBLK)
|
|
; DDWNP = 1:don't bother printing, used by DELBLK
|
|
N DDWI,DDWX
|
|
I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
|
|
F DDWI=DDWRW:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
|
|
S DDWX="" S:DDWSTB DDWX=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
|
|
S DDWL(DDWMR)=DDWX
|
|
;
|
|
D:'$G(DDWNP) XLINEP
|
|
;
|
|
S DDWCNT=DDWCNT-1
|
|
I 'DDWCNT D
|
|
. S DDWCNT=1 D POS(1,DDWLMAR,"RN")
|
|
E I DDWA+DDWRW>DDWCNT,'$G(DDWFLAG) D
|
|
. D UP^DDWT1
|
|
E D POS(DDWRW,DDWC,"N")
|
|
S $E(DDWBF,1,3)=111
|
|
Q
|
|
;
|
|
XLINEP ;Redisplay screen
|
|
I $P(DDGLED,DDGLDEL,4)]"" D
|
|
. W $P(DDGLED,DDGLDEL,4)
|
|
. I $P(DDGLED,DDGLDEL,2)="" D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3)
|
|
E I DDWRW<DDWMR D
|
|
. S DDWX=IOTM
|
|
. S IOTM=IOTM+DDWRW-1 W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
|
|
. D CUP(DDWMR,1) W $C(10)
|
|
. W @$P(DDGLED,DDGLDEL,2)
|
|
E D
|
|
. D CUP(DDWMR,1) W $P(DDGLCLR,DDGLDEL)
|
|
;
|
|
I DDWL(DDWMR)'?." " D
|
|
. D CUP(DDWMR,1)
|
|
. W $E(DDWL(DDWMR),1+DDWOFS,IOM+DDWOFS)
|
|
Q
|
|
;
|
|
TR(X) Q:$G(X)="" X
|
|
N I
|
|
F I=$L(X):-1:0 Q:$E(X,I)'=" "
|
|
Q $E(X,1,I)
|
|
;
|
|
LD(X) Q:$G(X)="" X
|
|
N I
|
|
F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
|
|
Q $E(X,I,999)
|
|
;
|
|
CUP(Y,X) ;
|
|
S DY=IOTM+Y-2,DX=X-1 X IOXY
|
|
Q
|
|
;
|
|
POS(R,C,F) ;
|
|
N DDWX
|
|
S:$G(C)="E" C=$L($G(DDWL(R)))+1
|
|
S:$G(F)["N" DDWN=$G(DDWL(R))
|
|
S:$G(F)["R" DDWRW=R,DDWC=C
|
|
;
|
|
S DDWX=C-DDWOFS
|
|
I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
|
|
S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
|
|
Q
|
|
;
|
|
SCR(C) ;
|
|
Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
|
|
;
|
|
MIN(X,Y) ;
|
|
Q $S(X<Y:X,1:Y)
|