PROGRAM ELLIPSES
$NOTRUNCATE
$DECLARE
C$ABSTRACT
C; ELLIPSES -- PROGRAM TO GENERATE RANDOM FILLED ELLIPSES IN GRAPHICS MODE
C$DESCRIPTION
C; ELLIPSES generates random filled ellipses, in random colors. It keeps
C;this up "forever" (until killed by Control-Z).
C$AUTHOR
C; Written by E. Nicholas Cupery 10 AUG 89
C$MODIFICATION_HISTORY
C; No modifications yet
C$VERSION
C; v1.0
IMPLICIT NONE !MAKE SURE TO DECLARE 'EM ALL!!!
C$CALLING_SEQUENCE
C; Exempt, due to being a main program
C$INPUT_ARGUMENTS
C; Exempt, due to being a main program
C$OUTPUT_ARGUMENTS
C; Exempt, due to being a main program
C$INCLUDE_FILES
C;
C$LOCAL_PARAMETERS
C;
C$LOCAL_VARIABLES
C;
INTEGER*2 ADAPTYP !VIDEO ADAPTER TYPE (NOT USED)
INTEGER*2 BIOSTYP !BIOS VIDEO-TYPE (NOT USED)
INTEGER*2 BORDER !SIZE OF FORBIDDEN-ZONE FOR CENTERS
INTEGER*2 BOTTOM !DISTANCE FROM POINT'S CENTER TO BOTTOM
INTEGER*2 CHRCNT !COMMAND-LINE CHARACTER-COUNT
INTEGER*1 CMDBUF(128) !COMMAND-LINE BUFFER
INTEGER*2 COLOR !CURRENT DRAWING COLOR
INTEGER*2 LEFT !DISTANCE FROM POINT'S CENTER TO LEFT
REAL*4 FCOLOR !COLOR AS FLOATING-POINT
REAL*4 FRADIUS !FLOATING-POINT RADIUS
REAL*4 FX1 !FLOATING-POINT STARTING X-COORDINATE
REAL*4 FY1 !FLOATING-POINT STARTING Y-COORDINATE
INTEGER*2 HRES !HORIZONTAL RESOLUTION
INTEGER*2 MODE !FARBA VIDEO MODE DESIRED
INTEGER*2 MONITYP !VIDEO MONITOR TYPE (NOT USED)
INTEGER*2 MONOFLAG !"MONO-AVAILABLE" FLAG
INTEGER*2 NCOLORS !NUMBER OF COLORS
REAL*4 RANVAL !STORAGE FOR A RANDOM-NUMBER
INTEGER*2 RIGHT !DISTANCE FROM POINT'S CENTER TO RIGHT
INTEGER*2 SMALLEST !SMALLEST DISTANCE FROM POINT TO EDGE
INTEGER*2 STATUS !RETURNED STATUS FROM SUBROUTINE CALLS
INTEGER*2 TOP !DISTANCE FROM POINT'S CENTER TO TOP
INTEGER*2 XCENTER !X-COORDINATE OF CENTER OF ELLIPSE
REAL*4 XCMAX !MAXIMUM UNBIASED X-CENTER VALUE
INTEGER*2 XRADIUS !X-RADIUS OF ELLIPSE
INTEGER*2 YCENTER !Y-COORDINATE OF CENTER OF ELLIPSE
REAL*4 YCMAX !MAXIMUM UNBIASED Y-CENTER VALUE
INTEGER*2 YRADIUS !Y-RADIUS OF ELLIPSE
INTEGER*2 VRES !VERTICAL RESOLUTION
C$EXTERNAL_ROUTINES
C;
C$INDENT
C$BEGIN_EXECUTABLES
C
C GET THE COMMAND-LINE FROM DOS [GTCMLN_M]
CALL GTCMLN_M (CMDBUF,CHRCNT)
C
C IF THERE WAS NO COMMAND-LINE AT ALL
IF (CHRCNT .NE. 0) GO TO 20
C
C TELL OPERATOR WHAT IS NEEDED ON THE COMMAND-LINE
10 WRITE (*,15)
15 FORMAT(1X,'ELLIPSES -- Need mode-type on the command-line'//)
C
C BREAK -- EXIT IMMEDIATELY
GO TO 999
C
C ENDI
20 CONTINUE
C
C IF THE COMMAND-LINE CONTAINS MORE THAN ONE CHARACTER
IF (CHRCNT .EQ. 1) GO TO 30
C
C BREAK -- TELL OPERATOR WHAT IS NEEDED ON THE COMMAND-LINE
GO TO 10
C
C ENDI
30 CONTINUE
C
C IF THE COMMAND-LINE CHARACTER IS A DECIMAL DIGIT
IF (CMDBUF(1) .LT. 48 .OR. CMDBUF(1) .GT. 57) GO TO 40
C
C REMOVE THE ASCII BIAS FROM THE DECIMAL DIGIT
CMDBUF(1) = CMDBUF(1) - 48
C
C STORE THE MODE NUMBER IN A WORD
MODE = CMDBUF(1)
C
C ELSE
GO TO 50
40 CONTINUE
C
C BREAK -- TELL OPERATOR WHAT IS NEEDED ON THE COMMAND-LINE
GO TO 10
C
C ENDI
50 CONTINUE
C
C SEED THE RANDOM-NUMBER GENERATOR {SEED}
CALL SEED(3)
C
C ALLOW SIMULTANEOUS MONOCHROME SCREEN, IF IT EXISTS
MONOFLAG = 1 !ANYTHING BUT ZERO
C
C INITIALIZE THE VGA SUBSYSTEM {VGA_INIT_M}
CALL VGA_INIT_M (STATUS,ADAPTYP,MONITYP,MONOFLAG,BIOSTYP)
C
C IF ANY ERROR OCCURRED
IF (STATUS .EQ. 0) GO TO 60
C
C LOG THE ERROR FOR THE OPERATOR
WRITE (*,55) STATUS
55 FORMAT(' BAD VGA_INIT_M STATUS ',I2//)
C
C BREAK -- EXIT IMMEDIATELY
GO TO 999
C
C ENDI
60 CONTINUE
C
C SET THE DESIRED VIDEO MODE {VGA_MODE_M}
CALL VGA_MODE_M (MODE,0,13,STATUS,HRES,VRES,NCOLORS)
C
C IF ANY ERROR OCCURRED
IF (STATUS .EQ. 0) GO TO 70
C
C LOG THE ERROR FOR THE OPERATOR
WRITE (*,65) STATUS
65 FORMAT(' BAD VGA_MODE_M STATUS ',I2//)
C
C BREAK -- EXIT IMMEDIATELY
GO TO 999
C
C ENDI
70 CONTINUE
C
C PICK A BORDER VALUE
BORDER = 20
C
C CALCULATE MAXIMUM UNBIASED X-CENTER
XCMAX = HRES - (2*BORDER)
C
C CALCULATE MAXIMUM UNBIASED Y-CENTER
YCMAX = VRES - (2*BORDER)
C
C FOR EVER (UNTIL KILLED BY CONTROL-Z)
80 CONTINUE
C
C CHECK FOR ANY KEYBOARD PAUSES, ETC {KBDCHK_M}
CALL KBDCHK_M
C
C GET A RANDOM NUMBER {RANDOM}
CALL RANDOM(RANVAL)
C
C SET FLOATING-POINT COLOR TO NUMBER OF COLORS SUPPORTED
FCOLOR = NCOLORS
C
C MULTIPLY THE FLOATING-POINT COLOR BY THE RANDOM NUMBER
FCOLOR = FCOLOR * RANVAL
C
C TRUNCATE TO GET AN INTEGER COLOR IN RANGE 0 TO NCOLORS-1
COLOR = FCOLOR
C
C SET THE COLOR OF THE ELLIPSE {VGA_SET_COLOR_M}
CALL VGA_SET_COLOR_M (COLOR)
C
C GET ANOTHER RANDOM NUMBER {RANDOM}
CALL RANDOM(RANVAL)
C
C SET FLOATING-POINT UNBIASED X-CENTER TO THE MAXIMUM
FX1 = XCMAX
C
C MULTIPLY THE COORDINATE BY THE RANDOM NUMBER
FX1 = FX1 * RANVAL
C
C TRUNCATE TO GET AN INTEGER COORDINATE
XCENTER = FX1
C
C ADD THE BORDER BIAS TO THE X-CENTER
XCENTER = XCENTER + BORDER
C
C GET ANOTHER RANDOM NUMBER {RANDOM}
CALL RANDOM(RANVAL)
C
C SET FLOATING-POINT UNBIASED Y-CENTER TO THE MAXIMUM
FY1 = YCMAX
C
C MULTIPLY THE COORDINATE BY THE RANDOM NUMBER
FY1 = FY1 * RANVAL
C
C TRUNCATE TO GET AN INTEGER COORDINATE
YCENTER = FY1
C
C ADD THE BORDER BIAS TO THE Y-CENTER
YCENTER = YCENTER + BORDER
C
C GET ANOTHER RANDOM NUMBER FOR X-RADIUS {RANDOM}
CALL RANDOM(RANVAL)
C
C CALCULATE THE DISTANCE FROM THE POINT'S CENTER TO THE LEFT SIDE
LEFT = XCENTER
C
C CALCULATE THE DISTANCE FROM THE POINT'S CENTER TO THE RIGHT SIDE
RIGHT = HRES - XCENTER
C
C ASSUME THAT THE LEFT-DISTANCE IS THE SMALLEST
SMALLEST = LEFT
C
C IF THE RIGHT-DISTANCE IS SMALLER
IF (RIGHT .GE. SMALLEST) GO TO 90
C
C USE THE RIGHT DISTANCE INSTEAD
SMALLEST = RIGHT
C
C ENDI
90 CONTINUE
C
C MAKE THE SMALLEST A LITTLE SMALLER, SO CAN HAVE A MINIMUM RADIUS
SMALLEST = SMALLEST - 10
C
C SET THE FLOATING-POINT MAX RADIUS TO THE SMALLEST DISTANCE FROM AN EDGE
FRADIUS = SMALLEST
C
C MULTIPLY THE MAXIMUM RADIUS BY THE RANDOM NUMBER
FRADIUS = FRADIUS * RANVAL
C
C TRUNCATE TO GET AN INTEGER X-RADIUS
XRADIUS = FRADIUS
C
C ADD BACK THE MINIMUM RADIUS VALUE
XRADIUS = XRADIUS + 10
C
C GET ANOTHER RANDOM NUMBER FOR Y-RADIUS {RANDOM}
CALL RANDOM(RANVAL)
C
C CALCULATE THE DISTANCE FROM THE POINT'S CENTER TO THE TOP SIDE
TOP = VRES - YCENTER
C
C CALCULATE THE DISTANCE FROM THE POINT'S CENTER TO THE BOTTOM SIDE
BOTTOM = YCENTER
C
C ASSUME THAT THE TOP-DISTANCE IS THE SMALLEST
SMALLEST = TOP
C
C IF THE BOTTOM-DISTANCE IS SMALLER
IF (BOTTOM .GE. SMALLEST) GO TO 100
C
C USE THE BOTTOM DISTANCE INSTEAD
SMALLEST = BOTTOM
C
C ENDI
100 CONTINUE
C
C MAKE THE SMALLEST A LITTLE SMALLER, SO CAN HAVE A MINIMUM RADIUS
SMALLEST = SMALLEST - 10
C
C SET THE FLOATING-POINT MAX RADIUS TO THE SMALLEST DISTANCE FROM AN EDGE
FRADIUS = SMALLEST
C
C MULTIPLY THE MAXIMUM RADIUS BY THE RANDOM NUMBER
FRADIUS = FRADIUS * RANVAL
C
C TRUNCATE TO GET AN INTEGER Y-RADIUS
YRADIUS = FRADIUS
C
C ADD BACK THE MINIMUM RADIUS VALUE
YRADIUS = YRADIUS + 10
C
C DRAW ONE FILLED ELLIPSE {VGA_FILL_ELLIPSE_M}
CALL VGA_FILL_ELLIPSE_M(XCENTER,YCENTER,XRADIUS,YRADIUS)
C
C ENDF
200 GO TO 80
C
C
C
C
C
C RESTORE THE PREVIOUS VIDEO CONDITIONS {VGA_RESTORE_M}
CALL VGA_RESTORE_M (1)
C
C GO AWAY NOW [EXIT_M]
999 CALL EXIT_M (0)
C
C END OF PROGRAM
END