source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XGSETUP.m@ 719

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1XGSETUP ;SFISC/VYD - setup KWAPI environment ;03/16/95 13:29
2 ;;8.0;KERNEL;;Jul 10, 1995
3PREP ;prepare graphics environment. Can be called multiple times.
4 N %,X
5 S U="^",C=","
6 D CLEAN2
7 S XG255=$C(255)
8 S XGPAD=$J("",IOM)
9 D:'$D(XGATRSET)!('$D(XGEMPATR))!('$D(XGCURATR))!('$D(IORESET)) ATR
10 D:'$D(^XUTL("XGATR")) ATRTABLE
11 F %=0:1:IOSL-1 D
12 . S XGSCRN(%,0)=XGPAD
13 . S XGSCRN(%,1)=$TR(XGPAD," ",XGEMPATR)
14 D ADJUST^XGSW(0,0,IOSL-1,IOM-1,"XGSCRN") ;store "COORDS" node
15 S XGSCRN("ORDER",0)=$C(1)
16 W IORESET,IOCUOFF,IOKPAM,@IOF
17 S XGCURATR=XGEMPATR
18 X ^%ZOSF("EOFF")
19 S X=0 X ^%ZOSF("RM")
20 D INIT^XGKB("*") ;turn on escape processing
21 S $X=0,$Y=0 ;S ($X,$Y)=0 ;DTM 4.3 choked here
22 Q
23 ;
24 ;
25KWAPI ;K-WAPI specific setup
26 N %
27 S (XGOLDFCS,XGNEWFCS)=""
28 S XGFLAG("ABORT")=0 ;flag if 1 will stop processing of a gadget
29 S XGFLAG("PAINT")=21 ;initialize paint flag
30 S XGESEQ="1000000^0" ;event_stack_level^event_sequence_counter unique
31 S XGMENU="" ;flag if not empty indicates that user went or is in menu
32 S XGUFCTR("PIXEL","X")=0.125
33 S XGUFCTR("PIXEL","Y")=0.05
34 S XGUFCTR("CHAR","X")=1
35 S XGUFCTR("CHAR","Y")=1
36 ;
37 ;------------set up DISPLAY with defaults
38 S ^TMP("XGD",$J,$PD,"PLATFORM")="ZEMULATION,KERNEL "_$$VERSION^XPDUTL("XU")
39 S:'$D(^TMP("XGD",$J,$PD,"FOCUS")) ^("FOCUS")=""
40 S:'$D(^TMP("XGD",$J,$PD,"UNITS")) ^("UNITS")="PIXEL"
41 ;
42 ;------------load key-actions
43 D ACTION^XGKB("KP0","D KP0^XGJUMP") ;menubar
44 D ACTION^XGKB("F10","D KP0^XGJUMP") ;menubar
45 D ACTION^XGKB("CR","D CR^XGJUMP")
46 D ACTION^XGKB("^C","D CTRLC^XGJUMP") ;break the program
47 D ACTION^XGKB("^R","D CTRLR^XGJUMP") ;window resize
48 D ACTION^XGKB("^V","D CTRLV^XGJUMP") ;window move
49 D ACTION^XGKB("^W","D CTRLW^XGJUMP") ;window select window
50 D ACTION^XGKB("^Z","D CTRLZ^XGJUMP") ;window close
51 D ACTION^XGKB("^\","D CTRLBSL^XGJUMP") ;window control menu
52 D ACTION^XGKB("TAB","D TAB^XGJUMP") ;next gadget
53 D ACTION^XGKB("PF4","D PF4^XGJUMP") ;previous gadget
54 ;
55 ;------------ set up a window control menu
56 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",1)="&Restore"
57 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",2)="&Move"
58 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",2,"EVENT","SELECT")="MOVE^XGWCTRL"
59 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",2,"ACCELERATOR")="^V"
60 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",3)="&Size"
61 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",3,"EVENT","SELECT")="RESIZE^XGWCTRL"
62 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",4)="Mi&nimize"
63 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",5)="Ma&ximize"
64 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",5,"SEPARATOR")=1
65 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",6)="&Close"
66 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",6,"EVENT","SELECT")="CLOSE^XGWCTRL"
67 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",6,"SEPARATOR")=1
68 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",7)="S&witch To..."
69 S ^TMP("XGUTIL",$J,"~XGWM","CHOICE",7,"EVENT","SELECT")="CTRLW^XGJUMP"
70 ;
71 ;------------ put up wall paper and save it as 1st window
72 ;D GRID^XGFDEMO
73 ;D ^XGWALL
74 ;M ^TMP("XGS",$J,$C(1))=XGSCRN
75 D WINSAVE^XGWIN($C(1),0,0,IOSL,IOM)
76 Q
77 ;
78ATR ;setup screen/graphic params. load attribute array
79 ; this should usually run once at login
80 N X
81 I ^%ZOSF("OS")["DTM" U $I:VT=1 ;if DTM change to VT220 emulation
82 D HOME^%ZIS,GSET^%ZISS
83 S X="IOBOFF;IOBON;IODWL;IOINHI;IOINORM;IOKPAM;IOKPNM;IORESET;IORVOFF;IORVON;IOSWL;IOUON;IOUOFF" D ENDR^%ZISS
84 S IORESET=$C(27)_"[0m"_IOG0 ;turn off all attr. diff from stnd IORESET
85 S IOCUOFF=$C(27)_"[?25l",IOCUON=$C(27)_"[?25h" ;cursor on, cursor off
86 S XGATRSET(8)=U_IORESET,XGATRSET(2)=IOBOFF_U_IOBON
87 S XGATRSET(3)=IOINORM_U_IOINHI,XGATRSET(4)=IORVOFF_U_IORVON
88 S XGATRSET(5)=IOSWL_U_IODWL,XGATRSET(6)=IOG0_U_IOG1
89 S XGATRSET(7)=IOUOFF_U_IOUON
90 S (XGCURATR,XGEMPATR)=$C(1)
91 Q
92 ;
93ATRTABLE ;setup ^XUTL("XGATR" attr letter to ESC code conversion table
94 N %
95 F %=1:1:255 S ^XUTL("XGATR",$C(%))=$$ESC^XGSA($C(%))
96 Q
97 ;
98CLEAN ;clean up KWAPI variables, screen/graphic parameters
99 ;this tag does universal clean up. It should be called at the end of all K-WAPI sessions.
100 X ^%ZOSF("EON") ; turn echo on
101 S X=IOM X ^%ZOSF("RM") ;restore right margin for proper wrapping
102 W IOCUON_IOKPNM_IORESET ; cursor on, number mode, reset terminal
103 D EXIT^XGKB ; turn off escape processing
104 D KILL^%ZISS,GKILL^%ZISS
105 K XGATRSET,XGCURATR,XGEMPATR,XGKEYMAP,XGSPCIAL,XGPAD,XG255
106 K IOCUON,IOCUOFF
107 K XGWIN,XGEVNT,XGDI
108CLEAN2 ;other than fall through, this is called from PREP
109 K ^TMP("XGE",$J),^TMP("XGD",$J),^TMP("XGS",$J),^TMP("XGW",$J)
110 K ^TMP("XGUTIL",$J),^TMP("XGKEY",$J) ;kill utility and key-action table
111 K XGMENU,XGSCRN,XGWT,XGWL,XGWB,XGWR,XGTRACE,XGOLDFCS,XGNEWFCS
112 K XGW,XGG,XGID,XGMENU,XGFLAG,XGUFCTR,XGDEFBTN,XGNEXTG,XGWAIT
113 Q
Note: See TracBrowser for help on using the repository browser.