| 1 | XGF ;SFISC/VYD - Graphics Functions ;11/06/2002 11:10
|
|---|
| 2 | ;;8.0;KERNEL;**269**;Jul 10, 1995
|
|---|
| 3 | PREP ;prepair graphics environment
|
|---|
| 4 | D PREP^XGSETUP Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | IOXY(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 | ;
|
|---|
| 14 | SAY(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 | ;
|
|---|
| 22 | SAYU(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 | ;
|
|---|
| 29 | ADJRC ;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 | ;
|
|---|
| 37 | SETA(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 | ;
|
|---|
| 46 | CHGA(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 | ;
|
|---|
| 57 | ATRSYNTX(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 | ;
|
|---|
| 65 | RESTORE(S) ;restore screen region TOP,LEFT,BOTTOM,RIGHT,SAVE ROOT
|
|---|
| 66 | D RESTORE^XGSW(S) Q
|
|---|
| 67 | K @S
|
|---|
| 68 | ;
|
|---|
| 69 | ;
|
|---|
| 70 | SAVE(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 | ;
|
|---|
| 74 | WIN(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 | ;
|
|---|
| 81 | FRAME(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 | ;
|
|---|
| 85 | CLEAR(T,L,B,R) ;clear screen portion TOP,LEFT,BOTTOM,RIGHT
|
|---|
| 86 | D CLEAR^XGSBOX(T,L,B,R) Q
|
|---|
| 87 | ;
|
|---|
| 88 | ;
|
|---|
| 89 | CLEAN ;clean up and destroy graphics environment
|
|---|
| 90 | D CLEAN^XGSETUP Q
|
|---|
| 91 | ;
|
|---|
| 92 | ;
|
|---|
| 93 | INITKB(XGTRM) ;initialize keyboard
|
|---|
| 94 | ;turn escape processing on, turn on passed terminators (if any)
|
|---|
| 95 | D INIT^XGKB($G(XGTRM)) Q
|
|---|
| 96 | ;
|
|---|
| 97 | ;
|
|---|
| 98 | READ(XGCHARS,XGTO) ;read the keyboard
|
|---|
| 99 | ;XGCHARS:number of chars to read, XGTO:timeout
|
|---|
| 100 | Q $$READ^XGKB($G(XGCHARS),$G(XGTO))
|
|---|
| 101 | ;
|
|---|
| 102 | ;
|
|---|
| 103 | RESETKB ;reset keyboard(escape processing off, terminators off)
|
|---|
| 104 | D EXIT^XGKB Q
|
|---|
