XGFDEMO ;SFISC/VYD - demonstrate graphics functions ;12/30/93 10:22
;;8.0;KERNEL;;Jul 10, 1995
N NT,NL,NB,NR ;top,left,bottom,right for narrative window
N MT,ML,MB,MR ;top,left,bottom,right for menu window
N OLDCHOIC,NEWCHOIC,TAG,STOP,CHOICE
D PREP^XGF ;prepare environment for graphics functions
D GRID
D WELCOME
D MENU
S STOP=0
F S %=$$CHOOSE() D Q:STOP
.S TAG=$$UP^XLFSTR($TR($TR(CHOICE(%),"&","")," ",""))
.D @(TAG_"^XGFDEMO1") ;do the menu choice
D CLEAN^XGF K ^TMP($J)
Q
;
CHOOSE() ;choose a choice from the menu
;;Use <UP ARROW> or <DOWN ARROW>
;;or press a hot key of a choice
;;
;;Press <RETURN> to select.
N I,S,STOP
D CLEAR^XGF(NT+1,NL+1,NB-1,NR-1)
F I=1:1:4 S S=$P($T(CHOOSE+I),";;",2) D SAY^XGF(NT+I,NL+1,S)
I '$D(OLDCHOIC) S OLDCHOIC=2
S:'$D(NEWCHOIC) NEWCHOIC=1
S STOP=0
F D Q:STOP
.I NEWCHOIC'=OLDCHOIC D ;another choice was selected
..D SAYU^XGF(MT+OLDCHOIC,ML+1,CHOICE(OLDCHOIC),"E1")
..D SAYU^XGF(MT+NEWCHOIC,ML+1,CHOICE(NEWCHOIC),"R1")
..D SAY^XGF(IOSL-1,2,CHOICE(NEWCHOIC,1)_$J("",80))
..S OLDCHOIC=NEWCHOIC
.S KEY=$$READ^XGF(1)
.I XGRT="CR" S STOP=1
.E I $L(KEY),$D(CHOICE("HK",$$UP^XLFSTR(KEY))) S NEWCHOIC=CHOICE("HK",$$UP^XLFSTR(KEY))
.E I XGRT="UP" S NEWCHOIC=$S($D(CHOICE(OLDCHOIC-1)):OLDCHOIC-1,1:$O(CHOICE("A"),-1))
.E I XGRT="DOWN" S NEWCHOIC=$S($D(CHOICE(OLDCHOIC+1)):OLDCHOIC+1,1:$O(CHOICE("")))
Q NEWCHOIC
;
;;&Cursor;Cursor positioning
;;&Attributes;Output text in different video attributes
;;&Windows;Open overlapping pop-up windows and restore screen when closed
;;&Keyboard;Experiment with the low level keyboard reader
;;E&xit;Stop the demo
N I
F I=1:1 D Q:CHOICE(I)["E&xit"
.S CHOICE(I)=$P($T(MENU+I),";",3)
.S CHOICE(I)=CHOICE(I)_$J("",11-$L(CHOICE(I)))
.S CHOICE(I,1)=$P($T(MENU+I),";",4)
.S CHOICE("HK",$$UP^XLFSTR($E($P(CHOICE(I),"&",2))))=I ;hot key x-ref
S MT=2,ML=2,MB=MT+I+1,MR=ML+11
D WIN^XGF(MT,ML,MB,MR,$NA(^TMP($J,"MENU")))
S $Y=MT
F %=1:1:I D SAYU^XGF("+",ML+1,CHOICE(%))
Q
;
GRID ;draw a grid
N %,I
; X scale accross the top
S %="" F I=0:1:IOM-1 S %=%_$S((I#10)=0:I/10,(I#5)=0:"+",1:"-")
D SAY^XGF(0,0,%)
; Y scale along the left
F I=1:1:IOSL-1 S %=$S((I#10)=0:I/10,(I#5)=0:"+",1:"|") D SAY^XGF(I,0,%)
; grid of dots
S %="" F I=5:5:IOM-1 S %=%_" ."
F I=5:5:IOSL D SAY^XGF(I,1,%)
Q
WELCOME ;displays welcome text
;;The purpose of this demo is to
;;exercise different components of
;;the low level graphics functions
S NB=IOSL-3,NR=IOM-1,NT=NB-6,NL=NR-33
D SAVE^XGF(NT,NL,NB,NR,$NA(^TMP($J,"NARRATIVE")))
D CLEAR^XGF(NT,NL,NB,NR),CHGA^XGF("R1"),FRAME^XGF(NT,NL,NB,NR),CHGA^XGF("R0")
D SAY^XGF(NT+1,NL+11,"W E L C O M E","U1B1")
F I=1:1:3 S S=$P($T(WELCOME+I),";;",2) D SAY^XGF(NT+I+1,NL+1,S)
D SAY^XGF(NB-1,NL+8,"RETURN","R1"),SAY^XGF("","+"," to continue")
F S %=$$READ^XGF(1) Q:XGRT="CR"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXGFDEMO 2937 printed Oct 16, 2024@18:03:08 Page 2
XGFDEMO ;SFISC/VYD - demonstrate graphics functions ;12/30/93 10:22
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 ;top,left,bottom,right for narrative window
NEW NT,NL,NB,NR
+3 ;top,left,bottom,right for menu window
NEW MT,ML,MB,MR
+4 NEW OLDCHOIC,NEWCHOIC,TAG,STOP,CHOICE
+5 ;prepare environment for graphics functions
DO PREP^XGF
+6 DO GRID
+7 DO WELCOME
+8 DO MENU
+9 SET STOP=0
+10 FOR
SET %=$$CHOOSE()
Begin DoDot:1
+11 SET TAG=$$UP^XLFSTR($TRANSLATE($TRANSLATE(CHOICE(%),"&","")," ",""))
+12 ;do the menu choice
DO @(TAG_"^XGFDEMO1")
End DoDot:1
if STOP
QUIT
+13 DO CLEAN^XGF
KILL ^TMP($JOB)
+14 QUIT
+15 ;
CHOOSE() ;choose a choice from the menu
+1 ;;Use <UP ARROW> or <DOWN ARROW>
+2 ;;or press a hot key of a choice
+3 ;;
+4 ;;Press <RETURN> to select.
+5 NEW I,S,STOP
+6 DO CLEAR^XGF(NT+1,NL+1,NB-1,NR-1)
+7 FOR I=1:1:4
SET S=$PIECE($TEXT(CHOOSE+I),";;",2)
DO SAY^XGF(NT+I,NL+1,S)
+8 IF '$DATA(OLDCHOIC)
SET OLDCHOIC=2
+9 if '$DATA(NEWCHOIC)
SET NEWCHOIC=1
+10 SET STOP=0
+11 FOR
Begin DoDot:1
+12 ;another choice was selected
IF NEWCHOIC'=OLDCHOIC
Begin DoDot:2
+13 DO SAYU^XGF(MT+OLDCHOIC,ML+1,CHOICE(OLDCHOIC),"E1")
+14 DO SAYU^XGF(MT+NEWCHOIC,ML+1,CHOICE(NEWCHOIC),"R1")
+15 DO SAY^XGF(IOSL-1,2,CHOICE(NEWCHOIC,1)_$JUSTIFY("",80))
+16 SET OLDCHOIC=NEWCHOIC
End DoDot:2
+17 SET KEY=$$READ^XGF(1)
+18 IF XGRT="CR"
SET STOP=1
+19 IF '$TEST
IF $LENGTH(KEY)
IF $DATA(CHOICE("HK",$$UP^XLFSTR(KEY)))
SET NEWCHOIC=CHOICE("HK",$$UP^XLFSTR(KEY))
+20 IF '$TEST
IF XGRT="UP"
SET NEWCHOIC=$SELECT($DATA(CHOICE(OLDCHOIC-1)):OLDCHOIC-1,1:$ORDER(CHOICE("A"),-1))
+21 IF '$TEST
IF XGRT="DOWN"
SET NEWCHOIC=$SELECT($DATA(CHOICE(OLDCHOIC+1)):OLDCHOIC+1,1:$ORDER(CHOICE("")))
End DoDot:1
if STOP
QUIT
+22 QUIT NEWCHOIC
+23 ;
+1 ;;&Cursor;Cursor positioning
+2 ;;&Attributes;Output text in different video attributes
+3 ;;&Windows;Open overlapping pop-up windows and restore screen when closed
+4 ;;&Keyboard;Experiment with the low level keyboard reader
+5 ;;E&xit;Stop the demo
+6 NEW I
+7 FOR I=1:1
Begin DoDot:1
+8 SET CHOICE(I)=$PIECE($TEXT(MENU+I),";",3)
+9 SET CHOICE(I)=CHOICE(I)_$JUSTIFY("",11-$LENGTH(CHOICE(I)))
+10 SET CHOICE(I,1)=$PIECE($TEXT(MENU+I),";",4)
+11 ;hot key x-ref
SET CHOICE("HK",$$UP^XLFSTR($EXTRACT($PIECE(CHOICE(I),"&",2))))=I
End DoDot:1
if CHOICE(I)["E&xit"
QUIT
+12 SET MT=2
SET ML=2
SET MB=MT+I+1
SET MR=ML+11
+13 DO WIN^XGF(MT,ML,MB,MR,$NAME(^TMP($JOB,"MENU")))
+14 SET $Y=MT
+15 FOR %=1:1:I
DO SAYU^XGF("+",ML+1,CHOICE(%))
+16 QUIT
+17 ;
GRID ;draw a grid
+1 NEW %,I
+2 ; X scale accross the top
+3 SET %=""
FOR I=0:1:IOM-1
SET %=%_$SELECT((I#10)=0:I/10,(I#5)=0:"+",1:"-")
+4 DO SAY^XGF(0,0,%)
+5 ; Y scale along the left
+6 FOR I=1:1:IOSL-1
SET %=$SELECT((I#10)=0:I/10,(I#5)=0:"+",1:"|")
DO SAY^XGF(I,0,%)
+7 ; grid of dots
+8 SET %=""
FOR I=5:5:IOM-1
SET %=%_" ."
+9 FOR I=5:5:IOSL
DO SAY^XGF(I,1,%)
+10 QUIT
WELCOME ;displays welcome text
+1 ;;The purpose of this demo is to
+2 ;;exercise different components of
+3 ;;the low level graphics functions
+4 SET NB=IOSL-3
SET NR=IOM-1
SET NT=NB-6
SET NL=NR-33
+5 DO SAVE^XGF(NT,NL,NB,NR,$NAME(^TMP($JOB,"NARRATIVE")))
+6 DO CLEAR^XGF(NT,NL,NB,NR)
DO CHGA^XGF("R1")
DO FRAME^XGF(NT,NL,NB,NR)
DO CHGA^XGF("R0")
+7 DO SAY^XGF(NT+1,NL+11,"W E L C O M E","U1B1")
+8 FOR I=1:1:3
SET S=$PIECE($TEXT(WELCOME+I),";;",2)
DO SAY^XGF(NT+I+1,NL+1,S)
+9 DO SAY^XGF(NB-1,NL+8,"RETURN","R1")
DO SAY^XGF("","+"," to continue")
+10 FOR
SET %=$$READ^XGF(1)
if XGRT="CR"
QUIT
+11 QUIT
