source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XGSW.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

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