XGSW ;SFISC/VYD - screen window primitives ;01/11/95 15:58
;;8.0;KERNEL;;Jul 10, 1995
;
WIN(T,L,B,R,S) ;draw a bordered window
;top,left,bottom,right,screen root
S:B'<IOSL B=IOSL-1,XGFLAG("TOO LONG")=1 ;adjust if longer than screen
S:R'<IOM R=IOM-1,XGFLAG("TOO WIDE")=1 ;adjust if wider than screen
D:$D(S) SAVE(T,L,B,R,S)
N L2,R2,%MIDDLE,%MID0,%MID1,XGSAVATR,%S,Y
N XGGR0 ;graphics attribute off
S XGSAVATR=XGCURATR ;save current attr
W $$CHG^XGSA("G0") S XGGR0=XGCURATR ;store attributes w/out graphics
W $$CHG^XGSA("G1") ;now turn on gr attr and leave it on
S %MIDDLE=R-L-1
S %MID0=IOVL_$J("",%MIDDLE)_$S($D(XGFLAG("TOO WIDE")):" ",1:IOVL)
S %MID1=XGCURATR_$TR($J("",%MIDDLE)," ",XGGR0)_$S($D(XGFLAG("TOO WIDE")):XGGR0,1:XGCURATR)
S L2=L+1,R2=R+1
;if window for LISTBUTTON gadget, don't draw top of frame
I $L($G(XGW)),$L($G(XGG)),$G(^TMP("XGW",$J,XGW,"G",XGG,"TYPE"))="LISTBUTTON",$G(XGMENU)="" D
. S $E(XGSCRN(T,0),L2,R2)=%MID0,%S=%MID0,$E(XGSCRN(T,1),L2,R2)=%MID1
E D ;draw the top of the box
. S %S=IOTLC_$TR($J("",%MIDDLE)," ",IOHL)_$S($D(XGFLAG("TOO WIDE")):IOHL,1:IOTRC)
. S $E(XGSCRN(T,0),L2,R2)=%S
. S $E(XGSCRN(T,1),L2,R2)=$TR($J("",(R-L+1))," ",XGCURATR)
W $$IOXY^XGS(T,L)_%S
F Y=T+1:1:$S($D(XGFLAG("TOO LONG")):B,1:B-1) D
. S $E(XGSCRN(Y,0),L2,R2)=%MID0
. S $E(XGSCRN(Y,1),L2,R2)=%MID1
. W $$IOXY^XGS(Y,L)_%MID0
S %S=$S($D(XGFLAG("TOO LONG")):%MID0,1:IOBLC_$TR($J("",%MIDDLE)," ",IOHL)_$S($D(XGFLAG("TOO WIDE")):IOHL,1:IOBRC))
S $E(XGSCRN(B,0),L2,R2)=%S
S $E(XGSCRN(B,1),L2,R2)=$S($D(XGFLAG("TOO LONG")):%MID1,1:$TR($J("",(R-L+1))," ",XGCURATR))
W $$IOXY^XGS(B,L)_%S
W $$SET^XGSA(XGSAVATR)
K XGFLAG("TOO LONG"),XGFLAG("TOO WIDE")
S $Y=B,$X=R
Q
;
;
RESTORE(S) ;restore portion of screen
;if S="XGSCRN" then simply refresh the entire screen
N %,X,Y,%ROW,L2,R2 ;L2 left position in $E R2 right position in $E
N T,L,B,R
N %RCOUNT,%CP,%S,A ;row counter,char pos,string,attr
N XGSAVATR,XGWIDTH
S T=$P(@S@("COORDS"),U,1),L2=$P(@S@("COORDS"),U,2)
S B=$P(@S@("COORDS"),U,3),R2=$P(@S@("COORDS"),U,4)
S %RCOUNT=0,XGSAVATR=XGCURATR
S XGWIDTH=R2-L2+1
F %ROW=T:1:B D
. S Y=$S($D(T):(T+%RCOUNT),1:%ROW)
. S XGFLAG("UPDATE")=$S(S="XGSCRN":1,1:0)
. ;check to see if a line from window needs to be placed on screen
. ; and if S="XGSCRN" then don't bother checking, refresh screen anyway
. 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
. D:XGFLAG("UPDATE") ;if what's on screen is different from window
. . I $E(@S@(Y,1),L2,R2)=$TR($J("",XGWIDTH)," ",XGCURATR)&('$D(XGWSTAMP)) S %S=$E(@S@(Y,0),L2,R2)
. . E S %S="",%=L2,A=XGCURATR D
. . . F %CP=L2:1:R2 D:$E(@S@(Y,1),%CP)'=A
. . . . S A=$E(@S@(Y,1),%CP),%S=%S_$E(@S@(Y,0),%,%CP-1)_$$SET^XGSA(A),%=%CP
. . . S %S=%S_$E(@S@(Y,0),%,%CP)
. . S X=$S($D(L):L,1:L2-1)
. . W $$IOXY^XGS(Y,X)_%S
. . ;-------------------- put data, attributes and window stamps back
. . I S'="XGSCRN" F %=0,1 S $E(XGSCRN(Y,%),L2,R2)=$E(@S@(Y,%),L2,R2)
. S %RCOUNT=%RCOUNT+1
W $$SET^XGSA(XGSAVATR) ;reset screen & XGCURATR to original
K XGFLAG("UPDATE")
;S $Y=B,$X=R
Q
;
;
SAVE(T,L,B,R,S) ;save portion of screen
N %,Y
K @S ;clean out the root
D ADJUST(T,L,B,R,S) ;adjust and save the coordinates
S B=$P(@S@("COORDS"),U,3),R=$P(@S@("COORDS"),U,4) ;get new adj coords
F Y=T:1:B F %=0,1 S @S@(Y,%)=XGSCRN(Y,%)
Q
;
;
ADJUST(T,L,B,R,S) ;adjust the coordinates of screen region and if S
;is passed, save the coordinates of a window into COORDS node
;NOTE: T,L,B,R may be passed by reference
S:B'<IOSL B=IOSL-1 ;adjust if longer than screen
S:R'<IOM R=IOM-1 ;adjust if wider than screen
S L=L+1 ;adjust for $E to work correctly
S R=R+1 ;adjust for $E to work correctly
S:$L($G(S)) @S@("COORDS")=T_U_L_U_B_U_R ;save
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXGSW 3936 printed Apr 09, 2024@21:08:09 Page 2
XGSW ;SFISC/VYD - screen window primitives ;01/11/95 15:58
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 ;
WIN(T,L,B,R,S) ;draw a bordered window
+1 ;top,left,bottom,right,screen root
+2 ;adjust if longer than screen
if B'<IOSL
SET B=IOSL-1
SET XGFLAG("TOO LONG")=1
+3 ;adjust if wider than screen
if R'<IOM
SET R=IOM-1
SET XGFLAG("TOO WIDE")=1
+4 if $DATA(S)
DO SAVE(T,L,B,R,S)
+5 NEW L2,R2,%MIDDLE,%MID0,%MID1,XGSAVATR,%S,Y
+6 ;graphics attribute off
NEW XGGR0
+7 ;save current attr
SET XGSAVATR=XGCURATR
+8 ;store attributes w/out graphics
WRITE $$CHG^XGSA("G0")
SET XGGR0=XGCURATR
+9 ;now turn on gr attr and leave it on
WRITE $$CHG^XGSA("G1")
+10 SET %MIDDLE=R-L-1
+11 SET %MID0=IOVL_$JUSTIFY("",%MIDDLE)_$SELECT($DATA(XGFLAG("TOO WIDE")):" ",1:IOVL)
+12 SET %MID1=XGCURATR_$TRANSLATE($JUSTIFY("",%MIDDLE)," ",XGGR0)_$SELECT($DATA(XGFLAG("TOO WIDE")):XGGR0,1:XGCURATR)
+13 SET L2=L+1
SET R2=R+1
+14 ;if window for LISTBUTTON gadget, don't draw top of frame
+15 IF $LENGTH($GET(XGW))
IF $LENGTH($GET(XGG))
IF $GET(^TMP("XGW",$JOB,XGW,"G",XGG,"TYPE"))="LISTBUTTON"
IF $GET(XGMENU)=""
Begin DoDot:1
+16 SET $EXTRACT(XGSCRN(T,0),L2,R2)=%MID0
SET %S=%MID0
SET $EXTRACT(XGSCRN(T,1),L2,R2)=%MID1
End DoDot:1
+17 ;draw the top of the box
IF '$TEST
Begin DoDot:1
+18 SET %S=IOTLC_$TRANSLATE($JUSTIFY("",%MIDDLE)," ",IOHL)_$SELECT($DATA(XGFLAG("TOO WIDE")):IOHL,1:IOTRC)
+19 SET $EXTRACT(XGSCRN(T,0),L2,R2)=%S
+20 SET $EXTRACT(XGSCRN(T,1),L2,R2)=$TRANSLATE($JUSTIFY("",(R-L+1))," ",XGCURATR)
End DoDot:1
+21 WRITE $$IOXY^XGS(T,L)_%S
+22 FOR Y=T+1:1:$SELECT($DATA(XGFLAG("TOO LONG")):B,1:B-1)
Begin DoDot:1
+23 SET $EXTRACT(XGSCRN(Y,0),L2,R2)=%MID0
+24 SET $EXTRACT(XGSCRN(Y,1),L2,R2)=%MID1
+25 WRITE $$IOXY^XGS(Y,L)_%MID0
End DoDot:1
+26 SET %S=$SELECT($DATA(XGFLAG("TOO LONG")):%MID0,1:IOBLC_$TRANSLATE($JUSTIFY("",%MIDDLE)," ",IOHL)_$SELECT($DATA(XGFLAG("TOO WIDE")):IOHL,1:IOBRC))
+27 SET $EXTRACT(XGSCRN(B,0),L2,R2)=%S
+28 SET $EXTRACT(XGSCRN(B,1),L2,R2)=$SELECT($DATA(XGFLAG("TOO LONG")):%MID1,1:$TRANSLATE($JUSTIFY("",(R-L+1))," ",XGCURATR))
+29 WRITE $$IOXY^XGS(B,L)_%S
+30 WRITE $$SET^XGSA(XGSAVATR)
+31 KILL XGFLAG("TOO LONG"),XGFLAG("TOO WIDE")
+32 SET $Y=B
SET $X=R
+33 QUIT
+34 ;
+35 ;
RESTORE(S) ;restore portion of screen
+1 ;if S="XGSCRN" then simply refresh the entire screen
+2 ;L2 left position in $E R2 right position in $E
NEW %,X,Y,%ROW,L2,R2
+3 NEW T,L,B,R
+4 ;row counter,char pos,string,attr
NEW %RCOUNT,%CP,%S,A
+5 NEW XGSAVATR,XGWIDTH
+6 SET T=$PIECE(@S@("COORDS"),U,1)
SET L2=$PIECE(@S@("COORDS"),U,2)
+7 SET B=$PIECE(@S@("COORDS"),U,3)
SET R2=$PIECE(@S@("COORDS"),U,4)
+8 SET %RCOUNT=0
SET XGSAVATR=XGCURATR
+9 SET XGWIDTH=R2-L2+1
+10 FOR %ROW=T:1:B
Begin DoDot:1
+11 SET Y=$SELECT($DATA(T):(T+%RCOUNT),1:%ROW)
+12 SET XGFLAG("UPDATE")=$SELECT(S="XGSCRN":1,1:0)
+13 ;check to see if a line from window needs to be placed on screen
+14 ; and if S="XGSCRN" then don't bother checking, refresh screen anyway
+15 IF S'="XGSCRN"
FOR X=0,1
IF $EXTRACT(XGSCRN(Y,X),L2,R2)'=$EXTRACT(@S@(Y,X),L2,R2)
SET XGFLAG("UPDATE")=1
QUIT
+16 ;if what's on screen is different from window
if XGFLAG("UPDATE")
Begin DoDot:2
+17 IF $EXTRACT(@S@(Y,1),L2,R2)=$TRANSLATE($JUSTIFY("",XGWIDTH)," ",XGCURATR)&('$DATA(XGWSTAMP))
SET %S=$EXTRACT(@S@(Y,0),L2,R2)
+18 IF '$TEST
SET %S=""
SET %=L2
SET A=XGCURATR
Begin DoDot:3
+19 FOR %CP=L2:1:R2
if $EXTRACT(@S@(Y,1),%CP)'=A
Begin DoDot:4
+20 SET A=$EXTRACT(@S@(Y,1),%CP)
SET %S=%S_$EXTRACT(@S@(Y,0),%,%CP-1)_$$SET^XGSA(A)
SET %=%CP
End DoDot:4
+21 SET %S=%S_$EXTRACT(@S@(Y,0),%,%CP)
End DoDot:3
+22 SET X=$SELECT($DATA(L):L,1:L2-1)
+23 WRITE $$IOXY^XGS(Y,X)_%S
+24 ;-------------------- put data, attributes and window stamps back
+25 IF S'="XGSCRN"
FOR %=0,1
SET $EXTRACT(XGSCRN(Y,%),L2,R2)=$EXTRACT(@S@(Y,%),L2,R2)
End DoDot:2
+26 SET %RCOUNT=%RCOUNT+1
End DoDot:1
+27 ;reset screen & XGCURATR to original
WRITE $$SET^XGSA(XGSAVATR)
+28 KILL XGFLAG("UPDATE")
+29 ;S $Y=B,$X=R
+30 QUIT
+31 ;
+32 ;
SAVE(T,L,B,R,S) ;save portion of screen
+1 NEW %,Y
+2 ;clean out the root
KILL @S
+3 ;adjust and save the coordinates
DO ADJUST(T,L,B,R,S)
+4 ;get new adj coords
SET B=$PIECE(@S@("COORDS"),U,3)
SET R=$PIECE(@S@("COORDS"),U,4)
+5 FOR Y=T:1:B
FOR %=0,1
SET @S@(Y,%)=XGSCRN(Y,%)
+6 QUIT
+7 ;
+8 ;
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
+2 ;NOTE: T,L,B,R may be passed by reference
+3 ;adjust if longer than screen
if B'<IOSL
SET B=IOSL-1
+4 ;adjust if wider than screen
if R'<IOM
SET R=IOM-1
+5 ;adjust for $E to work correctly
SET L=L+1
+6 ;adjust for $E to work correctly
SET R=R+1
+7 ;save
if $LENGTH($GET(S))
SET @S@("COORDS")=T_U_L_U_B_U_R
+8 QUIT
