File DECODE.FT (FORTRAN source file)

Directory of image this file is from
This file as a plain text file

C      PROGRAM DECODE
      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
      WRITE(4,27)
27    FORMAT(' ENTER NUMBER OF PLAYERS =')
      READ(4,1) NPL
1     FORMAT(I1)
      IF( ( NPL .LE. 0 ) .OR. ( NPL .GT. 2 ) ) GOTO 52
2     CONTINUE
      IF( NPL .EQ. 1 ) GOTO 5
C
C      GET CODE FROM FIRST PLAYER
C
      WRITE(4,4)
4     FORMAT(' ENTER CODE=")
      READ(4,3) ICODE
3     FORMAT(5I1)
      GOTO 8
C
C      GENERATE CODE FROM RANDOM GENERATOR 
C
5     CONTINUE
      DO 7 I = 1, 5
      CALL RANF(FIX)
      IX = IFIX(FIX*5.0)
      ICODE(I) = IX
7     CONTINUE
C
C      PRINT CODE
C
8     CONTINUE
      WRITE(4,9) ICODE
9     FORMAT(1X,5I1)
C
C      MAIN ROUTINE
C
      NGUESS = 0
C
C     FIRST GET GUESS
C
10    CONTINUE
      NGUESS = NGUESS + 1
      WRITE(4,11)
11    FORMAT(1X,'ENTER GUESS:')
      READ(4,3)( IGUESS( I, NGUESS ), I = 1, 5 )
C
C      EVALUATE GUESS
C
C      INITIALIZE COUNTS
C
      NCRCLR = 0
      NCRPOS = 0
      DO 14 I = 1, 5
      IPOS(I) = 0
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
      DO 15 I = 1, 5
      IF( ICODE( I ) .NE. IGUESS( I, NGUESS ) ) GOTO 15
      IPOS(I) = 3
      NCRPOS = NCRPOS + 1
15    CONTINUE
C
C     NEXT EVALUATE CORRECT COLOURS
C
      DO 18 I = 1, 5
C
C     CHECK GUESS INITIALIZATION
C
       IF( IPOS( I ) .EQ. 2 ) GOTO 18
       IF( IPOS( I ) .EQ. 3 ) GOTO 18
      DO 17 J = 1, 5
C
C     CHECK FOR CODE UTILIZATION
C
       IF( IPOS( J ) .EQ. 1 ) GOTO 17
       IF( IPOS( J ) .EQ. 3 ) GOTO 17
C
C     CHECK FOR HIT
C
       IF( IGUESS( I, NGUESS ) .NE. ICODE( J ) ) GOTO 17
      NCRCLR = NCRCLR + 1
       IF( IPOS( J ) .EQ. 0 ) IPOS( J ) = 1
       IF( IPOS( J ) .EQ. 2 ) IPOS( J ) = 3
       IF( IPOS( I ) .EQ. 0 ) IPOS( I ) = 2
       IF( IPOS( I ) .EQ. 1 ) IPOS( I ) = 3
      GOTO 18
17     CONTINUE
18    CONTINUE
C
C     FORMAT RESULTS
C
       DO 20 I = 1, 5
      ISCORE( I, NGUESS ) = 0
20     CONTINUE
      IF( NCRCLR .LE. 0 ) GOTO 22
      DO 21 I = 1, NCRCLR
      ISCORE( I, NGUESS ) = 1
21    CONTINUE
22     CONTINUE
      IF( NCRPOS .EQ. 0 ) GOTO 24
      L1 = NCRCLR + 1
      L2 = NCRPOS + NCRCLR
      IF( L2 .GT. 5 ) GOTO 50
       DO 23 I = L1, L2
       ISCORE( I, NGUESS ) = 2
23     CONTINUE
C
C      PRINT RESULTS
C
24     CONTINUE
       WRITE(4,28)
28     FORMAT(' NUMBER  GUESS   SCORE')
       DO 26 L = 1, NGUESS
       WRITE(4,25) L,(IGUESS(I,L),I=1,5),
     $               (ISCORE(J,L),J=1,5)
25     FORMAT(3X,I2,4X,5I1,3X,5I1)
26     CONTINUE
C
C      TEST FOR DECODED
C
       IF( NCRPOS .GE. 5 ) GOTO 30
C
C      TEST FOR LIMIT OF GUESSES
C
        IF( NGUESS .GE. 20 ) GOTO 32
       GOTO 10
C
C      WIN
C
30     CONTINUE
       WRITE(4,31) 
31     FORMAT(' CONGRATULATIONS, YOU HAVE BROKEN THE CODE')
      GOTO 34
C
C      LOSE
C
32    CONTINUE
      WRITE(4,33)
33    FORMAT(' SORRY...YOU COULD NOT GUESS THE CODE')
34    CONTINUE
      WRITE(4,35)( ICODE(I),I=1,5 )
35     FORMAT(1X,5I1)
C
C    ANOTHER GAME?
C
       WRITE(4,40)
40    FORMAT(' ANOTHER GAME?')
       READ(4,41)IG
41    FORMAT(A1)
      IF( IG .EQ. 1HY ) GOTO 2
     WRITE(4,42)
42    FORMAT(' END OF RUN')
     GOTO 99
C
C     ERROR MESSAGES
C
50   CONTINUE
      WRITE(4,51) NCRCLR,NCRPOS
51    FORMAT(' PROGRAM ERROR(',I5,'/',I5,')' )
      GOTO 99
52     CONTINUE
      WRITE(4,53)
53    FORMAT(' ERROR, INVALID ENTRY')
99    CONTINUE
      STOP
      END
E



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search