DELMAR, named after the race track in California, is a horse race simulation, originally written by Ron Morgan and Kirk Roderick in FORTRAN IV (1974), and published in David H. Ahl’s book The Best of Creative Computing Volume 2 (1977). This program is a faithful port to FORTRAN 77.
Up to five players select a horse and the amount to bet. The program ends once the players blow the bank or go bankrupt. There is also a time limit of 28 minutes.
Five subroutines are called by the program which are directly taken from the FORTRAN IV version:
CALL BANKER()CALL BET()CALL ODDS()CALL PICKS()CALL RACE()The following procedures are not part of the ANSI FORTRAN 77 language standard and have to be provided additionally:
RESULT = TIME()INTEGER). Required for the
initialisation of the pseudo-random number generator.RESULT = RAND(I)REAL).CALL SRAND(ISEED)INTEGER).CALL SLEEP(TIME)INTEGER).Most modern compilers expose these through extensions. The FORTRAN IV
implementation just used a busy loop instead of SLEEP(). The
call may be removed if the subroutine is not provided by the compiler.
Copy the program code to file delmar.f.
C ******************************************************************
C
C DELMAR - HORSE RACE GAME
C
C THE PROGRAM LISTING WAS PUBLISHED IN DAVID H. AHL'S BOOK "THE
C BEST OF CREATIVE COMPUTING VOLUME 2" (1977). THE FORTRAN IV
C SOURCE HAS BEEN FAITHFULLY CONVERTED TO FORTRAN 77 BY PHILIPP
C ENGEL IN 2021.
C
C USED FORTRAN EXTENSIONS:
C
C RAND - RETURNS RANDOM NUMBER.
C SLEEP - HALTS PROGRAM FOR GIVEN AMOUNT OF SECONDS.
C SRAND - INITIALISES RANDOM NUMBER GENERATOR.
C TIME - RETURNS CURRENT TIME IN SECONDS.
C
C ORIGINAL DESCRIPTION
C
C THIS PROGRAM SIMULATES A HORSE RACE STRICTLY USING THE RANDOM
C FUNCTION.
C
C BY RON MORGAN, KIRK RODERICK 12/02/74
C CSUN 18111 NORDHOFF STREET, NORTHRIDGE CA 91324
C THE DOUBLE PRECISION REALS, HORSE AND JOCK, CAN HOLD A MAXIMUM
C OF 16 ALPHA-NUMERIC CHARACTERS. THE COMMON BLOCKS REFER TO EACH
C OF THE SUBROUTINES WHICH ACCESS THEM.
C
C HORSE AND JOCK ARE DOUBLE PRECISION REAL ARRAYS THAT WILL HOLD
C THE NAMES OF THE HORSES AND JOCKES. IHAND CONTAINS THE HANDICAP
C THAT THE HORSES WILL START AWAY FROM THE FINISH LINE (FROM 1
C TO 20). IODD IS THE ODDS (-1) THAT WILL BE PRINTED OUT (DIVIDES
C 40). IHORSE AND IMT CONTAIN THE HORSE NUMBER AND AMOUNT FOR
C EACH PLAYER'S BET. IPLAY IS THE NUMBER OF PLAYERS (1-5). IBANK
C CONTAINS THE AMOUNT OF MONEY EACH PLAYER HAS LEFT (INITIALIZED
C TO 100). IWIN IS THE NUMBER OF THE WINNING HORSE.
C
C ******************************************************************
PROGRAM DELMAR
EXTERNAL BANKER, BETS, ODDS, PICKS, RACE
CHARACTER*16 HORSE(5), JOCK(5)
INTEGER IHAND(5), IODD(5)
INTEGER IHORSE(5), IMT(5), IPLAY, IBANK(5), IWIN
COMMON /HORSEY/ HORSE, JOCK
COMMON /NUMODD/ IHAND, IODD
COMMON /BET/ IHORSE, IMT, IPLAY, IBANK, IWIN
CHARACTER*3 ANS
INTEGER I, IMINS, ISTAT, MINS
LOGICAL FLAG
CALL SRAND(TIME())
MINS = TIME() / 60
IMINS = MINS
FLAG = .FALSE.
PRINT 100
100 FORMAT (30X,'DELMAR',/,/,5X,'PROGRAM SIMULATES A HORSE RACE BY',
&' USE OF THE RANDOM FUNCTION',/,/,
&' DO YOU WANT INSTRUCTIONS? ',$)
1 READ (*, 200, IOSTAT=ISTAT) ANS
200 FORMAT (A3)
IF (ANS(1:1) .EQ. 'N' .OR. ANS(1:1) .EQ. 'n') GOTO 3
IF (ANS(1:1) .EQ. 'Y' .OR. ANS(1:1) .EQ. 'y') GOTO 2
GOTO 1
2 PRINT 300
300 FORMAT (/,' THIS IS A SIMULATED HORSE RACE. THERE ARE 20 HORSES',
&' AND JOCKEYS IN',/,' THE STABLE. YOU START OUT WITH $100. ',
&' ONLY WHOLE NUMBER AMOUNTS ARE',/,' ALLOWED IN BETS (I.E. 100',
&' NOT 100.00). THERE IS A MAXIMUM OF 5',/,' PLAYERS. THE',
&' HORSES AND JOCKEYS FOR EACH RACE ARE PICKED RANDOMLY',/,' AS',
&' ARE THE ODDS AND THE ACTUAL RACE. HOWEVER, THE ODDS DO HAVE',
&' A',/,' WEIGHT (OR HANDICAP) IN THE OUTCOME OF THE RACE.',/)
3 PRINT 400
400 FORMAT (' HOW MANY PLAYERS? ',$)
READ (*, 500, IOSTAT=ISTAT) IPLAY
500 FORMAT (I1)
IF (IPLAY .LE. 5 .AND. IPLAY .GT. 0) GOTO 4
PRINT *, 'TOO MANY PLAYERS. MAXIMUM OF 5.'
GOTO 3
4 DO 10 I = 1, IPLAY
IBANK(I) = 100
10 CONTINUE
5 DO 20 I = 1, 5
IHORSE(I) = 0
IMT(I) = 0
IODD(I) = 0
IHAND(I) = 0
HORSE(I) = ' '
JOCK(I) = ' '
20 CONTINUE
CALL PICKS()
CALL ODDS()
CALL BETS()
CALL RACE()
CALL BANKER()
IF (FLAG) STOP
PRINT 600
600 FORMAT (' DO YOU WANT ANOTHER RACE? ',$)
6 READ (*, 200, IOSTAT=ISTAT) ANS
IF (ANS(1:1) .EQ. 'Y' .OR. ANS(1:1) .EQ. 'y') GOTO 7
IF (ANS(1:1) .EQ. 'N' .OR. ANS(1:1) .EQ. 'n') STOP
PRINT 700
700 FORMAT (' PLEASE ANSWER YES OR NO. ',$)
GOTO 6
7 MINS = (TIME() / 60) - 28
IF (IMINS .GT. MINS) GOTO 5
PRINT *, 'THIS IS YOUR LAST RACE.'
FLAG = .TRUE.
GOTO 5
END
C ******************************************************************
SUBROUTINE BANKER()
C
C THIS SUBROUTINE KEEPS A RECORD OF WINS AND LOSSES.
C
C THE BANK TOTALS ARE DETERMINED BY WHETHER THE PLAYER CHOSE THE
C WINNER. IF A BANK BALANCE BECOMES GREATER THAN 9999 THE PROGRAM
C ENDS AND PRINTS OUT A MESSAGE, OR IF ALL THE PLAYERS RUN OUT OF
C MONEY ANOTHER MESSAGE IS PRINTED OUT.
C
INTEGER IHAND(5), IODD(5)
INTEGER IHORSE(5), IMT(5), IPLAY, IBANK(5), IWIN
COMMON /NUMODD/ IHAND, IODD
COMMON /BET/ IHORSE, IMT, IPLAY, IBANK, IWIN
INTEGER I, I1, I2
LOGICAL FLAG
PRINT 100, IWIN
100 FORMAT (/,' HORSE #',I1,' WON.',/,' HERE ARE YOUR BANK BALANCES:')
I1 = 0
I2 = 0
FLAG = .FALSE.
DO 10 I = 1, IPLAY
IF (IHORSE(I) .EQ. IWIN) THEN
IBANK(I) = IBANK(I) + IMT(I) * IODD(IWIN)
ELSE
IBANK(I) = IBANK(I) - IMT(I)
END IF
PRINT 200, I, IBANK(I)
200 FORMAT (/,' PLAYER #',I1,' $',I4)
IF (IBANK(I) .GT. 9999) FLAG = .TRUE.
IF (IBANK(I) .LE. 0) I2 = I2 + 1
10 CONTINUE
IF (FLAG) THEN
PRINT *, 'YOU HAVE BROKEN THE BANK!!'
STOP
END IF
IF (I2 .GE. IPLAY) THEN
PRINT *, 'YOU ALL RAN OUT OF MONEY. PLEASE PAY THE CASHIER'
PRINT *, 'WHEN YOU EXIT. THANK YOU.'
STOP
END IF
END
C ******************************************************************
SUBROUTINE BETS()
C
C SUBROUTINE FOR TAKING BETS.
C
C IF THE PLAYER DIES NOT HAVE ANY MORE MONEY (IBANK = 0) THEN THAT
C PLAYER DIES NOT GET A CHANGE TO BET AND THE AMOUNT OF THE BET IS
C PUT TO 0 (IMT = 0).
C
CHARACTER*16 HORSE(5), JOCK(5)
INTEGER IHAND(5), IODD(5)
INTEGER IHORSE(5), IMT(5), IPLAY, IBANK(5), IWIN
COMMON /HORSEY/ HORSE, JOCK
COMMON /NUMODD/ IHAND, IODD
COMMON /BET/ IHORSE, IMT, IPLAY, IBANK, IWIN
INTEGER I, ISTAT
PRINT 100
100 FORMAT (/,/,/,2X,'#',4X,'HORSE',14X,'JOCKEY',22X,'ODDS',/)
DO 10 I = 1, 5
PRINT 200, I, HORSE(I), JOCK(I), IODD(I)
200 FORMAT (1X,'(',I1,')',3X,A16,3X,A16,12X,I2,'-1')
10 CONTINUE
PRINT 300
300 FORMAT (/,/,/,' TYPE THE NUMBER OF THE HORSE,',
&' THE AMOUNT OF THE BET.')
DO 20 I = 1, IPLAY
IF (IBANK(I) .LE. 0) GOTO 3
1 PRINT 400, I
400 FORMAT(/,' PLAYER #',I1,': ',$)
READ (*, *, IOSTAT=ISTAT) IHORSE(I), IMT(I)
IF (ISTAT .EQ. 0 .AND. IHORSE(I) .LE. 5 .AND. IHORSE(I) .GT. 0)
& GOTO 2
PRINT *, 'NO SUCH HORSE #.'
GOTO 1
2 IF (IMT(I) .LE. IBANK(I) .OR. IMT (I) .LT. 0) GOTO 20
PRINT *, 'YOU DON''T HAVE THAT MUCH MONEY. ',
&' ENTER HORSE # AND BET.'
GOTO 1
3 IMT(I) = 0
20 CONTINUE
END
C ******************************************************************
SUBROUTINE ODDS()
C
C SUBROUTINE FOR DETERMINING ODDS
C
C THE ODDS ARE DETERMINED BY HAVING 40 DIVIDED BY THE HANDICAP.
C THIS PRODUCES THE ODDS FROM 2-1 TO 40-1.
C
INTEGER IHAND(5), IODD(5)
COMMON /NUMODD/ IHAND, IODD
INTEGER I
DO 10 I = 1, 5
IHAND(I) = 1 + INT(RAND(0) * 20)
IODD(I) = 40 / IHAND(I)
10 CONTINUE
END
C ******************************************************************
SUBROUTINE PICKS()
C
C SUBROUTINE FOR PICKING HORSES AND JOCKEYS.
C
C IN THE FORTRAN IV VERSION, THE STRINGS WERE STORED AS HOLLERITH
C CONSTANTS IN DOUBLE PRECISION ARRAYS, BUT HAVE BEEN CONVERTED TO
C CHARACTER ARRAYS HERE. THE RANDOM NUMBER GENERATOR HAS BEEN
C REPLACED WITH THE RAND() EXTENSION THAT IS SUPPORTED BY MOST
C FORTRAN 77 COMPILERS.
C
C ORIGINAL DESCRIPTION OF THE RANDOM NUMBER GENERATOR
C
C -- RANDOM FUNCTION
C
C THE RANDOM FUNCTION RETURNS A PSEUDO-RANDOM NUMBER, R, WHERE
C 0 <= R < 1. THERE ARE TWO MODES AVAILABLE: REPRODUCIBLE
C AND NON-REPRODUCIBLE. THE ARGUMENT SELECTS THE MODE.
C
C MODE OF MODE OF
C NAME FUNCTION ARGUMENT RESULT
C
C RANDOM(I) NEXT PSEUDO-RANDOM VALUE INTEGER REAL
C
C IF I IS NEGATIVE, THE GENERATOR IS SET BACK TO THE BEGINNING OF
C ITS REPRODUCIBLE SEQUENCE. THE RESULT, R, WILL BE THE SAME AS
C THE FIRST TIME RANDOM IS CALLED AFTER lOADING. IF I IS ZERO, THE
C NEXT NUMBER IN THE REPRODUCIBLE SEQUENCE IS RETURNED AS THE
C RESULT. IF I IS GREATER THAN ZERO, AN INDEFINITE NUMBER (FROM 0
C TO 63) OF THE NEXT SEQUENTIAL INTERMEDIATE 12-BIT VALUES ARE
C SKIPPED BEFORE THE RANDOM NUMBER IS CONSTRUCTED. THE NUMBER OF
C VALUES SKIPPED IS DETERMINED BY THE LEAST SIGNIFICANT PORTION OF
C THE CURRENT VALUE OF THE REAL-TIME CLOCK IN THE COMPUTER.
C
C THE RANDOM NUMBERS ARE CONSTRUCTED FROM THREE 12-BIT GROUPS
C CALCULATED FROM 3**(2*N+1) (MOD 2**39), USING THE LEFT-MOST
C 12-BITS.
C
C J AND L ARE THE NUMBERS THAT ARE CHOSEN RANDOMLY THAT CONTROL THE
C HORSE(J) AND JOCKEY(L) THAT ARE CHOSEN. H AND JO ARE DEFINED IN
C DATA AS THE HORSES(H) AND JOCKEYS(J0). THE CHECK TO SEE IF THE
C HORSE (OR JOCKEY) WAS ALREADY CHOSEN STARTS AT 90.
C
CHARACTER*16 HORSE(5), JOCK(5), H(20), JO(20)
COMMON /HORSEY/ HORSE, JOCK
INTEGER I, I2
INTEGER J(5), L(5)
DATA H /'ACK ACK', 'OVERGLORY',
&'TIMETOLIGHT', 'GOLDEN WALLET', 'RAVISHING RUBY',
&'RED RUNNING GOOD', 'ACROCYANOSIS', 'NADINE MALCOLM',
&'WHOOPEE', 'SHAMALEEN', 'MISS ALERT',
&'COMMAND PRINCE', 'IRONSIDE', 'WILD SURF',
&'CANNONERO II', 'DAMAGE CONTROL', 'SHIEX KAMIAKIN',
&'AUDACITY', 'COURT CLOWN', 'SWEET ANASTACIA'/
DATA JO /'KSINNER', 'GBAZE',
&'JLEONARD', 'SHOEMAKER', 'JTGONZALEZ',
&'SGOLDSMITH', 'MLEWIS', 'RYAKA',
&'WDELIA', 'AOCHOA', 'GLAWLESS',
&'PINEDA', 'MRUJANO', 'KFURLONG',
&'SARCHULETA', 'MUALENAUELA', 'JWILBURN',
&'FMENA', 'SVALDEZ', 'PEREZ'/
DO 10 I = 1, 5
1 J(I) = 1 + INT(RAND(0) * 20)
L(I) = 1 + INT(RAND(0) * 20)
IF (I .EQ. 1) GOTO 2
DO 20 I2 = 1, I - 1
IF (J(I) .EQ. J(I2) .OR. L(I) .EQ. L(I2)) GOTO 1
20 CONTINUE
2 HORSE(I) = H(J(I))
JOCK(I) = JO(L(I))
10 CONTINUE
END
C ******************************************************************
SUBROUTINE RACE()
C
C THIS SUBROUTINE RUNS THE RACE INTERNALLY AND PRINTS THE RESULTS.
C
CHARACTER BELL
PARAMETER (BELL=CHAR(7))
INTEGER IHAND(5), IODD(5)
INTEGER IHORSE(5), IMT(5), IPLAY, IBANK(5), IWIN
COMMON /NUMODD/ IHAND, IODD
COMMON /BET/ IHORSE, IMT, IPLAY, IBANK, IWIN
CHARACTER BELLS(10)
INTEGER I, I1, IWIN1, N
DATA BELLS /10 * BELL/
PRINT 100
100 FORMAT (' AT THE SOUND OF THE BELL THEY''RE OFF.',$)
CALL SLEEP(2)
PRINT 200, BELLS
200 FORMAT (10(A1))
1 DO 10 I = 1, 5
IHAND(I) = IHAND(I) + INT(RAND(0) * 5)
10 CONTINUE
DO 20 I1 = 1, 5
IF (IHAND(I1) .GE. 60) GOTO 2
20 CONTINUE
GOTO 1
2 IWIN1 = IHAND(1)
DO 30 I = 1, 5
IWIN1 = MAX(IWIN1, IHAND(I))
30 CONTINUE
DO 40 I = 1, 5
IF (IWIN1 .EQ. IHAND(I)) IWIN1 = I
40 CONTINUE
PRINT 300
300 FORMAT (49X,' FINISH LINE^')
IWIN = IWIN1
PRINT *, 'HERE ARE THE RESULTS:'
DO 50 I = 1, 5
PRINT 400, I
400 FORMAT (1X,'(',I1,')',$)
DO 60 N = 1, IHAND(I) - 1
PRINT 500
500 FORMAT ('-',$)
60 CONTINUE
PRINT 600
600 FORMAT ('*')
50 CONTINUE
END| UNIX | Flang/F18 | $ flang -o delmar delmar.f |
|---|---|---|
| GNU Fortran | $ gfortran -o delmar delmar.f | |
| Intel Fortran Compiler | $ ifort -o delmar delmar.f | |
| Win32 | Digital/Compaq Visual Fortran | > fl32.exe delmar.f /Fe=delmar.exe |
