source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XGFDEMO.m@ 703

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1XGFDEMO ;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 ;
17CHOOSE() ;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 ;
41MENU ;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 ;
59GRID ;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
70WELCOME ;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
Note: See TracBrowser for help on using the repository browser.