[796] | 1 | TMGXGSW ;SFISC/VYD - screen window primitives ;01/11/95 15:58
|
---|
| 2 | ;;8.0;KERNEL;;5/7/07 by //kt
|
---|
| 3 | ;
|
---|
| 4 | WIN(T,L,B,R,S) ;draw a bordered window
|
---|
| 5 | ;top,left,bottom,right,screen root
|
---|
| 6 | ;"//kt 5/5/07 removed next two lines. CLIOXY will do clipping.
|
---|
| 7 | ;"S:B'<IOSL B=IOSL-1,XGFLAG("TOO LONG")=1 ;adjust if longer than screen
|
---|
| 8 | ;"S:R'<IOM R=IOM-1,XGFLAG("TOO WIDE")=1 ;adjust if wider than screen
|
---|
| 9 | D:$D(S) SAVE(T,L,B,R,S)
|
---|
| 10 | N L2,R2,%MIDDLE,%MID0,%MID1,XGSAVATR,%S,Y
|
---|
| 11 | N XGGR0 ;graphics attribute off
|
---|
| 12 | S XGSAVATR=XGCURATR ;save current attr
|
---|
| 13 | W $$CHG^XGSA("G0") S XGGR0=XGCURATR ;store attributes w/out graphics
|
---|
| 14 | W $$CHG^XGSA("G1") ;now turn on gr attr and leave it on
|
---|
| 15 | S %MIDDLE=R-L-1
|
---|
| 16 | S %MID0=IOVL_$J("",%MIDDLE)_$S($D(XGFLAG("TOO WIDE")):" ",1:IOVL)
|
---|
| 17 | S %MID1=XGCURATR_$TR($J("",%MIDDLE)," ",XGGR0)_$S($D(XGFLAG("TOO WIDE")):XGGR0,1:XGCURATR)
|
---|
| 18 | S L2=L+1,R2=R+1
|
---|
| 19 | ;if window for LISTBUTTON gadget, don't draw top of frame
|
---|
| 20 | I $L($G(XGW)),$L($G(XGG)),$G(^TMP("XGW",$J,XGW,"G",XGG,"TYPE"))="LISTBUTTON",$G(XGMENU)="" D
|
---|
| 21 | . S $E(XGSCRN(T,0),L2,R2)=%MID0,%S=%MID0,$E(XGSCRN(T,1),L2,R2)=%MID1
|
---|
| 22 | E D ;draw the top of the box
|
---|
| 23 | . S %S=IOTLC_$TR($J("",%MIDDLE)," ",IOHL)_$S($D(XGFLAG("TOO WIDE")):IOHL,1:IOTRC)
|
---|
| 24 | . S $E(XGSCRN(T,0),L2,R2)=%S
|
---|
| 25 | . S $E(XGSCRN(T,1),L2,R2)=$TR($J("",(R-L+1))," ",XGCURATR)
|
---|
| 26 | ;W $$IOXY^TMGXGS(T,L)_%S
|
---|
| 27 | do CLIOXY^TMGXGS(T,L,%S)
|
---|
| 28 | F Y=T+1:1:$S($D(XGFLAG("TOO LONG")):B,1:B-1) D
|
---|
| 29 | . S $E(XGSCRN(Y,0),L2,R2)=%MID0
|
---|
| 30 | . S $E(XGSCRN(Y,1),L2,R2)=%MID1
|
---|
| 31 | . ;W $$IOXY^TMGXGS(Y,L)_%MID0
|
---|
| 32 | . DO CLIOXY^TMGXGS(Y,L,%MID0)
|
---|
| 33 | S %S=$S($D(XGFLAG("TOO LONG")):%MID0,1:IOBLC_$TR($J("",%MIDDLE)," ",IOHL)_$S($D(XGFLAG("TOO WIDE")):IOHL,1:IOBRC))
|
---|
| 34 | S $E(XGSCRN(B,0),L2,R2)=%S
|
---|
| 35 | S $E(XGSCRN(B,1),L2,R2)=$S($D(XGFLAG("TOO LONG")):%MID1,1:$TR($J("",(R-L+1))," ",XGCURATR))
|
---|
| 36 | ;W $$IOXY^TMGXGS(B,L)_%S
|
---|
| 37 | DO CLIOXY^TMGXGS(B,L,%S)
|
---|
| 38 | W $$SET^XGSA(XGSAVATR)
|
---|
| 39 | K XGFLAG("TOO LONG"),XGFLAG("TOO WIDE")
|
---|
| 40 | S $Y=B,$X=R
|
---|
| 41 | Q
|
---|
| 42 | ;
|
---|
| 43 | ;
|
---|
| 44 | RESTORE(S) ;restore portion of screen
|
---|
| 45 | ;if S="XGSCRN" then simply refresh the entire screen
|
---|
| 46 | N %,X,Y,%ROW,L2,R2 ;L2 left position in $E R2 right position in $E
|
---|
| 47 | N T,L,B,R
|
---|
| 48 | N %RCOUNT,%CP,%S,A ;row counter,char pos,string,attr
|
---|
| 49 | N XGSAVATR,XGWIDTH
|
---|
| 50 | S T=$P(@S@("COORDS"),U,1),L2=$P(@S@("COORDS"),U,2)
|
---|
| 51 | S B=$P(@S@("COORDS"),U,3),R2=$P(@S@("COORDS"),U,4)
|
---|
| 52 | S %RCOUNT=0,XGSAVATR=XGCURATR
|
---|
| 53 | S XGWIDTH=R2-L2+1
|
---|
| 54 | F %ROW=T:1:B D
|
---|
| 55 | . S Y=$S($D(T):(T+%RCOUNT),1:%ROW)
|
---|
| 56 | . S XGFLAG("UPDATE")=$S(S="XGSCRN":1,1:0)
|
---|
| 57 | . ;check to see if a line from window needs to be placed on screen
|
---|
| 58 | . ; and if S="XGSCRN" then don't bother checking, refresh screen anyway
|
---|
| 59 | . 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
|
---|
| 60 | . D:XGFLAG("UPDATE") ;if what's on screen is different from window
|
---|
| 61 | . . I $E(@S@(Y,1),L2,R2)=$TR($J("",XGWIDTH)," ",XGCURATR)&('$D(XGWSTAMP)) S %S=$E(@S@(Y,0),L2,R2)
|
---|
| 62 | . . E S %S="",%=L2,A=XGCURATR D
|
---|
| 63 | . . . F %CP=L2:1:R2 D:$E(@S@(Y,1),%CP)'=A
|
---|
| 64 | . . . . S A=$E(@S@(Y,1),%CP),%S=%S_$E(@S@(Y,0),%,%CP-1)_$$SET^XGSA(A),%=%CP
|
---|
| 65 | . . . S %S=%S_$E(@S@(Y,0),%,%CP)
|
---|
| 66 | . . S X=$S($D(L):L,1:L2-1)
|
---|
| 67 | . . ;W $$IOXY^TMGXGS(Y,X)_%S
|
---|
| 68 | . . DO CLIOXY^TMGXGS(Y,X,%S)
|
---|
| 69 | . . ;-------------------- put data, attributes and window stamps back
|
---|
| 70 | . . I S'="XGSCRN" F %=0,1 S $E(XGSCRN(Y,%),L2,R2)=$E(@S@(Y,%),L2,R2)
|
---|
| 71 | . S %RCOUNT=%RCOUNT+1
|
---|
| 72 | W $$SET^XGSA(XGSAVATR) ;reset screen & XGCURATR to original
|
---|
| 73 | K XGFLAG("UPDATE")
|
---|
| 74 | ;S $Y=B,$X=R
|
---|
| 75 | Q
|
---|
| 76 | ;
|
---|
| 77 | ;
|
---|
| 78 | SAVE(T,L,B,R,S) ;save portion of screen
|
---|
| 79 | N %,Y
|
---|
| 80 | K @S ;clean out the root
|
---|
| 81 | D ADJUST(T,L,B,R,S) ;adjust and save the coordinates
|
---|
| 82 | S B=$P(@S@("COORDS"),U,3),R=$P(@S@("COORDS"),U,4) ;get new adj coords
|
---|
| 83 | F Y=T:1:B F %=0,1 S @S@(Y,%)=XGSCRN(Y,%)
|
---|
| 84 | Q
|
---|
| 85 | ;
|
---|
| 86 | ;
|
---|
| 87 | ADJUST(T,L,B,R,S) ;adjust the coordinates of screen region and if S
|
---|
| 88 | ;is passed, save the coordinates of a window into COORDS node
|
---|
| 89 | ;NOTE: T,L,B,R may be passed by reference
|
---|
| 90 | S:B'<IOSL B=IOSL-1 ;adjust if longer than screen
|
---|
| 91 | S:R'<IOM R=IOM-1 ;adjust if wider than screen
|
---|
| 92 | ;"//kt added 5/6/07 -- next line only
|
---|
| 93 | S:T<0 T=0 S:L<0 L=0
|
---|
| 94 | S L=L+1 ;adjust for $E to work correctly
|
---|
| 95 | S R=R+1 ;adjust for $E to work correctly
|
---|
| 96 | S:$L($G(S)) @S@("COORDS")=T_U_L_U_B_U_R ;save
|
---|
| 97 | Q
|
---|