	PROGRAM SAODEMO
C
C  Note:  This is the UNIX version
C
C	This program demonstrates the control of SAOimage from a
C  standalone program.  We send colored dots, moving dots, various kinds
C  of cursors, several images, and manipulate the color look-up table.
C
C			Donald H. Gudehus, 1993
C			Version 1U, D. Gudehus, September, 1994
C			Changed code for UNIX
C			Version 2, D. Gudehus, August 29, 2006
C			Incorporated changes from saofacts.for
C			and put in call to GET_ENDIAN
C			Version 3, D. Gudehs, April 16, 2009
C			Removed MAXFB_COLS_SAO and MAXFB_ROWS_SAO from
C			argument list of SAODEMO_DYNAMIC1 since they are in
C			saofacts.for.
C
	INCLUDE 'saofacts.for' !  UNIX likes lower case
C
	INTEGER*4 ACTION,CURSOR_TYPE,COLOR_TYPE,ADDRESS1
	REAL INCLINA,EXTRA(6)
C
	CALL GET_ENDIAN
	IFB_SAO=0  ! Lets the user be prompted for the size of the buffer
C  Establish the buffer size
	CALL SAOSTART
C  Initialize SAOimage
	CALL SAOFIRST
C  Initialize the lookup table so that the background will be black
	IVAL='100'X
	CALL SAOCONVLT(IVAL)
C
C  Get some parameters set up.  Initially, we will only be concerned with
C  one picture
	NCOLS=MAXFB_COLS_SAO
	NROWS=MAXFB_ROWS_SAO
	NPIC_SAO=1 !  Pictures run from 1 to 16
	NFRAME_SAO=0 !  Frames run from 0 to 3.  Only one frame is supported
		     !  on SAOimage
C  Establish the starting location on the frame
	XLOC_SAO(NPIC_SAO)=0
	YLOC_SAO(NPIC_SAO)=MAXFB_ROWS_SAO-1
C  Establish the starting location in the array
	IMSX_SAO(NFRAME_SAO,NPIC_SAO)=1
	IMSY_SAO(NFRAME_SAO,NPIC_SAO)=1
C
C  Write random colored dots onto the display
C  Send a caption for the colored dots now that we have set up the parameters
	TV_FILENAME(NPIC_SAO)='Colored dots'
	CALL SAOCAPTION
C
	ISEED=12345
	NPIC1=NPIC_SAO
	DO K=1,600
	  IVAL=MOD(K,5)+203
	  IX=RAN(ISEED)*(NCOLS-1)+1
	  IY=RAN(ISEED)*(NROWS-1)+1
	  CALL SAODOT(IX,IY,NPIC1,IVAL) !  Map coordinates
	END DO
C  Send moving dots
C  Send the caption
	TV_FILENAME(NPIC_SAO)='Moving dots'
	CALL SAOCAPTION
C  Now send the dots
	DO K=1,400 !  Longer loop for Unix since it is faster than VMS
	  ILEN=2*NINT(25.0*RAN(ISEED))+20 !  Length of streak
	  IDELTA=2*NINT(16.0*RAN(ISEED))+4 !  Length of lighted portion
	  IDELTA=MIN(IDELTA,ILEN-4)
	  THETA=360.0*RAN(ISEED)
	  DELX=COSD(THETA)
	  DELY=SIND(THETA)
	  IX=(NCOLS-2*ILEN)*RAN(ISEED)+ILEN !  Starting X location
	  IY=(NROWS-2*ILEN)*RAN(ISEED)+ILEN !  Starting Y location
	  IVAL=NINT(4.0*RAN(ISEED))+203
	  DO N=0,ILEN+IDELTA,2
	    IF (N.LE.ILEN) THEN
	      IIX=IX+NINT(N*DELX)
	      IIY=IY+NINT(N*DELY)
	      IF (IIX.GE.1.AND.IIY.GE.1.AND.IIX.LE.NCOLS.AND.
	1     IIY.LE.NROWS) CALL SAODOT(IIX,IIY,NPIC1,IVAL)
	    END IF
	    IF (N.GE.IDELTA) THEN
	      IIX=IX+NINT((N-IDELTA)*DELX)
	      IIY=IY+NINT((N-IDELTA)*DELY)
	      IF (IIX.GE.1.AND.IIY.GE.1.AND.IIX.LE.NCOLS.AND.
	1     IIY.LE.NROWS) CALL SAODOT(IIX,IIY,NPIC1,208)
	    END IF
	  END DO
	END DO
