File:  [Coherent Logic Development] / freem_fileman / USER / DDGFAPC.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: DDGFAPC	;SFISC/MKO-ADJUST PAGE COORDINATES ;01:16 PM  19 Jan 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;Input:
    5: 	; T  = PTOP: top of page
    6: 	;      PBRC: bottom right corner of page
    7: 	;Returns:
    8: 	; DDGFLIM
    9: 	;
   10: 	N DDGFE,P1,P2,P3,P4
   11: 	;
   12: 	D SETUP
   13: 	S DDGFE=0 F  S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y Q:DDGFE
   14: 	D CLEANUP
   15: 	Q
   16: 	;
   17: DESELECT	;
   18: 	S DDGFE=1
   19: 	Q
   20: 	;
   21: LNU	Q:DY'>$P(DDGFLIM,U)
   22: 	D MV(DY-1,DX)
   23: 	Q
   24: LND	Q:DY'<$P(DDGFLIM,U,3)
   25: 	D MV(DY+1,DX)
   26: 	Q
   27: CHR	Q:DX'<$P(DDGFLIM,U,4)
   28: 	D MV(DY,DX+1)
   29: 	Q
   30: CHL	Q:DX'>$P(DDGFLIM,U,2)
   31: 	D MV(DY,DX-1)
   32: 	Q
   33: TBR	Q:DX'<$P(DDGFLIM,U,4)
   34: 	D MV(DY,DX+$$MIN(5,$P(DDGFLIM,U,4)-DX))
   35: 	Q
   36: TBL	Q:DX'>$P(DDGFLIM,U,2)
   37: 	D MV(DY,DX-$$MIN(5,DX-$P(DDGFLIM,U,2)))
   38: 	Q
   39: SCT	Q:DY'>$P(DDGFLIM,U)
   40: 	D MV($P(DDGFLIM,U),DX)
   41: 	Q
   42: SCB	Q:DY'<$P(DDGFLIM,U,3)
   43: 	D MV($P(DDGFLIM,U,3),DX)
   44: 	Q
   45: SCR	Q:DX'<$P(DDGFLIM,U,4)
   46: 	D MV(DY,$P(DDGFLIM,U,4))
   47: 	Q
   48: SCL	Q:DX'>$P(DDGFLIM,U,2)
   49: 	D MV(DY,$P(DDGFLIM,U,2))
   50: 	Q
   51: 	;
   52: MV(DDGFY,DDGFX)	;
   53: 	I T="PTOP" D
   54: 	. F DDGFC=P1_U_P2,P1_U_P4,P3_U_P2,P3_U_P4 D REPALL^DDGLIBW(DDGFC_"^1^1")
   55: 	. S P1=P1+DDGFY-DY,P2=P2+DDGFX-DX,P3=P3+DDGFY-DY,P4=P4+DDGFX-DX
   56: 	;
   57: 	I T="PBRC" D
   58: 	. D:DDGFX'=DX REPALL^DDGLIBW(P1_U_P4_"^1^1")
   59: 	. D:DDGFY'=DY REPALL^DDGLIBW(P3_U_P2_"^1^1")
   60: 	. D REPALL^DDGLIBW(P3_U_P4_"^1^1")
   61: 	. S P3=P3+DDGFY-DY,P4=P4+DDGFX-DX
   62: 	;
   63: 	D CORNER()
   64: 	S DY=DDGFY,DX=DDGFX
   65: 	K DDGFC
   66: 	Q
   67: 	;
   68: CORNER(N)	;Draw corners of box
   69: 	;In: P1,P2,P3,P4,T; if N:normal video
   70: 	N DY,DX
   71: 	S DY=P1,DX=P2 X IOXY
   72: 	W $P(DDGLGRA,DDGLDEL)_$S($G(N):"",1:$P(DDGLVID,DDGLDEL,6))_$P(DDGLGRA,DDGLDEL,5)
   73: 	S DY=P1,DX=P4 X IOXY W $P(DDGLGRA,DDGLDEL,6)
   74: 	S DY=P3,DX=P2 X IOXY W $P(DDGLGRA,DDGLDEL,7)
   75: 	S DX=P4 X IOXY
   76: 	W $P(DDGLGRA,DDGLDEL,8)_$S($G(N):"",1:$P(DDGLVID,DDGLDEL,10))_$P(DDGLGRA,DDGLDEL,2)
   77: 	Q
   78: 	;
   79: MIN(X,Y,Z)	;Return the minimum of two or three numbers
   80: 	N A
   81: 	S A=$S(X<Y:X,1:Y)
   82: 	Q:$G(Z)="" A
   83: 	Q $S(A<Z:A,1:Z)
   84: 	;
   85: RC(DDGFY,DDGFX)	;Update status line, reset DX and DY, move cursor
   86: 	N S
   87: 	I DDGFR D
   88: 	. S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
   89: 	. X IOXY W S_$J("",7-$L(S))
   90: 	S DY=DDGFY,DX=DDGFX X IOXY
   91: 	Q
   92: 	;
   93: SETUP	;Initial setup
   94: 	S DDGFDY=DY,DDGFDX=DX
   95: 	;
   96: 	;Get page coordinates
   97: 	S P4=@DDGFREF@("F",DDGFPG)
   98: 	S P1=$P(P4,U),P2=$P(P4,U,2),P3=$P(P4,U,3),P4=$P(P4,U,4)
   99: 	S DDGFAREA=P1_U_P2_U_(P3-P1+1)_U_(P4-P2+1)
  100: 	;
  101: 	;Draw corners in reverse video, reset DDGFLIM
  102: 	D CORNER()
  103: 	I T="PTOP" S DDGFLIM=0_U_(DX-P2)_U_(DY+IOSL-8-P3)_U_(DX+IOM-2-P4)
  104: 	I T="PBRC" S DDGFLIM=P1+2_U_(P2+2)_U_(IOSL-8)_U_(IOM-2)
  105: 	Q
  106: 	;
  107: CLEANUP	;Final cleanup
  108: 	I DDGFDY'=DY!(DDGFDX'=DX) D
  109: 	. D PAGE^DDGFUPDP(P1,P2,P3,P4,T,DDGFAREA)
  110: 	E  D CORNER(1) S DDGFLIM=P1_U_P2_U_P3_U_P4
  111: 	;
  112: 	D RC(DY,DX)
  113: 	K DDGFDY,DDGFDX,DDGFAREA
  114: 	Q
  115: 	;
  116: READ()	N S,Y
  117: 	F  R *Y:DTIME D C Q:Y'=-1
  118: 	Q Y
  119: 	;
  120: C	I Y<0 S Y="TO" Q
  121: 	S S=""
  122: C1	S S=S_$C(Y)
  123: 	I DDGF("SIN")'[(U_S) D  I Y=-1 W $C(7) Q
  124: 	. I $C(Y)'?1L S Y=-1 Q
  125: 	. S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("SIN")'[(U_S_U) Y=-1
  126: 	;
  127: 	I DDGF("SIN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("SOUT"),U,$L($P(DDGF("SIN"),U_S_U),U)) Q
  128: 	R *Y:5 G:Y'=-1 C1 W $C(7)
  129: 	Q

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