XGFDEMO1 ;SFISC/VYD - graphics demo (cont.); ;01/27/95 15:16
;;8.0;KERNEL;;Jul 10, 1995
CURSOR ;cursor positioning
;;This demonstrates cursor positioning using
;; IOXY^XGF(row,col)
;;
;;Watch as the cursor makes its way around
;;the window.
;;
;;When you'll get tired of this, press any
;;key to stop.
N T,L,B,R,DELAY,STOP,K
S T=2,L=15,B=14,R=65,DELAY=1
D WIN^XGF(T,L,B,R,$NA(^TMP($J,"WIN")))
F %=1:1:8 D SAY^XGF(T+%+1,L+4,$P($T(CURSOR+%),";;",2))
W IOCUON S STOP=0
F D Q:STOP
.F %=L:3:R-1 Q:STOP D IOXY^XGF(T,%) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT)
.F %=T:1:B-1 Q:STOP D IOXY^XGF(%,R) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT)
.F %=R:-3:L+1 Q:STOP D IOXY^XGF(B,%) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT)
.F %=B:-1:T+1 Q:STOP D IOXY^XGF(%,L) S K=$$READ^XGF(1,DELAY) S STOP='$D(DTOUT)
W IOCUOFF
D RESTORE^XGF($NA(^TMP($J,"WIN")))
Q
;
ATTRIBUT ;
N T,L,B,R,K
S T=1,L=12,B=23,R=68
D WIN^XGF(T,L,B,R,$NA(^TMP($J,"WIN")))
D SAY^XGF(T+1,L+2,"By now you've probably seen this table somewhere")
D SAY^XGF(B-2,L+2,"...but now you have easy control of video attributes")
D SAY^XGF("+",L+10,"Press any key to return to the menu")
D SAY^XGF(T+3,L+5,"NORMAL ","E1")
D SAY^XGF("+",L+5,"INTENSITY ","I1")
D SAY^XGF("+",L+5,"REVERSE ","R1")
D SAY^XGF("+",L+5,"REVERSE,INTENSITY ","R1I1")
D SAY^XGF("+",L+5,"UNDERLINE ","U1")
D SAY^XGF("+",L+5,"UNDERLINE,INTENSITY ","U1I1")
D SAY^XGF("+",L+5,"UNDERLINE,REVERSE ","U1R1")
D SAY^XGF("+",L+5,"UNDERLINE,REVERSE,INTENSITY ","U1R1I1")
D CHGA^XGF("B1") ;turn blink on
D SAY^XGF("+",L+5,"BLINK")
D SAY^XGF("+",L+5,"BLINK,INTENSITY ","I1")
D SAY^XGF("+",L+5,"BLINK,REVERSE ","R1")
D SAY^XGF("+",L+5,"BLINK,REVERSE,INTENSITY ","R1I1")
D SAY^XGF("+",L+5,"BLINK,UNDERLINE ","U1")
D SAY^XGF("+",L+5,"BLINK,UNDERLINE,INTENSITY ","U1I1")
D SAY^XGF("+",L+5,"BLINK,UNDERLINE,REVERSE ","U1R1")
D SAY^XGF("+",L+5,"BLINK,UNDERLINE,REVERSE,INTENSITY","U1R1I1")
D CHGA^XGF("B0") ;turn blink off
S K=$$READ^XGF(1,0)
D RESTORE^XGF($NA(^TMP($J,"WIN")))
Q
;
KEYBOARD ;
;;Type some text and try different things:
;; - exceed the limit (15 characters)
;; - let timeout elapse (10 seconds)
;; - try terminators (function keys, arrow keys, keypad, etc.)
;;
;;To stop, type in "^" and press <RETURN> before time runs out.
;;
;;
;; Enter: [ ]
;;
;;Last Pass String Typed Terminator Limit Reached Timeout
;;--------- --------------- ---------- ------------- -------
N T,L,B,R,K
S T=5,L=5,B=20,R=75
D WIN^XGF(T,L,B,R,$NA(^TMP($J,"WIN")))
F %=1:1:12 D SAY^XGF(T+%+1,L+4,$P($T(KEYBOARD+%),";;",2))
W IOCUON X ^%ZOSF("EON")
F %=1:1 D Q:S="^"&('$D(DTOUT))
.D SAY^XGF(T+10,L+15,"_______________"),IOXY^XGF(T+10,L+15)
.S S=$$READ^XGF(15,10)
.D SAY^XGF(T+14,L+13,$J("",55)) ;clear output line for new results
.D SAY^XGF(T+14,L+8,%) ; display the pass #
.D SAY^XGF("",L+15,S) ; string typed
.D SAY^XGF("",L+35,$S($L(XGRT):XGRT,1:"none")) ;read terminator
.D SAY^XGF("",L+50,$S($L(S)=15:"Yes",1:"No")) ; length exceed status
.D SAY^XGF("",L+61,$S($D(DTOUT):"Yes",1:"No")) ;timeout status
W IOCUOFF X ^%ZOSF("EOFF")
D RESTORE^XGF($NA(^TMP($J,"WIN")))
Q
;
WINDOWS ;
D WIN^XGF(0,0,12,39,$NA(^TMP($J,"W1")))
D SAY^XGF(2,2,"This is a medium sized window")
D CHGA^XGF("U1")
D SAY^XGF(3,2,"coords are:0,0,12,39 "_(13*40)_" cells")
D CHGA^XGF("I1")
H 1 D WIN^XGF(0,40,23,79,$NA(^TMP($J,"W2")))
D CHGA^XGF("B1")
D SAY^XGF(4,41,"This is window is half the screen")
D CHGA^XGF("R1")
D SAY^XGF(6,41,"coords are:0,40,23,79 "_(24*40)_" cells")
D CHGA^XGF("B0")
H 1 D WIN^XGF(15,5,20,30,$NA(^TMP($J,"W3")))
D CHGA^XGF("E1")
D SAY^XGF(17,6,"This is a small window")
D SAY^XGF(18,6,"coords are:15,5,20,30")
D SAY^XGF(19,6,(6*26)_" cells")
H 1 D WIN^XGF(5,20,22,60,$NA(^TMP($J,"W4")))
D SAY^XGF(7,22,"This is 4th window")
D SAY^XGF(9,22,"coords are:5,20,16,60 "_(12*41)_" cells")
H 1 D WIN^XGF(3,50,21,77,$NA(^TMP($J,"W5")))
D SAY^XGF(5,52,"This is 5th window")
D SAY^XGF(7,52,"coords are:3,50,21,77")
D SAY^XGF(9,52,(19*28)_" cells")
H 1 D WIN^XGF(10,15,17,65,$NA(^TMP($J,"W6")))
D SAY^XGF(12,23,"Please don't touch the keyboard.","R1")
D SAY^XGF(14,23,"All windows will close in 5 seconds.")
H 5
F %="W6","W5","W4","W3","W2","W1" H 1 D RESTORE^XGF($NA(^TMP($J,%)))
Q
;
EXIT ;exit out of the demo program
;;"Application type" code for this
;;demo is in XGFDEMO, XGFDEMO1
;;routines.
;;
;;....wait until Kernel 8 is out!
N I,S
D CLEAR^XGF(NT+1,NL+1,NB-1,NR-1)
F I=1:1:5 S S=$P($T(EXIT+I),";;",2) D SAY^XGF(NT+I,NL+1,S)
S STOP=1
D IOXY^XGF(21,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXGFDEMO1 4997 printed Dec 13, 2024@02:02:19 Page 2
XGFDEMO1 ;SFISC/VYD - graphics demo (cont.); ;01/27/95 15:16
+1 ;;8.0;KERNEL;;Jul 10, 1995
CURSOR ;cursor positioning
+1 ;;This demonstrates cursor positioning using
+2 ;; IOXY^XGF(row,col)
+3 ;;
+4 ;;Watch as the cursor makes its way around
+5 ;;the window.
+6 ;;
+7 ;;When you'll get tired of this, press any
+8 ;;key to stop.
+9 NEW T,L,B,R,DELAY,STOP,K
+10 SET T=2
SET L=15
SET B=14
SET R=65
SET DELAY=1
+11 DO WIN^XGF(T,L,B,R,$NAME(^TMP($JOB,"WIN")))
+12 FOR %=1:1:8
DO SAY^XGF(T+%+1,L+4,$PIECE($TEXT(CURSOR+%),";;",2))
+13 WRITE IOCUON
SET STOP=0
+14 FOR
Begin DoDot:1
+15 FOR %=L:3:R-1
if STOP
QUIT
DO IOXY^XGF(T,%)
SET K=$$READ^XGF(1,DELAY)
SET STOP='$DATA(DTOUT)
+16 FOR %=T:1:B-1
if STOP
QUIT
DO IOXY^XGF(%,R)
SET K=$$READ^XGF(1,DELAY)
SET STOP='$DATA(DTOUT)
+17 FOR %=R:-3:L+1
if STOP
QUIT
DO IOXY^XGF(B,%)
SET K=$$READ^XGF(1,DELAY)
SET STOP='$DATA(DTOUT)
+18 FOR %=B:-1:T+1
if STOP
QUIT
DO IOXY^XGF(%,L)
SET K=$$READ^XGF(1,DELAY)
SET STOP='$DATA(DTOUT)
End DoDot:1
if STOP
QUIT
+19 WRITE IOCUOFF
+20 DO RESTORE^XGF($NAME(^TMP($JOB,"WIN")))
+21 QUIT
+22 ;
ATTRIBUT ;
+1 NEW T,L,B,R,K
+2 SET T=1
SET L=12
SET B=23
SET R=68
+3 DO WIN^XGF(T,L,B,R,$NAME(^TMP($JOB,"WIN")))
+4 DO SAY^XGF(T+1,L+2,"By now you've probably seen this table somewhere")
+5 DO SAY^XGF(B-2,L+2,"...but now you have easy control of video attributes")
+6 DO SAY^XGF("+",L+10,"Press any key to return to the menu")
+7 DO SAY^XGF(T+3,L+5,"NORMAL ","E1")
+8 DO SAY^XGF("+",L+5,"INTENSITY ","I1")
+9 DO SAY^XGF("+",L+5,"REVERSE ","R1")
+10 DO SAY^XGF("+",L+5,"REVERSE,INTENSITY ","R1I1")
+11 DO SAY^XGF("+",L+5,"UNDERLINE ","U1")
+12 DO SAY^XGF("+",L+5,"UNDERLINE,INTENSITY ","U1I1")
+13 DO SAY^XGF("+",L+5,"UNDERLINE,REVERSE ","U1R1")
+14 DO SAY^XGF("+",L+5,"UNDERLINE,REVERSE,INTENSITY ","U1R1I1")
+15 ;turn blink on
DO CHGA^XGF("B1")
+16 DO SAY^XGF("+",L+5,"BLINK")
+17 DO SAY^XGF("+",L+5,"BLINK,INTENSITY ","I1")
+18 DO SAY^XGF("+",L+5,"BLINK,REVERSE ","R1")
+19 DO SAY^XGF("+",L+5,"BLINK,REVERSE,INTENSITY ","R1I1")
+20 DO SAY^XGF("+",L+5,"BLINK,UNDERLINE ","U1")
+21 DO SAY^XGF("+",L+5,"BLINK,UNDERLINE,INTENSITY ","U1I1")
+22 DO SAY^XGF("+",L+5,"BLINK,UNDERLINE,REVERSE ","U1R1")
+23 DO SAY^XGF("+",L+5,"BLINK,UNDERLINE,REVERSE,INTENSITY","U1R1I1")
+24 ;turn blink off
DO CHGA^XGF("B0")
+25 SET K=$$READ^XGF(1,0)
+26 DO RESTORE^XGF($NAME(^TMP($JOB,"WIN")))
+27 QUIT
+28 ;
KEYBOARD ;
+1 ;;Type some text and try different things:
+2 ;; - exceed the limit (15 characters)
+3 ;; - let timeout elapse (10 seconds)
+4 ;; - try terminators (function keys, arrow keys, keypad, etc.)
+5 ;;
+6 ;;To stop, type in "^" and press <RETURN> before time runs out.
+7 ;;
+8 ;;
+9 ;; Enter: [ ]
+10 ;;
+11 ;;Last Pass String Typed Terminator Limit Reached Timeout
+12 ;;--------- --------------- ---------- ------------- -------
+13 NEW T,L,B,R,K
+14 SET T=5
SET L=5
SET B=20
SET R=75
+15 DO WIN^XGF(T,L,B,R,$NAME(^TMP($JOB,"WIN")))
+16 FOR %=1:1:12
DO SAY^XGF(T+%+1,L+4,$PIECE($TEXT(KEYBOARD+%),";;",2))
+17 WRITE IOCUON
XECUTE ^%ZOSF("EON")
+18 FOR %=1:1
Begin DoDot:1
+19 DO SAY^XGF(T+10,L+15,"_______________")
DO IOXY^XGF(T+10,L+15)
+20 SET S=$$READ^XGF(15,10)
+21 ;clear output line for new results
DO SAY^XGF(T+14,L+13,$JUSTIFY("",55))
+22 ; display the pass #
DO SAY^XGF(T+14,L+8,%)
+23 ; string typed
DO SAY^XGF("",L+15,S)
+24 ;read terminator
DO SAY^XGF("",L+35,$SELECT($LENGTH(XGRT):XGRT,1:"none"))
+25 ; length exceed status
DO SAY^XGF("",L+50,$SELECT($LENGTH(S)=15:"Yes",1:"No"))
+26 ;timeout status
DO SAY^XGF("",L+61,$SELECT($DATA(DTOUT):"Yes",1:"No"))
End DoDot:1
if S="^"&('$DATA(DTOUT))
QUIT
+27 WRITE IOCUOFF
XECUTE ^%ZOSF("EOFF")
+28 DO RESTORE^XGF($NAME(^TMP($JOB,"WIN")))
+29 QUIT
+30 ;
WINDOWS ;
+1 DO WIN^XGF(0,0,12,39,$NAME(^TMP($JOB,"W1")))
+2 DO SAY^XGF(2,2,"This is a medium sized window")
+3 DO CHGA^XGF("U1")
+4 DO SAY^XGF(3,2,"coords are:0,0,12,39 "_(13*40)_" cells")
+5 DO CHGA^XGF("I1")
+6 HANG 1
DO WIN^XGF(0,40,23,79,$NAME(^TMP($JOB,"W2")))
+7 DO CHGA^XGF("B1")
+8 DO SAY^XGF(4,41,"This is window is half the screen")
+9 DO CHGA^XGF("R1")
+10 DO SAY^XGF(6,41,"coords are:0,40,23,79 "_(24*40)_" cells")
+11 DO CHGA^XGF("B0")
+12 HANG 1
DO WIN^XGF(15,5,20,30,$NAME(^TMP($JOB,"W3")))
+13 DO CHGA^XGF("E1")
+14 DO SAY^XGF(17,6,"This is a small window")
+15 DO SAY^XGF(18,6,"coords are:15,5,20,30")
+16 DO SAY^XGF(19,6,(6*26)_" cells")
+17 HANG 1
DO WIN^XGF(5,20,22,60,$NAME(^TMP($JOB,"W4")))
+18 DO SAY^XGF(7,22,"This is 4th window")
+19 DO SAY^XGF(9,22,"coords are:5,20,16,60 "_(12*41)_" cells")
+20 HANG 1
DO WIN^XGF(3,50,21,77,$NAME(^TMP($JOB,"W5")))
+21 DO SAY^XGF(5,52,"This is 5th window")
+22 DO SAY^XGF(7,52,"coords are:3,50,21,77")
+23 DO SAY^XGF(9,52,(19*28)_" cells")
+24 HANG 1
DO WIN^XGF(10,15,17,65,$NAME(^TMP($JOB,"W6")))
+25 DO SAY^XGF(12,23,"Please don't touch the keyboard.","R1")
+26 DO SAY^XGF(14,23,"All windows will close in 5 seconds.")
+27 HANG 5
+28 FOR %="W6","W5","W4","W3","W2","W1"
HANG 1
DO RESTORE^XGF($NAME(^TMP($JOB,%)))
+29 QUIT
+30 ;
EXIT ;exit out of the demo program
+1 ;;"Application type" code for this
+2 ;;demo is in XGFDEMO, XGFDEMO1
+3 ;;routines.
+4 ;;
+5 ;;....wait until Kernel 8 is out!
+6 NEW I,S
+7 DO CLEAR^XGF(NT+1,NL+1,NB-1,NR-1)
+8 FOR I=1:1:5
SET S=$PIECE($TEXT(EXIT+I),";;",2)
DO SAY^XGF(NT+I,NL+1,S)
+9 SET STOP=1
+10 DO IOXY^XGF(21,0)
+11 QUIT