C
C  Draw erasable circles and ellipses
C  Send the caption
	TV_FILENAME(NPIC_SAO)='Erasable circles and ellipses'
	CALL SAOCAPTION
	ACTION=1 !  Erasable cursor
	CURSOR_TYPE=1024 !  Circles and ellipses
	NPIC1=NPIC_SAO
	ISEED=12345
	DO K=1,34
	  COLOR_TYPE=MOD(K,5)+203
	  X=RAN(ISEED)*(NCOLS-2)+1.5
	  Y=RAN(ISEED)*(NROWS-2)+1.5
	  a=RAN(ISEED)*NROWS*0.1+1.0
	  b=RAN(ISEED)*NCOLS*0.1+1.0
	  INCLINA=RAN(ISEED)*360.0
	  EXTRA(1)=0.0
	  CALL SAO_DRAW(ACTION,CURSOR_TYPE,COLOR_TYPE,X,Y,NPIC1,
	1 a,b,INCLINA,EXTRA,0)
	  CALL DELAY(0.05)
	END DO
	CALL SAO_ERASE_CURSOR(0)
C  Display some annuli too
	TV_FILENAME(NPIC_SAO)='Erasable circular and elliptical annuli'
	CALL SAOCAPTION
	DO K=1,16
	  COLOR_TYPE=MOD(K,5)+203
	  X=RAN(ISEED)*(NCOLS-2)+1.5
	  Y=RAN(ISEED)*(NROWS-2)+1.5
	  a=RAN(ISEED)*NROWS*0.08+1.0
	  b=RAN(ISEED)*NCOLS*0.08+1.0
	  INCLINA=RAN(ISEED)*360.0
	  EXTRA(1)=a*1.8
	  EXTRA(2)=a*2.5
	  EXTRA(3)=a*3.0
	  EXTRA(4)=a*3.4
	  EXTRA(5)=a*3.8
	  EXTRA(6)=a*4.1
	  NEXTRA=NINT(RAN(ISEED)*5.0)+1
	  CALL SAO_DRAW(ACTION,CURSOR_TYPE,COLOR_TYPE,X,Y,NPIC1,
	1 a,b,INCLINA,EXTRA,NEXTRA)
	  CALL DELAY(0.05)
	END DO
C  Pause to view
	DO I=1,100
	  IVAL='100'X
	  CALL SAOCONVLT(IVAL)
	END DO
C  Erase circle cursors
	CALL SAO_ERASE_CURSOR(0)
C
C  Draw circle cursor regions
C  Send the caption
	TV_FILENAME(NPIC_SAO)='Erasable circle regions'
	CALL SAOCAPTION
	INCLINA=0.0
	ACTION=11 !  Erasable region cursor
	DO K=1,25
	  COLOR_TYPE=MOD(K,5)+203
	  X=RAN(ISEED)*(NCOLS-40)+20.0
	  Y=RAN(ISEED)*(NROWS-40)+20.0
	  a=RAN(ISEED)*MAX(60.0,NCOLS*0.1)+1.0
	  b=RAN(ISEED)*MAX(60.0,NROWS*0.1)+1.0
	  CALL SAO_DRAW(ACTION,CURSOR_TYPE,COLOR_TYPE,X,Y,NPIC1,
	1 a,b,INCLINA,EXTRA,0)
	  CALL DELAY(0.05)
	END DO
C  Pause to view
	DO I=1,100
	  IVAL='100'X
	  CALL SAOCONVLT(IVAL)
	END DO
C  Erase circle cursor regions
	CALL SAO_ERASE_CURSOR(1)
C
C  Draw some nonerasable circles and ellipse
C  Send the caption
	TV_FILENAME(NPIC_SAO)='Nonerasable circles and ellipses'
	CALL SAOCAPTION	
C
	ACTION=2 !  Nonerasable cursor
	DO K=1,15
	  COLOR_TYPE=MOD(K,5)+203
	  X=RAN(ISEED)*(NCOLS-2)+1.5
	  Y=RAN(ISEED)*(NROWS-2)+1.5
	  a=RAN(ISEED)*NCOLS*0.1+1.0
	  b=RAN(ISEED)*NROWS*0.1+1.0
	  CALL SAO_DRAW(ACTION,CURSOR_TYPE,COLOR_TYPE,X,Y,NPIC1,
	1 a,b,INCLINA,EXTRA,0)
	  CALL DELAY(0.05)
	END DO
