Directory of image this file is from
This file as a plain text file
FORTRAN IV 4AAAA PAGE ONE
C PROGRAM DECODE
0002 DIMENSION ICODE(5),IGUESS(5,20),ISCORE(5,20),IPOS(5)
C
C NPL NUMBER OF PLAYERS
C ICODE CODE TO BE DISCOVERED
C IGUESS GUESSES ENTERED BY THE PLAYER
C ISCORE SCORE FOR EACH ENTERED GUESS
C NCRCLR NUMBER OF CORRECT COLOUR
C NCRPOS NUMBER OF CORRECT COLOUR AND POSITION
C NGUESS NUMBER OF GUESS
C
C FIRST GET NUMBER OF PLAYERS
C
0003 WRITE(4,27)
0004 27 FORMAT(' ENTER NUMBER OF PLAYERS =')
0005 READ(4,1) NPL
0006 1 FORMAT(I1)
0007 IF( ( NPL .LE. 0 ) .OR. ( NPL .GT. 2 ) ) GOTO 52
0010 2 CONTINUE
0011 IF( NPL .EQ. 1 ) GOTO 5
C
C GET CODE FROM FIRST PLAYER
C
0012 WRITE(4,4)
0013 4 FORMAT(' ENTER CODE=")
0014 READ(4,3) ICODE
0015 3 FORMAT(5I1)
0016 GOTO 8
C
C GENERATE CODE FROM RANDOM GENERATOR
C
0017 5 CONTINUE
0020 DO 7 I = 1, 5
0021 CALL RANF(FIX)
0022 IX = IFIX(FIX*5.0)
0023 ICODE(I) = IX
0024 7 CONTINUE
C
C PRINT CODE
C
0025 8 CONTINUE
0026 WRITE(4,9) ICODE
0027 9 FORMAT(1X,5I1)
C
C MAIN ROUTINE
C
0030 NGUESS = 0
C
C FIRST GET GUESS
C
0031 10 CONTINUE
0032 NGUESS = NGUESS + 1
0033 WRITE(4,11)
0034 11 FORMAT(1X,'ENTER GUESS:')
0035 READ(4,3)( IGUESS( I, NGUESS ), I = 1, 5 )
FORTRAN IV 4AAAA PAGE TWO
C
C EVALUATE GUESS
C
C INITIALIZE COUNTS
C
0036 NCRCLR = 0
0037 NCRPOS = 0
0040 DO 14 I = 1, 5
0041 IPOS(I) = 0
0042 14 CONTINUE
C
C IPOS CODES,
C 0 NEITHER POSITION USED FOR SCORE
C 1 CODE POSITION USED FOR SCORE
C 2 GUESS POSITION USED FOR SCORE
C 3 BOTH USED FOR SCORE
C
C FIRST EVALUATE DIRECT HITS
C
0043 DO 15 I = 1, 5
0044 IF( ICODE( I ) .NE. IGUESS( I, NGUESS ) ) GOTO 15
0045 IPOS(I) = 3
0046 NCRPOS = NCRPOS + 1
0047 15 CONTINUE
C
C NEXT EVALUATE CORRECT COLOURS
C
0050 DO 18 I = 1, 5
C
C CHECK GUESS INITIALIZATION
C
0051 IF( IPOS( I ) .EQ. 2 ) GOTO 18
0052 IF( IPOS( I ) .EQ. 3 ) GOTO 18
0053 DO 17 J = 1, 5
C
C CHECK FOR CODE UTILIZATION
C
0054 IF( IPOS( J ) .EQ. 1 ) GOTO 17
0055 IF( IPOS( J ) .EQ. 3 ) GOTO 17
C
C CHECK FOR HIT
C
0056 IF( IGUESS( I, NGUESS ) .NE. ICODE( J ) ) GOTO 17
0057 NCRCLR = NCRCLR + 1
0060 IF( IPOS( J ) .EQ. 0 ) IPOS( J ) = 1
0061 IF( IPOS( J ) .EQ. 2 ) IPOS( J ) = 3
0062 IF( IPOS( I ) .EQ. 0 ) IPOS( I ) = 2
0063 IF( IPOS( I ) .EQ. 1 ) IPOS( I ) = 3
0064 GOTO 18
0065 17 CONTINUE
0066 18 CONTINUE
C
C FORMAT RESULTS
C
0067 DO 20 I = 1, 5
FORTRAN IV 4AAAA PAGE THREE
0070 ISCORE( I, NGUESS ) = 0
0071 20 CONTINUE
0072 IF( NCRCLR .LE. 0 ) GOTO 22
0073 DO 21 I = 1, NCRCLR
0074 ISCORE( I, NGUESS ) = 1
0075 21 CONTINUE
0076 22 CONTINUE
0077 IF( NCRPOS .EQ. 0 ) GOTO 24
0100 L1 = NCRCLR + 1
0101 L2 = NCRPOS + NCRCLR
0102 IF( L2 .GT. 5 ) GOTO 50
0103 DO 23 I = L1, L2
0104 ISCORE( I, NGUESS ) = 2
0105 23 CONTINUE
C
C PRINT RESULTS
C
0106 24 CONTINUE
0107 WRITE(4,28)
0110 28 FORMAT(' NUMBER GUESS SCORE')
0111 DO 26 L = 1, NGUESS
0112 WRITE(4,25) L,(IGUESS(I,L),I=1,5),
$ (ISCORE(J,L),J=1,5)
0113 25 FORMAT(3X,I2,4X,5I1,3X,5I1)
0114 26 CONTINUE
C
C TEST FOR DECODED
C
0115 IF( NCRPOS .GE. 5 ) GOTO 30
C
C TEST FOR LIMIT OF GUESSES
C
0116 IF( NGUESS .GE. 20 ) GOTO 32
0117 GOTO 10
C
C WIN
C
0120 30 CONTINUE
0121 WRITE(4,31)
0122 31 FORMAT(' CONGRATULATIONS, YOU HAVE BROKEN THE CODE')
0123 GOTO 34
C
C LOSE
C
0124 32 CONTINUE
0125 WRITE(4,33)
0126 33 FORMAT(' SORRY...YOU COULD NOT GUESS THE CODE')
0127 34 CONTINUE
0130 WRITE(4,35)( ICODE(I),I=1,5 )
0131 35 FORMAT(1X,5I1)
C
C ANOTHER GAME?
C
0132 WRITE(4,40)
0133 40 FORMAT(' ANOTHER GAME?')
FORTRAN IV 4AAAA PAGE FOUR
0134 READ(4,41)IG
0135 41 FORMAT(A1)
0136 IF( IG .EQ. 1HY ) GOTO 2
WRITE(4,42)
0137 42 FORMAT(' END OF RUN')
GOTO 99
C
C ERROR MESSAGES
C
50 CONTINUE
0140 WRITE(4,51) NCRCLR,NCRPOS
0141 51 FORMAT(' PROGRAM ERROR(',I5,'/',I5,')' )
0142 GOTO 99
0143 52 CONTINUE
0144 WRITE(4,53)
0145 53 FORMAT(' ERROR, INVALID ENTRY')
0146 99 CONTINUE
0147 STOP
0150 END
E