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