C
C  Draw erasable rectangles
C
C  Send the caption
	TV_FILENAME(NPIC_SAO)='Erasable rectangles'
	CALL SAOCAPTION
C
	ACTION=1 !  Erasable cursor
	CURSOR_TYPE=768 !  Rectangle
	NPIC1=NPIC_SAO
	DO K=1,30
	  COLOR_TYPE=MOD(K,5)+203
	  X=RAN(ISEED)*(NCOLS-2)+2
	  Y=RAN(ISEED)*(NROWS-2)+2
	  a=RAN(ISEED)*NCOLS*0.1+1.0
	  b=RAN(ISEED)*NROWS*0.1+1.0
	  INCLINA=RAN(ISEED)*360.0
	  CALL SAO_DRAW(ACTION,CURSOR_TYPE,COLOR_TYPE,X,Y,NPIC1,
	1 a,b,INCLINA,EXTRA,0)
	  CALL DELAY(0.05)
	END DO
C  Erase rectangle cursor
	CALL SAO_ERASE_CURSOR(0)
C
C  Draw some erasable rectangle regions
C  Send the caption
	TV_FILENAME(NPIC)='Erasable rectangle regions'
	CALL SAOCAPTION
C
	INCLINA=0.0
	ACTION=11 !  Erasable region cursor
	DO K=1,25
	  COLOR_TYPE=MOD(K,5)+203
	  X=RAN(ISEED)*(NCOLS-2)+2
	  Y=RAN(ISEED)*(NROWS-2)+2
	  a=RAN(ISEED)*NCOLS*0.1+1.0
	  b=RAN(ISEED)*NROWS*0.1+1.0
	  CALL SAO_DRAW(ACTION,CURSOR_TYPE,COLOR_TYPE,X,Y,NPIC1,
	1 a,b,INCLINA,EXTRA,0)
	  CALL DELAY(0.05)
	END DO
C  Pause to view 
	DO I=1,100
	  IVAL='100'X
	  CALL SAOCONVLT(IVAL)
	END DO
C  Erase rectangle cursor
	CALL SAO_ERASE_CURSOR(1)
C
C  Draw some nonerasable rectangles
C  Send the caption
	TV_FILENAME(NPIC_SAO)='Nonerasable rectangles'
	CALL SAOCAPTION
C
	ACTION=2 !  Nonerasable cursor
	DO K=1,80
	  COLOR_TYPE=MOD(K,5)+203
	  X=RAN(ISEED)*(NCOLS-2)+2
	  Y=RAN(ISEED)*(NROWS-2)+2
	  a=RAN(ISEED)*NCOLS*0.1
	  b=RAN(ISEED)*NROWS*0.1
	  CALL SAO_DRAW(ACTION,CURSOR_TYPE,COLOR_TYPE,X,Y,NPIC1,
	1 a,b,INCLINA,EXTRA,0)
	  CALL DELAY(0.05)
	END DO
C
C  Draw a picture in each quadrant of the frame buffer.
C  The upper left corner of the frame buffer, given by XLOC, YLOC is at
C  0, 0.
	IVAL='100'X
	CALL SAOCONVLT(IVAL)
C  Because we do not know ahead of time what size the array should be
C  (since that is chosen by the user when the program is run) we need
C  to use dynamic memory.  Somewhat smoother loading of the image on the
C  screen of SAOimage can be attained by putting the code for SAOLOAD 
C  here and avoiding subroutine calls and dynamic memory, but this 
C  arrangement is easier to use and understand.
	NCOLS=MAXFB_COLS_SAO/2 !  4 pictures in the frame buffer
	NROWS=MAXFB_ROWS_SAO/2
	LENGTH1=NCOLS*NROWS
	CALL DYNAMIC(ADDRESS1,LENGTH1,'  R4',.TRUE.)
	CALL SAODEMO_DYNAMIC1(%VAL(ADDRESS1),NCOLS,NROWS)
	CALL DYNAMIC(ADDRESS1,LENGTH1,'  R4',.FALSE.)
C
C  Change the color LUT
C  Send the caption
	TV_FILENAME(NPIC_SAO)='Color look-up table'
	CALL SAOCAPTION
C
	DO K=1,2
	  IF (K.EQ.1) TIME=1.0
C  First slowly
	  IF (K.EQ.2) TIME=0.2
