FORTRAN Computer Games


DELMAR

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.

jockey

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.

Gameplay

DELMAR in FORTRAN 77

Functions & Subroutines

Five subroutines are called by the program which are directly taken from the FORTRAN IV version:

CALL BANKER()
Keeps a record of wins and losses.
CALL BET()
Subroutine for taking bets.
CALL ODDS()
Determines the odds.
CALL PICKS()
Selects horses and jockeys randomly.
CALL RACE()
Runs the race internally and prints the results.

The following procedures are not part of the ANSI FORTRAN 77 language standard and have to be provided additionally:

RESULT = TIME()
Returns timestamp in seconds (INTEGER). Required for the initialisation of the pseudo-random number generator.
RESULT = RAND(I)
Returns the next random number (REAL).
CALL SRAND(ISEED)
Initialises the pseudo-random number generator with given seed value (INTEGER).
CALL SLEEP(TIME)
Suspends program execution for the given time in seconds (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.

Program Listing

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

Build Instructions

UNIXFlang/F18$ flang -o delmar delmar.f
GNU Fortran$ gfortran -o delmar delmar.f
Intel Fortran Compiler$ ifort -o delmar delmar.f
Win32Digital/Compaq Visual Fortran> fl32.exe delmar.f /Fe=delmar.exe

References


Home