File:  [Coherent Logic Development] / freem_fileman / USER / DDGFBSEL.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDGFBSEL	;SFISC/MKO-SELECT BLOCK ;07:50 AM  23 Aug 1993
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;Sets:
    5: 	;  DDGFORIG(B) = original $Y^original $X for all blocks that were
    6: 	;                  selected, since they were potentially moved
    7: SELECT	;
    8: 	N B,C,C1,C2,C3
    9: 	N B1,X1,X2
   10: 	;
   11: 	;Which element is the cursor on?
   12: 	;Set B=Block
   13: 	S X1="" K B
   14: 	F  S X1=$O(@DDGFREF@("BKRC",DDGFWIDB,DY,X1)) Q:X1=""!(DX<X1)  D
   15: 	. S X2=""
   16: 	. F  S X2=$O(@DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2)) Q:X2=""  D  Q:$G(B)
   17: 	.. Q:DX>X2
   18: 	.. S B=$O(@DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2,""))
   19: 	.. I @DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2,B)="H",$O(^(B)) S B=$O(^(B))
   20: 	Q:'$G(B)
   21: 	;
   22: 	;Get caption and coordinates
   23: 	S B1=$G(@DDGFREF@("F",DDGFPG,B)) Q:B1=""
   24: 	S C1=$P(B1,U),C2=$P(B1,U,2),C3=$P(B1,U,3),C=$P(B1,U,4)
   25: 	;
   26: 	S:@DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)="H" DDGFHDR=1
   27: 	D COVER
   28: 	;
   29: 	K B1,X1,X2
   30: 	G ^DDGF4
   31: 	;
   32: COVER	;
   33: 	N H,O,L
   34: 	;Clear and/or kill portions of DDGFREF
   35: 	K @DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)
   36: 	;
   37: 	;Remember original block coordinates
   38: 	S:$D(DDGFORIG(B))[0 DDGFORIG(B)=C1_U_C2
   39: 	;
   40: 	;Look for covered (hidden) fields
   41: 	;Set H(B) - array of hidden fields
   42: 	S X1=""
   43: 	F  S X1=$O(@DDGFREF@("BKRC",DDGFWIDB,C1,X1)) Q:X1=""  D
   44: 	. S X2=""
   45: 	. F  S X2=$O(@DDGFREF@("BKRC",DDGFWIDB,C1,X1,X2)) Q:X2=""  D
   46: 	.. S H=$O(@DDGFREF@("BKRC",DDGFWIDB,C1,X1,X2,""))
   47: 	.. I H]"",$D(H(H))[0,$$OVERLAP(C2,C3,X1,X2) S H(H)=""
   48: 	;
   49: 	;Clear in buffer area occupied by element(s) selected
   50: 	;If block on the page border, redraw the lines
   51: 	S L=$J("",$L(C)-$S(C3>$P(DDGFLIM,U,4):C3-$P(DDGFLIM,U,4),1:0))
   52: 	D WRITE^DDGLIBW(DDGFWIDB,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
   53: 	;
   54: 	I $P(@DDGFREF@("F",DDGFPG),U,3) D
   55: 	. I C1=$P(DDGFLIM,U)!(C1=$P(DDGFLIM,U,3)) D
   56: 	.. S L=$TR(L," ",$P(DDGLGRA,DDGLDEL,3))
   57: 	.. S:C2=$P(DDGFLIM,U,2) $E(L)=$P(DDGLGRA,DDGLDEL,$S(C1=$P(DDGFLIM,U):5,1:7))
   58: 	.. S:C3'<$P(DDGFLIM,U,4) $E(L,$L(L))=$P(DDGLGRA,DDGLDE,$S(C1=$P(DDGFLIM,U):6,1:8))
   59: 	.. D WRITE^DDGLIBW(DDGFWIDB,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
   60: 	. E  I C2=$P(DDGFLIM,U,2) D
   61: 	.. D WRITE^DDGLIBW(DDGFWIDB,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
   62: 	. E  I C3'<$P(DDGFLIM,U,4) D
   63: 	.. D WRITE^DDGLIBW(DDGFWIDB,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),$P(DDGFLIM,U,4)-$P(DDGFLIM,U,2),"G",1)
   64: 	;
   65: 	;Write to buffer the overlapped blocks(s)
   66: 	I $D(H)>1 S H="" F  S H=$O(H(H)) Q:H=""  D
   67: 	. S B1=$G(@DDGFREF@("F",DDGFPG,H)) Q:B1=""
   68: 	. D WRITE^DDGLIBW(DDGFWIDB,$P(B1,U,4),$P(B1,U)-$P(DDGFLIM,U),$P(B1,U,2)-$P(DDGFLIM,U,2),"",1)
   69: 	Q
   70: 	;
   71: OVERLAP(A1,A2,B1,B2)	;Does line with X-coords A1,A2 overlap B1,B2
   72: 	N T
   73: 	I A1<B1 S T=A1,A1=B1,B1=T,T=A2,A2=B2,B2=T
   74: 	Q A1'<B1&(A1'>B2)!(A2'<B1&(A2'>B2))

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>