C  Then fast
	  DO J=1,11
	    IF (J.EQ.1) IVAL='100'X
	    IF (J.EQ.2) IVAL='200'X
	    IF (J.EQ.3) IVAL='300'X
	    IF (J.EQ.4) IVAL='400'X
	    IF (J.EQ.5) IVAL='500'X
	    IF (J.EQ.6) IVAL='600'X
	    IF (J.EQ.7) IVAL='700'X
	    IF (J.EQ.8) IVAL='800'X
	    IF (J.EQ.9) IVAL='900'X
	    IF (J.EQ.10) IVAL='A00'X
	    IF (J.EQ.11) IVAL='B00'X
	    CALL SAOCONVLT(IVAL)
	    CALL DELAY(TIME)
	  END DO
	END DO
	IVAL='800'X
	CALL SAOCONVLT(IVAL)
	END
C
	SUBROUTINE SAODEMO_DYNAMIC1(ARRAY,NCOLS,NROWS)
C
	DIMENSION ARRAY(NCOLS,NROWS)
C
C	This subroutine helps SAODEMO when dynamic memory is needed
C  to create room for ARRAY.
C
C			Donald H. Gudehus, July, 1994
C			Version 2, D. Gudehus,  April 16
C			Removed MAXFB_COLS_SAO and MAXFB_ROWS_SAO from
C			argument list of SAODEMO_DYNAMIC1 since they are in
C			saofacts.for.
C
	INCLUDE 'saofacts.for'
C
	CHARACTER*40 CAPTION
C  The lower left corner of each data array is considered to be at 1, 1.
	IMIN=1
	JMIN=1
	IMAX=NCOLS
	JMAX=NROWS
	BRIGHTNESS_MIN=-1000.0
	BRIGHTNESS_MAX=1000.0
	MODE=1
	DO NPICTURE=1,4
	  IF (NPICTURE.EQ.1) THEN
	    IXLOC=MAXFB_COLS_SAO/2
	    IYLOC=MAXFB_ROWS_SAO/2-1
	    DO J=JMIN,JMAX
	      DO I=IMIN,IMAX
	        ARRAY(I,J)=1000.0*COSD(I*360.0/IMAX)
	      END DO
	    END DO
	    CAPTION='First picture'
	    CALL SAOLOAD(ARRAY,NCOLS,NROWS,IXLOC,IYLOC,BRIGHTNESS_MIN,
	1   BRIGHTNESS_MAX,CAPTION,NPICTURE,MODE)
	  ELSE IF (NPICTURE.EQ.2) THEN
	    IXLOC=MAXFB_COLS_SAO/2
	    IYLOC=MAXFB_ROWS_SAO-1
	    DO J=JMIN,JMAX
	      DO I=IMIN,IMAX
	        ARRAY(I,J)=1000.0*COSD(J*360.0/IMAX)
	      END DO
	    END DO
	    CAPTION='Second picture'
	    CALL SAOLOAD(ARRAY,NCOLS,NROWS,IXLOC,IYLOC,BRIGHTNESS_MIN,
	1   BRIGHTNESS_MAX,CAPTION,NPICTURE,MODE)
	  ELSE IF (NPICTURE.EQ.3) THEN
	    IXLOC=0
	    IYLOC=MAXFB_ROWS_SAO-1
	    DO J=JMIN,JMAX
	      DO I=IMIN,IMAX
	        ARRAY(I,J)=1000.0*COSD((I+J)*360.0/IMAX)
	      END DO
	    END DO
	    CAPTION='Third picture'
	    CALL SAOLOAD(ARRAY,NCOLS,NROWS,IXLOC,IYLOC,BRIGHTNESS_MIN,
	1   BRIGHTNESS_MAX,CAPTION,NPICTURE,MODE)
	  ELSE IF (NPICTURE.EQ.4) THEN
	    IXLOC=0
	    IYLOC=MAXFB_ROWS_SAO/2-1
	    DO J=JMIN,JMAX
	      DO I=IMIN,IMAX
	        ARRAY(I,J)=1000.0*COSD((I-J)*720.0/IMAX)
	      END DO
	    END DO
	    CAPTION='Fourth picture'
	    CALL SAOLOAD(ARRAY,NCOLS,NROWS,IXLOC,IYLOC,BRIGHTNESS_MIN,
	1   BRIGHTNESS_MAX,CAPTION,NPICTURE,MODE)
	  END IF
	END DO
	RETURN
	END
