Return to DDW5.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DDW5	;SFISC/PD KELTZ-WRAP, BREAK, ILINE, XLINE ;01:23 PM  21 Dec 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;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)