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/XGF.m@ 1073

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1XGF ;SFISC/VYD - Graphics Functions ;11/06/2002 11:10
2 ;;8.0;KERNEL;**269**;Jul 10, 1995
3PREP ;prepair graphics environment
4 D PREP^XGSETUP Q
5 ;
6 ;
7IOXY(R,C) ;cursor positioning R:row, C:col
8 D ADJRC
9 W $$IOXY^XGS(R,C)
10 S $Y=R,$X=C
11 Q
12 ;
13 ;
14SAY(R,C,S,A) ;coordinate output instead of WRITE
15 D ADJRC
16 S:C+$L(S)>IOM S=$E(S,1,IOM-C) ;truncate if longer than screen
17 I $L($G(A)) S A=$$UP^XLFSTR(A) D SAY^XGS(R,C,S,$S($$ATRSYNTX(A):A,1:"")) I 1
18 E D SAY^XGS(R,C,S)
19 Q
20 ;
21 ;
22SAYU(R,C,S,A) ;coordinate output w/ underline instead of WRITE
23 D ADJRC
24 I $L($G(A)) S A=$$UP^XLFSTR(A) D SAYU^XGS(R,C,S,$S($$ATRSYNTX(A):A,1:"")) I 1
25 E D SAYU^XGS(R,C,S)
26 Q
27 ;
28 ;
29ADJRC ;adjust row and column R and C are assumed to exist
30 S R=$S($G(R)="":$Y,1:R),C=$S($G(C)="":$X,1:C) ;use current coords if none are passed
31 S:"+-"[$E(R) R=$Y+$S(R="+":1,R="-":-1,1:R) ;increment/decrement
32 S:"+-"[$E(C) C=$X+$S(C="+":1,C="-":-1,1:C)
33 S R=$S(R<0:0,1:R\1),C=$S(C<0:0,1:C\1) ;make sure only pos int
34 Q
35 ;
36 ;
37SETA(XGATR) ;set screen attribute(s) regardless of previous state
38 ;XGATR=1 char when converted to binary represents all new attr
39 N XGOLDX,XGOLDY
40 S XGOLDX=$X,XGOLDY=$Y ;save $X $Y
41 W $$SET^XGSA(XGATR)
42 S $X=XGOLDX,$Y=XGOLDY ;restore $X $Y
43 Q
44 ;
45 ;
46CHGA(XGATR) ;change screen attribute(s) w/ respect to previous state
47 ;XGNEWATR=string of attr to change eg. "B0U1" or "E1"
48 N XGOLDX,XGOLDY,XGSYNTX,XGACODE,%
49 S XGATR=$$UP^XLFSTR(XGATR) ;make sure all attr codes are in upper case
50 D:$$ATRSYNTX(XGATR)
51 . S XGOLDX=$X,XGOLDY=$Y ;save $X $Y
52 . W $$CHG^XGSA(XGATR)
53 . S $X=XGOLDX,$Y=XGOLDY ;restore $X $Y
54 Q
55 ;
56 ;
57ATRSYNTX(XGATR) ;check attribute code syntax
58 ;proper attr is 1 or more (char from {BIRGUE} concat w/ 1 or 0)
59 N XGSYNTX,%
60 S XGSYNTX=$S($L(XGATR)&($L(XGATR)#2=0):1,1:0) ;even # of chars
61 F %=1:2:$L(XGATR) S:"B1B0I1I0R1R0G1G0U1U0E1"'[$E(XGATR,%,%+1) XGSYNTX=0
62 Q XGSYNTX
63 ;
64 ;
65RESTORE(S) ;restore screen region TOP,LEFT,BOTTOM,RIGHT,SAVE ROOT
66 D RESTORE^XGSW(S) Q
67 K @S
68 ;
69 ;
70SAVE(T,L,B,R,S) ;save screen region TOP,LEFT,BOTTOM,RIGHT,SAVE ROOT
71 D SAVE^XGSW(T,L,B,R,S) Q
72 ;
73 ;
74WIN(T,L,B,R,S) ;put up a window TOP,LEFT,BOTTOM,RIGHT[,SAVE ROOT]
75 ;window style is not yet implemented
76 I $L($G(S)) D WIN^XGSW(T,L,B,R,S) I 1
77 E D WIN^XGSW(T,L,B,R)
78 Q
79 ;
80 ;
81FRAME(T,L,B,R) ;put a frame without clearing the inside TOP,LEFT,BOTTOM,RIGHT
82 D FRAME^XGSBOX(T,L,B,R) Q
83 ;
84 ;
85CLEAR(T,L,B,R) ;clear screen portion TOP,LEFT,BOTTOM,RIGHT
86 D CLEAR^XGSBOX(T,L,B,R) Q
87 ;
88 ;
89CLEAN ;clean up and destroy graphics environment
90 D CLEAN^XGSETUP Q
91 ;
92 ;
93INITKB(XGTRM) ;initialize keyboard
94 ;turn escape processing on, turn on passed terminators (if any)
95 D INIT^XGKB($G(XGTRM)) Q
96 ;
97 ;
98READ(XGCHARS,XGTO) ;read the keyboard
99 ;XGCHARS:number of chars to read, XGTO:timeout
100 Q $$READ^XGKB($G(XGCHARS),$G(XGTO))
101 ;
102 ;
103RESETKB ;reset keyboard(escape processing off, terminators off)
104 D EXIT^XGKB Q
Note: See TracBrowser for help on using the repository browser.