- 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 Jan 18, 2025@03:03:31 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