Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XGFDEMO

XGFDEMO.m

Go to the documentation of this file. 
  1. XGFDEMO ;SFISC/VYD - demonstrate graphics functions ;12/30/93  10:22 [ 04/02/2003   8:29 AM ]
  1.  ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
  1.  ;;8.0;KERNEL;;Jul 10, 1995
  1.  N NT,NL,NB,NR ;top,left,bottom,right for narrative window
  1.  N MT,ML,MB,MR ;top,left,bottom,right for menu window
  1.  N OLDCHOIC,NEWCHOIC,TAG,STOP,CHOICE
  1.  D PREP^XGF ;prepare environment for graphics functions
  1.  D GRID
  1.  D WELCOME
  1.  D MENU
  1.  S STOP=0
  1.  F  S %=$$CHOOSE() D  Q:STOP
  1.  .S TAG=$$UP^XLFSTR($TR($TR(CHOICE(%),"&","")," ",""))
  1.  .D @(TAG_"^XGFDEMO1") ;do the menu choice
  1.  D CLEAN^XGF K ^TMP($J)
  1.  Q
  1.  ;
  1. CHOOSE() ;choose a choice from the menu
  1.  ;;Use <UP ARROW> or <DOWN ARROW>
  1.  ;;or press a hot key of a choice
  1.  ;;
  1.  ;;Press <RETURN> to select.
  1.  N I,S,STOP
  1.  D CLEAR^XGF(NT+1,NL+1,NB-1,NR-1)
  1.  F I=1:1:4 S S=$P($T(CHOOSE+I),";;",2) D SAY^XGF(NT+I,NL+1,S)
  1.  I '$D(OLDCHOIC) S OLDCHOIC=2
  1.  S:'$D(NEWCHOIC) NEWCHOIC=1
  1.  S STOP=0
  1.  F  D  Q:STOP
  1.  .I NEWCHOIC'=OLDCHOIC D  ;another choice was selected
  1.  ..D SAYU^XGF(MT+OLDCHOIC,ML+1,CHOICE(OLDCHOIC),"E1")
  1.  ..D SAYU^XGF(MT+NEWCHOIC,ML+1,CHOICE(NEWCHOIC),"R1")
  1.  ..D SAY^XGF(IOSL-1,2,CHOICE(NEWCHOIC,1)_$J("",80))
  1.  ..S OLDCHOIC=NEWCHOIC
  1.  .S KEY=$$READ^XGF(1)
  1.  .I XGRT="CR" S STOP=1
  1.  .E  I $L(KEY),$D(CHOICE("HK",$$UP^XLFSTR(KEY))) S NEWCHOIC=CHOICE("HK",$$UP^XLFSTR(KEY))
  1.  .E  I XGRT="UP" S NEWCHOIC=$S($D(CHOICE(OLDCHOIC-1)):OLDCHOIC-1,1:$O(CHOICE("A"),-1))
  1.  .E  I XGRT="DOWN" S NEWCHOIC=$S($D(CHOICE(OLDCHOIC+1)):OLDCHOIC+1,1:$O(CHOICE("")))
  1.  Q NEWCHOIC
  1.  ;
  1.  ;;&Cursor;Cursor positioning
  1.  ;;&Attributes;Output text in different video attributes
  1.  ;;&Windows;Open overlapping pop-up windows and restore screen when closed
  1.  ;;&Keyboard;Experiment with the low level keyboard reader
  1.  ;;E&xit;Stop the demo
  1.  N I
  1.  F I=1:1 D  Q:CHOICE(I)["E&xit"
  1.  .S CHOICE(I)=$P($T(MENU+I),";",3)
  1.  .S CHOICE(I)=CHOICE(I)_$J("",11-$L(CHOICE(I)))
  1.  .S CHOICE(I,1)=$P($T(MENU+I),";",4)
  1.  .S CHOICE("HK",$$UP^XLFSTR($E($P(CHOICE(I),"&",2))))=I ;hot key x-ref
  1.  S MT=2,ML=2,MB=MT+I+1,MR=ML+11
  1.  D WIN^XGF(MT,ML,MB,MR,$NA(^TMP($J,"MENU")))
  1.  S $Y=MT
  1.  F %=1:1:I D SAYU^XGF("+",ML+1,CHOICE(%))
  1.  Q
  1.  ;
  1. GRID ;draw a grid
  1.  N %,I
  1.  ;   X scale accross the top
  1.  S %="" F I=0:1:IOM-1 S %=%_$S((I#10)=0:I/10,(I#5)=0:"+",1:"-")
  1.  D SAY^XGF(0,0,%)
  1.  ;   Y scale along the left
  1.  F I=1:1:IOSL-1 S %=$S((I#10)=0:I/10,(I#5)=0:"+",1:"|") D SAY^XGF(I,0,%)
  1.  ;   grid of dots
  1.  S %="" F I=5:5:IOM-1 S %=%_"    ."
  1.  F I=5:5:IOSL D SAY^XGF(I,1,%)
  1.  Q
  1. WELCOME ;displays welcome text
  1.  ;;The purpose of this demo is to
  1.  ;;exercise different components of
  1.  ;;the low level graphics functions
  1.  S NB=IOSL-3,NR=IOM-1,NT=NB-6,NL=NR-33
  1.  D SAVE^XGF(NT,NL,NB,NR,$NA(^TMP($J,"NARRATIVE")))
  1.  D CLEAR^XGF(NT,NL,NB,NR),CHGA^XGF("R1"),FRAME^XGF(NT,NL,NB,NR),CHGA^XGF("R0")
  1.  D SAY^XGF(NT+1,NL+11,"W E L C O M E","U1B1")
  1.  F I=1:1:3 S S=$P($T(WELCOME+I),";;",2) D SAY^XGF(NT+I+1,NL+1,S)
  1.  D SAY^XGF(NB-1,NL+8,"RETURN","R1"),SAY^XGF("","+"," to continue")
  1.  F  S %=$$READ^XGF(1) Q:XGRT="CR"
  1.  Q