source: cprs/branches/tmg-cprs/m_files/TMGXGSW.m@ 840

Last change on this file since 840 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 4.7 KB
Line 
1TMGXGSW ;SFISC/VYD - screen window primitives ;01/11/95 15:58
2 ;;8.0;KERNEL;;5/7/07 by //kt
3 ;
4WIN(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 ;
44RESTORE(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 ;
78SAVE(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 ;
87ADJUST(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
Note: See TracBrowser for help on using the repository browser.