| 1 | XGFDEMO ;SFISC/VYD - demonstrate graphics functions ;12/30/93 10:22
|
|---|
| 2 | ;;8.0;KERNEL;;Jul 10, 1995
|
|---|
| 3 | N NT,NL,NB,NR ;top,left,bottom,right for narrative window
|
|---|
| 4 | N MT,ML,MB,MR ;top,left,bottom,right for menu window
|
|---|
| 5 | N OLDCHOIC,NEWCHOIC,TAG,STOP,CHOICE
|
|---|
| 6 | D PREP^XGF ;prepare environment for graphics functions
|
|---|
| 7 | D GRID
|
|---|
| 8 | D WELCOME
|
|---|
| 9 | D MENU
|
|---|
| 10 | S STOP=0
|
|---|
| 11 | F S %=$$CHOOSE() D Q:STOP
|
|---|
| 12 | .S TAG=$$UP^XLFSTR($TR($TR(CHOICE(%),"&","")," ",""))
|
|---|
| 13 | .D @(TAG_"^XGFDEMO1") ;do the menu choice
|
|---|
| 14 | D CLEAN^XGF K ^TMP($J)
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | CHOOSE() ;choose a choice from the menu
|
|---|
| 18 | ;;Use <UP ARROW> or <DOWN ARROW>
|
|---|
| 19 | ;;or press a hot key of a choice
|
|---|
| 20 | ;;
|
|---|
| 21 | ;;Press <RETURN> to select.
|
|---|
| 22 | N I,S,STOP
|
|---|
| 23 | D CLEAR^XGF(NT+1,NL+1,NB-1,NR-1)
|
|---|
| 24 | F I=1:1:4 S S=$P($T(CHOOSE+I),";;",2) D SAY^XGF(NT+I,NL+1,S)
|
|---|
| 25 | I '$D(OLDCHOIC) S OLDCHOIC=2
|
|---|
| 26 | S:'$D(NEWCHOIC) NEWCHOIC=1
|
|---|
| 27 | S STOP=0
|
|---|
| 28 | F D Q:STOP
|
|---|
| 29 | .I NEWCHOIC'=OLDCHOIC D ;another choice was selected
|
|---|
| 30 | ..D SAYU^XGF(MT+OLDCHOIC,ML+1,CHOICE(OLDCHOIC),"E1")
|
|---|
| 31 | ..D SAYU^XGF(MT+NEWCHOIC,ML+1,CHOICE(NEWCHOIC),"R1")
|
|---|
| 32 | ..D SAY^XGF(IOSL-1,2,CHOICE(NEWCHOIC,1)_$J("",80))
|
|---|
| 33 | ..S OLDCHOIC=NEWCHOIC
|
|---|
| 34 | .S KEY=$$READ^XGF(1)
|
|---|
| 35 | .I XGRT="CR" S STOP=1
|
|---|
| 36 | .E I $L(KEY),$D(CHOICE("HK",$$UP^XLFSTR(KEY))) S NEWCHOIC=CHOICE("HK",$$UP^XLFSTR(KEY))
|
|---|
| 37 | .E I XGRT="UP" S NEWCHOIC=$S($D(CHOICE(OLDCHOIC-1)):OLDCHOIC-1,1:$O(CHOICE("A"),-1))
|
|---|
| 38 | .E I XGRT="DOWN" S NEWCHOIC=$S($D(CHOICE(OLDCHOIC+1)):OLDCHOIC+1,1:$O(CHOICE("")))
|
|---|
| 39 | Q NEWCHOIC
|
|---|
| 40 | ;
|
|---|
| 41 | MENU ;main menu
|
|---|
| 42 | ;;&Cursor;Cursor positioning
|
|---|
| 43 | ;;&Attributes;Output text in different video attributes
|
|---|
| 44 | ;;&Windows;Open overlapping pop-up windows and restore screen when closed
|
|---|
| 45 | ;;&Keyboard;Experiment with the low level keyboard reader
|
|---|
| 46 | ;;E&xit;Stop the demo
|
|---|
| 47 | N I
|
|---|
| 48 | F I=1:1 D Q:CHOICE(I)["E&xit"
|
|---|
| 49 | .S CHOICE(I)=$P($T(MENU+I),";",3)
|
|---|
| 50 | .S CHOICE(I)=CHOICE(I)_$J("",11-$L(CHOICE(I)))
|
|---|
| 51 | .S CHOICE(I,1)=$P($T(MENU+I),";",4)
|
|---|
| 52 | .S CHOICE("HK",$$UP^XLFSTR($E($P(CHOICE(I),"&",2))))=I ;hot key x-ref
|
|---|
| 53 | S MT=2,ML=2,MB=MT+I+1,MR=ML+11
|
|---|
| 54 | D WIN^XGF(MT,ML,MB,MR,$NA(^TMP($J,"MENU")))
|
|---|
| 55 | S $Y=MT
|
|---|
| 56 | F %=1:1:I D SAYU^XGF("+",ML+1,CHOICE(%))
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | GRID ;draw a grid
|
|---|
| 60 | N %,I
|
|---|
| 61 | ; X scale accross the top
|
|---|
| 62 | S %="" F I=0:1:IOM-1 S %=%_$S((I#10)=0:I/10,(I#5)=0:"+",1:"-")
|
|---|
| 63 | D SAY^XGF(0,0,%)
|
|---|
| 64 | ; Y scale along the left
|
|---|
| 65 | F I=1:1:IOSL-1 S %=$S((I#10)=0:I/10,(I#5)=0:"+",1:"|") D SAY^XGF(I,0,%)
|
|---|
| 66 | ; grid of dots
|
|---|
| 67 | S %="" F I=5:5:IOM-1 S %=%_" ."
|
|---|
| 68 | F I=5:5:IOSL D SAY^XGF(I,1,%)
|
|---|
| 69 | Q
|
|---|
| 70 | WELCOME ;displays welcome text
|
|---|
| 71 | ;;The purpose of this demo is to
|
|---|
| 72 | ;;exercise different components of
|
|---|
| 73 | ;;the low level graphics functions
|
|---|
| 74 | S NB=IOSL-3,NR=IOM-1,NT=NB-6,NL=NR-33
|
|---|
| 75 | D SAVE^XGF(NT,NL,NB,NR,$NA(^TMP($J,"NARRATIVE")))
|
|---|
| 76 | D CLEAR^XGF(NT,NL,NB,NR),CHGA^XGF("R1"),FRAME^XGF(NT,NL,NB,NR),CHGA^XGF("R0")
|
|---|
| 77 | D SAY^XGF(NT+1,NL+11,"W E L C O M E","U1B1")
|
|---|
| 78 | F I=1:1:3 S S=$P($T(WELCOME+I),";;",2) D SAY^XGF(NT+I+1,NL+1,S)
|
|---|
| 79 | D SAY^XGF(NB-1,NL+8,"RETURN","R1"),SAY^XGF("","+"," to continue")
|
|---|
| 80 | F S %=$$READ^XGF(1) Q:XGRT="CR"
|
|---|
| 81 | Q
|
|---|
