Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XGSA

XGSA.m

Go to the documentation of this file. 
  1. XGSA ;SFISC/VYD - screen attribute primitives ;03/15/95  13:50 [ 04/02/2003   8:29 AM ]
  1.  ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
  1.  ;;8.0;KERNEL;;Jul 10, 1995
  1. SET(XGNEWATR) ;set screen attributes return only the ESC codes
  1.  ;ABSOLUTE setting of screen attributes to new attributes regadless
  1.  ;of prev state.  For relative change use CHG
  1.  ;XGNEWATR=char represents what all attributes should become ex: R1B0
  1.  ;XGCURATR=state of all current attributes in form of a char
  1.  S XGCURATR=XGNEWATR ;set curr attr var
  1.  Q ^XUTL("XGATR",XGNEWATR)
  1.  ;
  1. CHG99(XGATR) ;XGATR=passed attribute string ie: R1B0G1
  1.  ;RELATIVE change of screen attributes to the new ones.  Only changes attributes that were passed, retains others.  For ABSOLUTE set use SET
  1.  N X,%,XGATRLTR,XGATRNO,XGCURBIN,XGESC,XGONOFF
  1.  ;S XGCURBIN=$$CNV(XGCURATR)
  1.  S XGCURBIN=^XUTL("XGATR1",XGCURATR)
  1.  ;parse passed string, generate ESC codes
  1.  F %=1:2:$L(XGATR) S XGATRLTR=$E(XGATR,%),XGONOFF=$E(XGATR,%+1) D
  1.  . I XGATRLTR'="E" D  ;continue if not EMPTY
  1.  . . S XGATRNO=$F("BIRDGU",XGATRLTR) ;get attr # to match in XGATRSET
  1.  . . S $E(XGCURBIN,XGATRNO)=XGONOFF ;chg bin str
  1.  . E  S XGCURBIN="00000001" ;EMPTY attr clears everything
  1.  ;in case all prev attr got turned off, turn on EMPTY attr
  1.  S $E(XGCURBIN,8)=$S($E(XGCURBIN,1,7)[1:0,1:1)
  1.  ;S XGCURATR=$$CNV(XGCURBIN)
  1.  S XGCURATR=^XUTL("XGATR1",XGCURBIN)
  1.  Q ^XUTL("XGATR",XGCURATR) ;return escape sequence
  1.  ;
  1.  ;
  1. CHG(XGATR) ;XGATR=passed attribute string ie: R1B0G1
  1.  ;RELATIVE change of screen attributes to the new ones.  Only changes attributes that were passed, retains others.  For ABSOLUTE set use SET
  1.  N X,%,XGATRLTR,XGATRASC,XGBIT,XGONOFF
  1.  S XGATRASC=$A(XGCURATR)
  1.  F %=1:2:$L(XGATR) S XGATRLTR=$E(XGATR,%),XGONOFF=$E(XGATR,%+1) D
  1.  . I XGATRLTR'="E" D  ;continue if not EMPTY
  1.  . . S XGBIT=2**($F("UGDRIB",XGATRLTR)-1) ;bit mask
  1.  . . ;if attribute bit needs to change add/subtract the mask
  1.  . . S:(XGATRASC\XGBIT#2)'=XGONOFF XGATRASC=XGATRASC+$S(XGONOFF=0:-XGBIT,1:XGBIT)
  1.  . E  S XGATRASC=1 ;EMPTY attr clears everything
  1.  S:XGATRASC=0 XGATRASC=1 ;if all attr got turned off, turn on EMPTY attr
  1.  S XGCURATR=$C(XGATRASC)
  1.  Q ^XUTL("XGATR",XGCURATR) ;return escape sequence
  1.  ;
  1.  ;
  1. STAT(XGATR) ;returns the state of a specific attribute
  1.  ;XGATR is the attribute mnemonic character. Possible values are
  1.  ;B-blinking, I-high intensity, R-reverse, D-double wide, G-graphics
  1.  ;U-underline, E-empty
  1.  Q $A(XGCURATR)\(2**($F("EUGDRIB",XGATR)-2))#2
  1.  ;
  1.  ;
  1. ESC(XGATR) ;return ESC codes of all attributes in XGATR
  1.  ;XGATR=char represents what all attributes should be ex: R1B0
  1.  N %,XGESC,X,XGBIN
  1.  I XGATR'=XGEMPATR D  ;if setting to other than EMPTY attribute
  1.  .;get binary representation of CURRENTATTRIBUTES and NEWATTRIBUTES
  1.  .S XGBIN=$$CNV(XGATR)
  1.  .S XGESC=IORESET D  ;turn off all attr & process only 1s to turn on
  1.  ..F %=2:1:7 S X=$E(XGBIN,%) S:X XGESC=XGESC_$P(XGATRSET(%),U,2)
  1.  E  S XGESC=IORESET
  1.  Q XGESC
  1.  ;
  1.  ;
  1. CNV(ATR) ;convert attribute from character to binary and vice-versa
  1.  ;if $L(ATR)=8 then binary format is passed and character returned
  1.  ;if $L(ATR)=1 then character format is passed and binary str returned
  1.  N X,Y
  1.  I $L(ATR)=1 S X=$A(ATR),Y="" F  S Y=(X#2)_Y,X=X\2 I 'X S Y=$E(100000000+Y,2,9) Q
  1.  E  S Y="" F X=1:1:8 S Y=Y*2+$E(ATR,X)
  1.  E  S Y=$C(Y)
  1.  Q Y