Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XGSW

XGSW.m

Go to the documentation of this file.
  1. XGSW ;SFISC/VYD - screen window primitives ;01/11/95 15:58
  1. ;;8.0;KERNEL;;Jul 10, 1995
  1. ;
  1. WIN(T,L,B,R,S) ;draw a bordered window
  1. ;top,left,bottom,right,screen root
  1. S:B'<IOSL B=IOSL-1,XGFLAG("TOO LONG")=1 ;adjust if longer than screen
  1. S:R'<IOM R=IOM-1,XGFLAG("TOO WIDE")=1 ;adjust if wider than screen
  1. D:$D(S) SAVE(T,L,B,R,S)
  1. N L2,R2,%MIDDLE,%MID0,%MID1,XGSAVATR,%S,Y
  1. N XGGR0 ;graphics attribute off
  1. S XGSAVATR=XGCURATR ;save current attr
  1. W $$CHG^XGSA("G0") S XGGR0=XGCURATR ;store attributes w/out graphics
  1. W $$CHG^XGSA("G1") ;now turn on gr attr and leave it on
  1. S %MIDDLE=R-L-1
  1. S %MID0=IOVL_$J("",%MIDDLE)_$S($D(XGFLAG("TOO WIDE")):" ",1:IOVL)
  1. S %MID1=XGCURATR_$TR($J("",%MIDDLE)," ",XGGR0)_$S($D(XGFLAG("TOO WIDE")):XGGR0,1:XGCURATR)
  1. S L2=L+1,R2=R+1
  1. ;if window for LISTBUTTON gadget, don't draw top of frame
  1. I $L($G(XGW)),$L($G(XGG)),$G(^TMP("XGW",$J,XGW,"G",XGG,"TYPE"))="LISTBUTTON",$G(XGMENU)="" D
  1. . S $E(XGSCRN(T,0),L2,R2)=%MID0,%S=%MID0,$E(XGSCRN(T,1),L2,R2)=%MID1
  1. E D ;draw the top of the box
  1. . S %S=IOTLC_$TR($J("",%MIDDLE)," ",IOHL)_$S($D(XGFLAG("TOO WIDE")):IOHL,1:IOTRC)
  1. . S $E(XGSCRN(T,0),L2,R2)=%S
  1. . S $E(XGSCRN(T,1),L2,R2)=$TR($J("",(R-L+1))," ",XGCURATR)
  1. W $$IOXY^XGS(T,L)_%S
  1. F Y=T+1:1:$S($D(XGFLAG("TOO LONG")):B,1:B-1) D
  1. . S $E(XGSCRN(Y,0),L2,R2)=%MID0
  1. . S $E(XGSCRN(Y,1),L2,R2)=%MID1
  1. . W $$IOXY^XGS(Y,L)_%MID0
  1. S %S=$S($D(XGFLAG("TOO LONG")):%MID0,1:IOBLC_$TR($J("",%MIDDLE)," ",IOHL)_$S($D(XGFLAG("TOO WIDE")):IOHL,1:IOBRC))
  1. S $E(XGSCRN(B,0),L2,R2)=%S
  1. S $E(XGSCRN(B,1),L2,R2)=$S($D(XGFLAG("TOO LONG")):%MID1,1:$TR($J("",(R-L+1))," ",XGCURATR))
  1. W $$IOXY^XGS(B,L)_%S
  1. W $$SET^XGSA(XGSAVATR)
  1. K XGFLAG("TOO LONG"),XGFLAG("TOO WIDE")
  1. S $Y=B,$X=R
  1. Q
  1. ;
  1. ;
  1. RESTORE(S) ;restore portion of screen
  1. ;if S="XGSCRN" then simply refresh the entire screen
  1. N %,X,Y,%ROW,L2,R2 ;L2 left position in $E R2 right position in $E
  1. N T,L,B,R
  1. N %RCOUNT,%CP,%S,A ;row counter,char pos,string,attr
  1. N XGSAVATR,XGWIDTH
  1. S T=$P(@S@("COORDS"),U,1),L2=$P(@S@("COORDS"),U,2)
  1. S B=$P(@S@("COORDS"),U,3),R2=$P(@S@("COORDS"),U,4)
  1. S %RCOUNT=0,XGSAVATR=XGCURATR
  1. S XGWIDTH=R2-L2+1
  1. F %ROW=T:1:B D
  1. . S Y=$S($D(T):(T+%RCOUNT),1:%ROW)
  1. . S XGFLAG("UPDATE")=$S(S="XGSCRN":1,1:0)
  1. . ;check to see if a line from window needs to be placed on screen
  1. . ; and if S="XGSCRN" then don't bother checking, refresh screen anyway
  1. . I S'="XGSCRN" F X=0,1 I $E(XGSCRN(Y,X),L2,R2)'=$E(@S@(Y,X),L2,R2) S XGFLAG("UPDATE")=1 Q
  1. . D:XGFLAG("UPDATE") ;if what's on screen is different from window
  1. . . I $E(@S@(Y,1),L2,R2)=$TR($J("",XGWIDTH)," ",XGCURATR)&('$D(XGWSTAMP)) S %S=$E(@S@(Y,0),L2,R2)
  1. . . E S %S="",%=L2,A=XGCURATR D
  1. . . . F %CP=L2:1:R2 D:$E(@S@(Y,1),%CP)'=A
  1. . . . . S A=$E(@S@(Y,1),%CP),%S=%S_$E(@S@(Y,0),%,%CP-1)_$$SET^XGSA(A),%=%CP
  1. . . . S %S=%S_$E(@S@(Y,0),%,%CP)
  1. . . S X=$S($D(L):L,1:L2-1)
  1. . . W $$IOXY^XGS(Y,X)_%S
  1. . . ;-------------------- put data, attributes and window stamps back
  1. . . I S'="XGSCRN" F %=0,1 S $E(XGSCRN(Y,%),L2,R2)=$E(@S@(Y,%),L2,R2)
  1. . S %RCOUNT=%RCOUNT+1
  1. W $$SET^XGSA(XGSAVATR) ;reset screen & XGCURATR to original
  1. K XGFLAG("UPDATE")
  1. ;S $Y=B,$X=R
  1. Q
  1. ;
  1. ;
  1. SAVE(T,L,B,R,S) ;save portion of screen
  1. N %,Y
  1. K @S ;clean out the root
  1. D ADJUST(T,L,B,R,S) ;adjust and save the coordinates
  1. S B=$P(@S@("COORDS"),U,3),R=$P(@S@("COORDS"),U,4) ;get new adj coords
  1. F Y=T:1:B F %=0,1 S @S@(Y,%)=XGSCRN(Y,%)
  1. Q
  1. ;
  1. ;
  1. ADJUST(T,L,B,R,S) ;adjust the coordinates of screen region and if S
  1. ;is passed, save the coordinates of a window into COORDS node
  1. ;NOTE: T,L,B,R may be passed by reference
  1. S:B'<IOSL B=IOSL-1 ;adjust if longer than screen
  1. S:R'<IOM R=IOM-1 ;adjust if wider than screen
  1. S L=L+1 ;adjust for $E to work correctly
  1. S R=R+1 ;adjust for $E to work correctly
  1. S:$L($G(S)) @S@("COORDS")=T_U_L_U_B_U_R ;save
  1. Q