FORTRAN Computer Games


Penney’s Game

A coin tossing game, invented by Walter Penney. The user and the computer each choose a head/tail sequence of three. The sequence that is first tossed wins.

Gameplay

 PENNEY'S GAME

 YOU PICK FIRST.
 ENTER YOUR SEQUENCE OF THREE (H/T): TTH
 THE COMPUTER PICKED: HTT

 TOSSED SEQUENCE: THHHTHHHHHTHHHHHHHHTHHTT
 THE COMPUTER WINS!

 ANOTHER GAME?

Functions & Subroutines

The program implements the following functions and subroutines:

RESULT = CMPSEQ(IUSR)
Lets the computer select a sequence depending on the choice of the user (INTEGER).
RESULT = USRSEQ(ICMP)
Returns user’s sequence from input (INTEGER).
RESULT = TOSS(ICMP, IUSR)
Flips a coin until either the computer’s or the user’s picked sequence matches. Returns 1 if the user has won, else 0.
CALL OUTSEQ(ISEQ)
Prints the given sequence of three to screen.
CALL PLAY()
Runs the game loop.

The program calls four procedures that are not part of the ANSI FORTRAN 77 language standard:

RESULT = ISHFT(I, SHIFT)
Performs a logical shift (INTEGER). Later became a Fortran 90 standard.
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(SEED)
Initialises the pseudo-random number generator with given seed value (INTEGER).

Most modern compilers provide these procedures through extensions.

Program Listing

Copy and save the program as penney.f locally.

C     ******************************************************************
C
C     PENNEY'S GAME
C
C     TWO PLAYERS (USER AND COMPUTER) BET ON BEING THE FIRST TO SEE A
C     PARTICULAR SEQUENCE OF HEADS OR TAILS IN CONSECUTIVE TOSSES OF A
C     FAIR COIN.
C
C     ******************************************************************
      PROGRAM PENNEY
      EXTERNAL  PLAY
      CHARACTER A

      CALL SRAND(TIME())
      PRINT 100, CHAR(39)

   10 CONTINUE
      CALL PLAY()
      PRINT 200
      READ (*, 300, IOSTAT=ISTAT) A
      IF (ISTAT .EQ. 0 .AND. (A .EQ. 'Y' .OR. A .EQ. 'y')) GOTO 10

  100 FORMAT (' PENNEY',A,'S GAME')
  200 FORMAT (/,' ANOTHER GAME? ',$)
  300 FORMAT (A)
      END
C     ******************************************************************
      INTEGER FUNCTION CMPSEQ(IUSR)
C
C     IF USER'S SEQUENCE IS GIVEN AND NOT -1, THE COMPUTER SELECTS THE
C     OPTIMUM SEQUENCE (WHICH IS ~2-1-2).
C
      INTEGER IUSR

      IF (IUSR .EQ. -1) THEN
        CMPSEQ = NINT(RAND(0) * 7)
      ELSE
        CMPSEQ = IOR(ISHFT(IUSR, -1),
     &               IAND(ISHFT(NOT(IUSR), 1), ISHFT(1, 2)))
      END IF
      END
C     ******************************************************************
      INTEGER FUNCTION USRSEQ(ICMP)
C
C     READS USER'S SEQUENCE FROM INPUT.
C
      INTEGER     ICMP
      CHARACTER*3 A
      INTEGER     I, ISTAT

   10 CONTINUE
      PRINT 100
      READ (*, 200, IOSTAT=ISTAT) A

      IF (ISTAT .NE. 0) THEN
        PRINT 300
        GOTO 10
      END IF

      USRSEQ = 0

      DO 20 I = 1, 3
      IF (A(I:I) .NE. 'H' .AND. A(I:I) .NE. 'h' .AND.
     &    A(I:I) .NE. 'T' .AND. A(I:I) .NE. 't') THEN
        PRINT 300
        GOTO 10
      END IF

      IF (A(I:I) .EQ. 'H' .OR. A(I:I) .EQ. 'h') THEN
        USRSEQ = IOR(USRSEQ, ISHFT(8, -I))
      END IF
   20 CONTINUE

      IF (USRSEQ .EQ. ICMP) THEN
        PRINT 400
        GOTO 10
      END IF

  100 FORMAT (/,' ENTER YOUR SEQUENCE OF THREE (H/T): ',$)
  200 FORMAT (A)
  300 FORMAT (' INVALID INPUT.',
     &' PLEASE ENTER ONLY CHARACTERS "H" AND "T".')
  400 FORMAT (' INVALID INPUT.',
     &' PICK A DIFFERENT SEQUENCE THAN THE COMPUTER.')
      END
C     ******************************************************************
      INTEGER FUNCTION TOSS(ICMP, IUSR)
C
C     FLIPS A COIN UNTIL EITHER THE COMPUTER'S OR THE USER'S PICKED
C     SEQUENCE MATCHES. RETURNS 1 IF THE USER HAS WON, ELSE 0.
C
      EXTERNAL OUTSEQ
      INTEGER  ICMP, IUSR
      INTEGER  ILAST

      ILAST = NINT(RAND(0) * 7)
      PRINT 100
      CALL OUTSEQ(ILAST)

   10 CONTINUE
      IF (ICMP .EQ. ILAST) THEN
        TOSS = 0
        RETURN
      ELSE IF (IUSR .EQ. ILAST) THEN
        TOSS = 1
        RETURN
      END IF

      ILAST = IOR(IAND(ISHFT(ILAST, 1), 6), NINT(RAND(0)))

      IF (IAND(ILAST, 1) .EQ. 1) THEN
        PRINT 200, 'H'
      ELSE
        PRINT 200, 'T'
      END IF
      GOTO 10

  100 FORMAT (/,' TOSSED SEQUENCE: ',$)
  200 FORMAT (A,$)
      END
C     ******************************************************************
      SUBROUTINE OUTSEQ(ISEQ)
C
C     PRINTS THE GIVEN SEQUENCE OF THREE TO SCREEN.
C
      INTEGER ISEQ
      INTEGER I

      DO 10 I = 2, 0, -1
      IF (IAND(ISEQ, ISHFT(1, I)) .GT. 0) THEN
        PRINT 100, 'H'
      ELSE
        PRINT 100, 'T'
      END IF
   10 CONTINUE

  100 FORMAT (A,$)
      END
C     ******************************************************************
      SUBROUTINE PLAY()
C
C     THE GAME STARTS HERE.
C
      EXTERNAL OUTSEQ
      INTEGER  CMPSEQ, USRSEQ, TOSS
      INTEGER  ICMP, IUSR, IWIN

      IUSR = -1
      ICMP = -1

      IF (RAND(0) .GE. 0.5) THEN
        PRINT 100
        IUSR = USRSEQ(ICMP)
        ICMP = CMPSEQ(IUSR)
        PRINT 300
        CALL OUTSEQ(ICMP)
        PRINT *
      ELSE
        PRINT 200
        ICMP = CMPSEQ(IUSR)
        PRINT 300
        CALL OUTSEQ(ICMP)
        IUSR = USRSEQ(ICMP)
      END IF

      IWIN = TOSS(ICMP, IUSR)

      IF (IWIN .EQ. 1) THEN
        PRINT 400
      ELSE
        PRINT 500
      END IF

  100 FORMAT (/,' YOU PICK FIRST.',$)
  200 FORMAT (/,' THE COMPUTER PICKS FIRST.')
  300 FORMAT (' THE COMPUTER PICKED: ',$)
  400 FORMAT (/,' YOU WIN!')
  500 FORMAT (/,' THE COMPUTER WINS!')
      END

Build Instructions

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

References


Home