- 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 Jan 18, 2025@03:03:38 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