A slot machine game, ported from BASIC to FORTRAN 77. The original program listing was published in Computer Games for Business, School, and Home (1980):
Let’s go to Las Vegas! This game is one of chance. Slot machines are found in most gambling rooms throughout the world. Most slot machines are made up of 3, 4, or more vertical reels (wheels) on which various symbols are marked. The symbols are usually a cherry, orange, bell, plum, apple, and a bar. A handle is pulled in order to spin the wheels which stop eventually […].
Initially, the player starts with $15, but IFIRST
may be changed
to any other value.
The following subroutines are implemented:
CALL PAYOFF()
CALL PULL(IBANK)
IBANK
.Additionally, three procedures are called that are not part of the ANSI FORTRAN 77 language standard:
RESULT = TIME()
INTEGER
). Required for the
initialisation of the pseudo-random number generator.RESULT = RAND(I)
REAL
).CALL SRAND(ISEED)
INTEGER
).Most modern compilers provide these procedures through extensions.
Copy and save the program in file jackpot.f
locally.
C ******************************************************************
C
C JACKPOT - SLOT MACHINE GAME
C
C PROGRAM WAS ORIGINALLY WRITTEN IN BASIC, AND PUBLISHED IN:
C
C J. VICTOR NAHIGIAN & WILLIAM S. HODGES: COMPUTER GAMES FOR
C BUSINESS, SCHOOL, AND HOME. FOR TRS-80 LEVEL II BASIC. WINTHROP,
C CAMBRIDGE, MA, 1980
C
C PORTED TO FORTRAN 77 BY PHILIPP ENGEL (2021).
C
C ******************************************************************
PROGRAM JACKPOT
EXTERNAL PAYOFF
INTEGER IFIRST
PARAMETER (IFIRST=15)
CHARACTER A
INTEGER IBANK, ISTAT
C
C SET THE BANK ROLL AND INITIALISE THE RANDOM NUMBER GENERATOR.
C
IBANK = IFIRST
CALL SRAND(TIME())
C
C OUTPUT TITLE AND SHOW THE LIST OF PAYOFFS.
C
PRINT 100
CALL PAYOFF()
C
C GAME LOOP.
C
10 CONTINUE
PRINT 200, IBANK
READ (*, 900, IOSTAT=ISTAT) A
C
C PULL THE HANDLE.
C
CALL PULL(IBANK)
C
C ASK PLAYER TO PLAY AGAIN.
C
PRINT 300
A = ' '
READ (*, 900, IOSTAT=ISTAT) A
IF (A .EQ. ' ' .OR. A .EQ. 'Y' .OR. A .EQ. 'y') GOTO 10
C
C SHOW RESULTS.
C
IF (IBANK .LT. 0) THEN
PRINT 400, ABS(IBANK)
ELSE IF (IBANK .GT. IFIRST) THEN
PRINT 500, IBANK - IFIRST
ELSE
PRINT 600, IFIRST - IBANK
END IF
100 FORMAT (16X,' JACKPOT GAME',/)
200 FORMAT (/,' YOU HAVE $',I3,'.',/,/,' HIT RETURN TO PULL HANDLE.')
300 FORMAT (/,' AGAIN? ',$)
400 FORMAT (/,' YOU HAVE 10 DAYS TO PAY ME $',I3,'. AFTER THAT',/,
&' IT IS OUT OF MY HANDS AS TO WHAT HAPPENS TO YOU!')
500 FORMAT (/,' CONGRATULATIONS, YOU WON $',I3,'.')
600 FORMAT (/,' TOO BAD, YOU LOST $',I3,'.')
900 FORMAT (A)
END
C ******************************************************************
SUBROUTINE PAYOFF()
C
C SHOWS THE LIST OF PAYOFFS.
C
CHARACTER A
INTEGER ISTAT
PRINT 100
READ (*, 900, IOSTAT=ISTAT) A
IF (ISTAT .NE. 0) RETURN
IF (A .NE. 'Y' .AND. A .NE. 'y') RETURN
PRINT 200
100 FORMAT (' DO YOU WANT A LIST OF THE PAYOFFS? ',$)
200 FORMAT (/,' REEL 1 REEL 2 REEL 3 PAYOFF',/,/,
&' CHERRY ANYTHING ANYTHING 3 DOLLARS',/,
&' CHERRY CHERRY ANYTHING 5 DOLLARS',/,
&' ORANGE ORANGE BAR 6 DOLLARS',/,
&' BELL BELL ORANGE 8 DOLLARS',/,
&' PLUM PLUM PLUM 10 DOLLARS',/,
&' APPLE APPLE ANYTHING 15 DOLLARS',/,
&' ORANGE ORANGE ORANGE 18 DOLLARS',/,
&' APPLE APPLE APPLE 20 DOLLARS',/,
&' BELL BELL BELL 30 DOLLARS',/,
&' BAR BAR BAR 200 DOLLARS')
900 FORMAT (A)
END
C ******************************************************************
SUBROUTINE PULL(IBANK)
C
C PULLS THE HANDLE OF THE SLOT MACHINE.
C
INTEGER IBANK
CHARACTER*6 REELY(6)
INTEGER NEXTY(3, 20)
INTEGER I, IR(3), IWIN, IX
DATA REELY /'CHERRY','ORANGE','BAR','BELL','PLUM','APPLE'/
DATA NEXTY /2,4,2,5,1,4,2,2,5,6,4,6,1,1,2,4,2,6,5,4,
&5,6,1,4,4,5,3,5,5,5,1,1,2,2,2,4,4,4,6,1,
&3,2,3,4,2,2,1,4,6,2,5,1,4,2,4,6,4,2,1,2/
C
C INSERT COIN.
C
IBANK = IBANK - 1
C
C SPIN THE REELS.
C
DO 10 I = 1, 3
IX = 1 + INT(RAND(0) * 20)
IR(I) = NEXTY(I, IX)
10 CONTINUE
C
C DETERMINE THE WIN.
C
IWIN = 0
IF (IR(1) .EQ. 3 .AND. IR(2) .EQ. 3 .AND. IR(3) .EQ. 3) THEN
IWIN = 200
ELSE IF (IR(1) .EQ. 4 .AND. IR(2) .EQ. 4 .AND. IR(3) .EQ. 4) THEN
IWIN = 30
ELSE IF (IR(1) .EQ. 6 .AND. IR(2) .EQ. 6 .AND. IR(3) .EQ. 6) THEN
IWIN = 20
ELSE IF (IR(1) .EQ. 2 .AND. IR(2) .EQ. 2 .AND. IR(3) .EQ. 2) THEN
IWIN = 20
ELSE IF (IR(1) .EQ. 6 .AND. IR(2) .EQ. 6) THEN
IWIN = 15
ELSE IF (IR(1) .EQ. 5 .AND. IR(2) .EQ. 5 .AND. IR(3) .EQ. 5) THEN
IWIN = 10
ELSE IF (IR(1) .EQ. 4 .AND. IR(2) .EQ. 4 .AND. IR(3) .EQ. 2) THEN
IWIN = 8
ELSE IF (IR(1) .EQ. 2 .AND. IR(2) .EQ. 2 .AND. IR(3) .EQ. 3) THEN
IWIN = 6
ELSE IF (IR(1) .EQ. 1 .AND. IR(2) .EQ. 1) THEN
IWIN = 5
ELSE IF (IR(1) .EQ. 1) THEN
IWIN = 3
END IF
C
C SHOW RESULTS AND TRANSFER WIN.
C
PRINT 100, REELY(IR(1)), REELY(IR(2)), REELY(IR(3)), IWIN
IBANK = IBANK + IWIN
IF (IWIN .EQ. 200) PRINT 200
100 FORMAT (1X,3(A,6X),'YOU WIN $',I3)
200 FORMAT (' *** JACKPOT ***')
END
UNIX | Flang/F18 | $ flang -o jackpot jackpot.f |
---|---|---|
GNU Fortran | $ gfortran -o jackpot jackpot.f | |
Intel Fortran Compiler | $ ifort -o jackpot jackpot.f | |
Win32 | Digital/Compaq Visual Fortran | > fl32.exe jackpot.f /Fe=jackpot.exe |