XGSETUP ;SFISC/VYD - setup KWAPI environment ;03/16/95 13:29
;;8.0;KERNEL;;Jul 10, 1995
PREP ;prepare graphics environment. Can be called multiple times.
N %,X
S U="^",C=","
D CLEAN2
S XG255=$C(255)
S XGPAD=$J("",IOM)
D:'$D(XGATRSET)!('$D(XGEMPATR))!('$D(XGCURATR))!('$D(IORESET)) ATR
D:'$D(^XUTL("XGATR")) ATRTABLE
F %=0:1:IOSL-1 D
. S XGSCRN(%,0)=XGPAD
. S XGSCRN(%,1)=$TR(XGPAD," ",XGEMPATR)
D ADJUST^XGSW(0,0,IOSL-1,IOM-1,"XGSCRN") ;store "COORDS" node
S XGSCRN("ORDER",0)=$C(1)
W IORESET,IOCUOFF,IOKPAM,@IOF
S XGCURATR=XGEMPATR
X ^%ZOSF("EOFF")
S X=0 X ^%ZOSF("RM")
D INIT^XGKB("*") ;turn on escape processing
S $X=0,$Y=0 ;S ($X,$Y)=0 ;DTM 4.3 choked here
Q
;
;
KWAPI ;K-WAPI specific setup
N %
S (XGOLDFCS,XGNEWFCS)=""
S XGFLAG("ABORT")=0 ;flag if 1 will stop processing of a gadget
S XGFLAG("PAINT")=21 ;initialize paint flag
S XGESEQ="1000000^0" ;event_stack_level^event_sequence_counter unique
S XGMENU="" ;flag if not empty indicates that user went or is in menu
S XGUFCTR("PIXEL","X")=0.125
S XGUFCTR("PIXEL","Y")=0.05
S XGUFCTR("CHAR","X")=1
S XGUFCTR("CHAR","Y")=1
;
;------------set up DISPLAY with defaults
S ^TMP("XGD",$J,$PD,"PLATFORM")="ZEMULATION,KERNEL "_$$VERSION^XPDUTL("XU")
S:'$D(^TMP("XGD",$J,$PD,"FOCUS")) ^("FOCUS")=""
S:'$D(^TMP("XGD",$J,$PD,"UNITS")) ^("UNITS")="PIXEL"
;
;------------load key-actions
D ACTION^XGKB("KP0","D KP0^XGJUMP") ;menubar
D ACTION^XGKB("F10","D KP0^XGJUMP") ;menubar
D ACTION^XGKB("CR","D CR^XGJUMP")
D ACTION^XGKB("^C","D CTRLC^XGJUMP") ;break the program
D ACTION^XGKB("^R","D CTRLR^XGJUMP") ;window resize
D ACTION^XGKB("^V","D CTRLV^XGJUMP") ;window move
D ACTION^XGKB("^W","D CTRLW^XGJUMP") ;window select window
D ACTION^XGKB("^Z","D CTRLZ^XGJUMP") ;window close
D ACTION^XGKB("^\","D CTRLBSL^XGJUMP") ;window control menu
D ACTION^XGKB("TAB","D TAB^XGJUMP") ;next gadget
D ACTION^XGKB("PF4","D PF4^XGJUMP") ;previous gadget
;
;------------ set up a window control menu
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",1)="&Restore"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",2)="&Move"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",2,"EVENT","SELECT")="MOVE^XGWCTRL"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",2,"ACCELERATOR")="^V"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",3)="&Size"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",3,"EVENT","SELECT")="RESIZE^XGWCTRL"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",4)="Mi&nimize"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",5)="Ma&ximize"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",5,"SEPARATOR")=1
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",6)="&Close"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",6,"EVENT","SELECT")="CLOSE^XGWCTRL"
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",6,"SEPARATOR")=1
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",7)="S&witch To..."
S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",7,"EVENT","SELECT")="CTRLW^XGJUMP"
;
;------------ put up wall paper and save it as 1st window
;D GRID^XGFDEMO
;D ^XGWALL
;M ^TMP("XGS",$J,$C(1))=XGSCRN
D WINSAVE^XGWIN($C(1),0,0,IOSL,IOM)
Q
;
ATR ;setup screen/graphic params. load attribute array
; this should usually run once at login
N X
I ^%ZOSF("OS")["DTM" U $I:VT=1 ;if DTM change to VT220 emulation
D HOME^%ZIS,GSET^%ZISS
S X="IOBOFF;IOBON;IODWL;IOINHI;IOINORM;IOKPAM;IOKPNM;IORESET;IORVOFF;IORVON;IOSWL;IOUON;IOUOFF" D ENDR^%ZISS
S IORESET=$C(27)_"[0m"_IOG0 ;turn off all attr. diff from stnd IORESET
S IOCUOFF=$C(27)_"[?25l",IOCUON=$C(27)_"[?25h" ;cursor on, cursor off
S XGATRSET(8)=U_IORESET,XGATRSET(2)=IOBOFF_U_IOBON
S XGATRSET(3)=IOINORM_U_IOINHI,XGATRSET(4)=IORVOFF_U_IORVON
S XGATRSET(5)=IOSWL_U_IODWL,XGATRSET(6)=IOG0_U_IOG1
S XGATRSET(7)=IOUOFF_U_IOUON
S (XGCURATR,XGEMPATR)=$C(1)
Q
;
ATRTABLE ;setup ^XUTL("XGATR" attr letter to ESC code conversion table
N %
F %=1:1:255 S ^XUTL("XGATR",$C(%))=$$ESC^XGSA($C(%))
Q
;
CLEAN ;clean up KWAPI variables, screen/graphic parameters
;this tag does universal clean up. It should be called at the end of all K-WAPI sessions.
X ^%ZOSF("EON") ; turn echo on
S X=IOM X ^%ZOSF("RM") ;restore right margin for proper wrapping
W IOCUON_IOKPNM_IORESET ; cursor on, number mode, reset terminal
D EXIT^XGKB ; turn off escape processing
D KILL^%ZISS,GKILL^%ZISS
K XGATRSET,XGCURATR,XGEMPATR,XGKEYMAP,XGSPCIAL,XGPAD,XG255
K IOCUON,IOCUOFF
K XGWIN,XGEVNT,XGDI
CLEAN2 ;other than fall through, this is called from PREP
K ^TMP("XGE",$J),^TMP("XGD",$J),^TMP("XGS",$J),^TMP("XGW",$J)
K ^TMP("XGUTIL",$J),^TMP("XGKEY",$J) ;kill utility and key-action table
K XGMENU,XGSCRN,XGWT,XGWL,XGWB,XGWR,XGTRACE,XGOLDFCS,XGNEWFCS
K XGW,XGG,XGID,XGMENU,XGFLAG,XGUFCTR,XGDEFBTN,XGNEXTG,XGWAIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXGSETUP 4759 printed Dec 13, 2024@02:02:25 Page 2
XGSETUP ;SFISC/VYD - setup KWAPI environment ;03/16/95 13:29
+1 ;;8.0;KERNEL;;Jul 10, 1995
PREP ;prepare graphics environment. Can be called multiple times.
+1 NEW %,X
+2 SET U="^"
SET C=","
+3 DO CLEAN2
+4 SET XG255=$CHAR(255)
+5 SET XGPAD=$JUSTIFY("",IOM)
+6 if '$DATA(XGATRSET)!('$DATA(XGEMPATR))!('$DATA(XGCURATR))!('$DATA(IORESET))
DO ATR
+7 if '$DATA(^XUTL("XGATR"))
DO ATRTABLE
+8 FOR %=0:1:IOSL-1
Begin DoDot:1
+9 SET XGSCRN(%,0)=XGPAD
+10 SET XGSCRN(%,1)=$TRANSLATE(XGPAD," ",XGEMPATR)
End DoDot:1
+11 ;store "COORDS" node
DO ADJUST^XGSW(0,0,IOSL-1,IOM-1,"XGSCRN")
+12 SET XGSCRN("ORDER",0)=$CHAR(1)
+13 WRITE IORESET,IOCUOFF,IOKPAM,@IOF
+14 SET XGCURATR=XGEMPATR
+15 XECUTE ^%ZOSF("EOFF")
+16 SET X=0
XECUTE ^%ZOSF("RM")
+17 ;turn on escape processing
DO INIT^XGKB("*")
+18 ;S ($X,$Y)=0 ;DTM 4.3 choked here
SET $X=0
SET $Y=0
+19 QUIT
+20 ;
+21 ;
KWAPI ;K-WAPI specific setup
+1 NEW %
+2 SET (XGOLDFCS,XGNEWFCS)=""
+3 ;flag if 1 will stop processing of a gadget
SET XGFLAG("ABORT")=0
+4 ;initialize paint flag
SET XGFLAG("PAINT")=21
+5 ;event_stack_level^event_sequence_counter unique
SET XGESEQ="1000000^0"
+6 ;flag if not empty indicates that user went or is in menu
SET XGMENU=""
+7 SET XGUFCTR("PIXEL","X")=0.125
+8 SET XGUFCTR("PIXEL","Y")=0.05
+9 SET XGUFCTR("CHAR","X")=1
+10 SET XGUFCTR("CHAR","Y")=1
+11 ;
+12 ;------------set up DISPLAY with defaults
+13
*** ERROR ***
SET ^TMP("XGD",$JOB,$PD,"PLATFORM")="ZEMULATION,KERNEL "_$$VERSION^XPDUTL("XU")
+14
*** ERROR ***
if '$DATA(^TMP("XGD",$JOB,$PD,"FOCUS"))
SET ^("FOCUS")=""
+15
*** ERROR ***
if '$DATA(^TMP("XGD",$JOB,$PD,"UNITS"))
SET ^("UNITS")="PIXEL"
+16 ;
+17 ;------------load key-actions
+18 ;menubar
DO ACTION^XGKB("KP0","D KP0^XGJUMP")
+19 ;menubar
DO ACTION^XGKB("F10","D KP0^XGJUMP")
+20 DO ACTION^XGKB("CR","D CR^XGJUMP")
+21 ;break the program
DO ACTION^XGKB("^C","D CTRLC^XGJUMP")
+22 ;window resize
DO ACTION^XGKB("^R","D CTRLR^XGJUMP")
+23 ;window move
DO ACTION^XGKB("^V","D CTRLV^XGJUMP")
+24 ;window select window
DO ACTION^XGKB("^W","D CTRLW^XGJUMP")
+25 ;window close
DO ACTION^XGKB("^Z","D CTRLZ^XGJUMP")
+26 ;window control menu
DO ACTION^XGKB("^\","D CTRLBSL^XGJUMP")
+27 ;next gadget
DO ACTION^XGKB("TAB","D TAB^XGJUMP")
+28 ;previous gadget
DO ACTION^XGKB("PF4","D PF4^XGJUMP")
+29 ;
+30 ;------------ set up a window control menu
+31 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",1)="&Restore"
+32 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",2)="&Move"
+33 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",2,"EVENT","SELECT")="MOVE^XGWCTRL"
+34 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",2,"ACCELERATOR")="^V"
+35 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",3)="&Size"
+36 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",3,"EVENT","SELECT")="RESIZE^XGWCTRL"
+37 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",4)="Mi&nimize"
+38 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",5)="Ma&ximize"
+39 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",5,"SEPARATOR")=1
+40 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",6)="&Close"
+41 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",6,"EVENT","SELECT")="CLOSE^XGWCTRL"
+42 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",6,"SEPARATOR")=1
+43 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",7)="S&witch To..."
+44 SET ^TMP("XGUTIL",$JOB,"~XGWM","CHOICE",7,"EVENT","SELECT")="CTRLW^XGJUMP"
+45 ;
+46 ;------------ put up wall paper and save it as 1st window
+47 ;D GRID^XGFDEMO
+48 ;D ^XGWALL
+49 ;M ^TMP("XGS",$J,$C(1))=XGSCRN
+50 DO WINSAVE^XGWIN($CHAR(1),0,0,IOSL,IOM)
+51 QUIT
+52 ;
ATR ;setup screen/graphic params. load attribute array
+1 ; this should usually run once at login
+2 NEW X
+3 ;if DTM change to VT220 emulation
IF ^%ZOSF("OS")["DTM"
USE $IO:VT=1
+4 DO HOME^%ZIS
DO GSET^%ZISS
+5 SET X="IOBOFF;IOBON;IODWL;IOINHI;IOINORM;IOKPAM;IOKPNM;IORESET;IORVOFF;IORVON;IOSWL;IOUON;IOUOFF"
DO ENDR^%ZISS
+6 ;turn off all attr. diff from stnd IORESET
SET IORESET=$CHAR(27)_"[0m"_IOG0
+7 ;cursor on, cursor off
SET IOCUOFF=$CHAR(27)_"[?25l"
SET IOCUON=$CHAR(27)_"[?25h"
+8 SET XGATRSET(8)=U_IORESET
SET XGATRSET(2)=IOBOFF_U_IOBON
+9 SET XGATRSET(3)=IOINORM_U_IOINHI
SET XGATRSET(4)=IORVOFF_U_IORVON
+10 SET XGATRSET(5)=IOSWL_U_IODWL
SET XGATRSET(6)=IOG0_U_IOG1
+11 SET XGATRSET(7)=IOUOFF_U_IOUON
+12 SET (XGCURATR,XGEMPATR)=$CHAR(1)
+13 QUIT
+14 ;
ATRTABLE ;setup ^XUTL("XGATR" attr letter to ESC code conversion table
+1 NEW %
+2 FOR %=1:1:255
SET ^XUTL("XGATR",$CHAR(%))=$$ESC^XGSA($CHAR(%))
+3 QUIT
+4 ;
CLEAN ;clean up KWAPI variables, screen/graphic parameters
+1 ;this tag does universal clean up. It should be called at the end of all K-WAPI sessions.
+2 ; turn echo on
XECUTE ^%ZOSF("EON")
+3 ;restore right margin for proper wrapping
SET X=IOM
XECUTE ^%ZOSF("RM")
+4 ; cursor on, number mode, reset terminal
WRITE IOCUON_IOKPNM_IORESET
+5 ; turn off escape processing
DO EXIT^XGKB
+6 DO KILL^%ZISS
DO GKILL^%ZISS
+7 KILL XGATRSET,XGCURATR,XGEMPATR,XGKEYMAP,XGSPCIAL,XGPAD,XG255
+8 KILL IOCUON,IOCUOFF
+9 KILL XGWIN,XGEVNT,XGDI
CLEAN2 ;other than fall through, this is called from PREP
+1 KILL ^TMP("XGE",$JOB),^TMP("XGD",$JOB),^TMP("XGS",$JOB),^TMP("XGW",$JOB)
+2 ;kill utility and key-action table
KILL ^TMP("XGUTIL",$JOB),^TMP("XGKEY",$JOB)
+3 KILL XGMENU,XGSCRN,XGWT,XGWL,XGWB,XGWR,XGTRACE,XGOLDFCS,XGNEWFCS
+4 KILL XGW,XGG,XGID,XGMENU,XGFLAG,XGUFCTR,XGDEFBTN,XGNEXTG,XGWAIT
+5 QUIT
