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/XGFDEMO1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1XGFDEMO1 ;SFISC/VYD - graphics demo (cont.); ;01/27/95 15:16
2 ;;8.0;KERNEL;;Jul 10, 1995
3CURSOR ;cursor positioning
4 ;;This demonstrates cursor positioning using
5 ;; IOXY^XGF(row,col)
6 ;;
7 ;;Watch as the cursor makes its way around
8 ;;the window.
9 ;;
10 ;;When you'll get tired of this, press any
11 ;;key to stop.
12 N T,L,B,R,DELAY,STOP,K
13 S T=2,L=15,B=14,R=65,DELAY=1
14 D WIN^XGF(T,L,B,R,$NA(^TMP($J,"WIN")))
15 F %=1:1:8 D SAY^XGF(T+%+1,L+4,$P($T(CURSOR+%),";;",2))
16 W IOCUON S STOP=0
17 F D Q:STOP
18 .F %=L:3:R-1 Q:STOP D IOXY^XGF(T,%) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT)
19 .F %=T:1:B-1 Q:STOP D IOXY^XGF(%,R) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT)
20 .F %=R:-3:L+1 Q:STOP D IOXY^XGF(B,%) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT)
21 .F %=B:-1:T+1 Q:STOP D IOXY^XGF(%,L) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT)
22 W IOCUOFF
23 D RESTORE^XGF($NA(^TMP($J,"WIN")))
24 Q
25 ;
26ATTRIBUT ;
27 N T,L,B,R,K
28 S T=1,L=12,B=23,R=68
29 D WIN^XGF(T,L,B,R,$NA(^TMP($J,"WIN")))
30 D SAY^XGF(T+1,L+2,"By now you've probably seen this table somewhere")
31 D SAY^XGF(B-2,L+2,"...but now you have easy control of video attributes")
32 D SAY^XGF("+",L+10,"Press any key to return to the menu")
33 D SAY^XGF(T+3,L+5,"NORMAL ","E1")
34 D SAY^XGF("+",L+5,"INTENSITY ","I1")
35 D SAY^XGF("+",L+5,"REVERSE ","R1")
36 D SAY^XGF("+",L+5,"REVERSE,INTENSITY ","R1I1")
37 D SAY^XGF("+",L+5,"UNDERLINE ","U1")
38 D SAY^XGF("+",L+5,"UNDERLINE,INTENSITY ","U1I1")
39 D SAY^XGF("+",L+5,"UNDERLINE,REVERSE ","U1R1")
40 D SAY^XGF("+",L+5,"UNDERLINE,REVERSE,INTENSITY ","U1R1I1")
41 D CHGA^XGF("B1") ;turn blink on
42 D SAY^XGF("+",L+5,"BLINK")
43 D SAY^XGF("+",L+5,"BLINK,INTENSITY ","I1")
44 D SAY^XGF("+",L+5,"BLINK,REVERSE ","R1")
45 D SAY^XGF("+",L+5,"BLINK,REVERSE,INTENSITY ","R1I1")
46 D SAY^XGF("+",L+5,"BLINK,UNDERLINE ","U1")
47 D SAY^XGF("+",L+5,"BLINK,UNDERLINE,INTENSITY ","U1I1")
48 D SAY^XGF("+",L+5,"BLINK,UNDERLINE,REVERSE ","U1R1")
49 D SAY^XGF("+",L+5,"BLINK,UNDERLINE,REVERSE,INTENSITY","U1R1I1")
50 D CHGA^XGF("B0") ;turn blink off
51 S K=$$READ^XGF(1,0)
52 D RESTORE^XGF($NA(^TMP($J,"WIN")))
53 Q
54 ;
55KEYBOARD ;
56 ;;Type some text and try different things:
57 ;; - exceed the limit (15 characters)
58 ;; - let timeout elapse (10 seconds)
59 ;; - try terminators (function keys, arrow keys, keypad, etc.)
60 ;;
61 ;;To stop, type in "^" and press <RETURN> before time runs out.
62 ;;
63 ;;
64 ;; Enter: [ ]
65 ;;
66 ;;Last Pass String Typed Terminator Limit Reached Timeout
67 ;;--------- --------------- ---------- ------------- -------
68 N T,L,B,R,K
69 S T=5,L=5,B=20,R=75
70 D WIN^XGF(T,L,B,R,$NA(^TMP($J,"WIN")))
71 F %=1:1:12 D SAY^XGF(T+%+1,L+4,$P($T(KEYBOARD+%),";;",2))
72 W IOCUON X ^%ZOSF("EON")
73 F %=1:1 D Q:S="^"&('$D(DTOUT))
74 .D SAY^XGF(T+10,L+15,"_______________"),IOXY^XGF(T+10,L+15)
75 .S S=$$READ^XGF(15,10)
76 .D SAY^XGF(T+14,L+13,$J("",55)) ;clear output line for new results
77 .D SAY^XGF(T+14,L+8,%) ; display the pass #
78 .D SAY^XGF("",L+15,S) ; string typed
79 .D SAY^XGF("",L+35,$S($L(XGRT):XGRT,1:"none")) ;read terminator
80 .D SAY^XGF("",L+50,$S($L(S)=15:"Yes",1:"No")) ; length exceed status
81 .D SAY^XGF("",L+61,$S($D(DTOUT):"Yes",1:"No")) ;timeout status
82 W IOCUOFF X ^%ZOSF("EOFF")
83 D RESTORE^XGF($NA(^TMP($J,"WIN")))
84 Q
85 ;
86WINDOWS ;
87 D WIN^XGF(0,0,12,39,$NA(^TMP($J,"W1")))
88 D SAY^XGF(2,2,"This is a medium sized window")
89 D CHGA^XGF("U1")
90 D SAY^XGF(3,2,"coords are:0,0,12,39 "_(13*40)_" cells")
91 D CHGA^XGF("I1")
92 H 1 D WIN^XGF(0,40,23,79,$NA(^TMP($J,"W2")))
93 D CHGA^XGF("B1")
94 D SAY^XGF(4,41,"This is window is half the screen")
95 D CHGA^XGF("R1")
96 D SAY^XGF(6,41,"coords are:0,40,23,79 "_(24*40)_" cells")
97 D CHGA^XGF("B0")
98 H 1 D WIN^XGF(15,5,20,30,$NA(^TMP($J,"W3")))
99 D CHGA^XGF("E1")
100 D SAY^XGF(17,6,"This is a small window")
101 D SAY^XGF(18,6,"coords are:15,5,20,30")
102 D SAY^XGF(19,6,(6*26)_" cells")
103 H 1 D WIN^XGF(5,20,22,60,$NA(^TMP($J,"W4")))
104 D SAY^XGF(7,22,"This is 4th window")
105 D SAY^XGF(9,22,"coords are:5,20,16,60 "_(12*41)_" cells")
106 H 1 D WIN^XGF(3,50,21,77,$NA(^TMP($J,"W5")))
107 D SAY^XGF(5,52,"This is 5th window")
108 D SAY^XGF(7,52,"coords are:3,50,21,77")
109 D SAY^XGF(9,52,(19*28)_" cells")
110 H 1 D WIN^XGF(10,15,17,65,$NA(^TMP($J,"W6")))
111 D SAY^XGF(12,23,"Please don't touch the keyboard.","R1")
112 D SAY^XGF(14,23,"All windows will close in 5 seconds.")
113 H 5
114 F %="W6","W5","W4","W3","W2","W1" H 1 D RESTORE^XGF($NA(^TMP($J,%)))
115 Q
116 ;
117EXIT ;exit out of the demo program
118 ;;"Application type" code for this
119 ;;demo is in XGFDEMO, XGFDEMO1
120 ;;routines.
121 ;;
122 ;;....wait until Kernel 8 is out!
123 N I,S
124 D CLEAR^XGF(NT+1,NL+1,NB-1,NR-1)
125 F I=1:1:5 S S=$P($T(EXIT+I),";;",2) D SAY^XGF(NT+I,NL+1,S)
126 S STOP=1
127 D IOXY^XGF(21,0)
128 Q
Note: See TracBrowser for help on using the repository browser.