PROGRAM MSTRMD
C+
C	This program plays the game of mastermind.
C	It will report on guesses made by the operator and keep score.
C	It will also guess, which is the unusual part.
C	Score is also kept for the machine.
C	Mastermind is a Sequence generating and guessing game between
C	two players.  In this version (which is the standard game or
C	simplist if you perfer) there are four positions to be guessed.
C	Each position can hold one of six different colors.  One player
C	makes up a sequence and the other player attempts to guess it.
C	Each guess makes up a turn.  After each guess the original player
C	gives the guesser clues as to how he is doing.  A black peg
C	is given for each color that is found in the original sequence
C	and that is in the correct position.  A white peg is given if
C	the color exists in the original sequence but it is in a incorrect
C	position.  In this program the player and the machine take turns
C	being the guesser.  The machine averages a little under 5 guesses
C	per sequence.  There is no shrewdness in the guesses of the machine.
C	Each guess is just a random selection from the array of possible
C	combinations that exist.  If a history is kept up against each 
C	opponenent then the machine could be a little more shrew in its gueses.
C
C	AUTHOR:	J.L.HAMILTON
C		E-SYSTEMS INC
C		P.O.BOX 1056 CBN 27
C		GREENVILLE, TEXAS  75401
C
C	DATE:	10-SEP-79
C-
	BYTE ANS,KNOW,FRST
	INTEGER SCORE
	DIMENSION SCORE(2)
	DATA SCORE/0,0/
C	GET A RANDOM NUMBER FROM THE TIME AND DATE
	X=SECNDS(0.0)
	X=X*10
2	X=X/10
	IF(X.GT.32000.)GO TO 2
	IR=INT(X)
	CALL IDATE(JUNK,JR,JUNK)
	M=0
C	CHECK IF USER KNOWS HOW TO PLAY
	TYPE *,'DO YOU KNOW THE RULES?'
	READ(5,100,END=999)KNOW
	IF(KNOW.EQ.'N')CALL RULES
4	TYPE *,'WHO DO YOU WANT TO GUESS FIRST? ME(M) OR YOU(Y)'
	READ(5,100,END=999)FRST
5	IF(FRST.EQ.'M')CALL ME(SCORE,IR,JR)
	CALL YOU(SCORE,IR,JR)
	IF(FRST.EQ.'Y')CALL ME(SCORE,IR,JR)
	M=M+1
	TYPE *,'DO YOU WANT TO PLAY AGAIN?'
	READ(5,100,END=999)ANS
	IF(ANS.EQ.'Y')GO TO 5
	TYPE 101,SCORE,M
999	CALL EXIT
100	FORMAT(A1)
101	FORMAT(1X,'FINAL SCORE:',/,1X,'ME=',I3,
	120X,'YOU=',I3,/,15X,'GAMES=',I3)
	END
	SUBROUTINE RULES
C
C	This subroutine will print out the rules to the terminal.
C
	TYPE *,'THIS IS A GAME OF MASTER MIND.'
	TYPE *,'It can hold a sequence of four colors.'
	TYPE *,'The object is to guess these four colors by entering'
	TYPE *,'guesses to the * prompt.  The guesses must be '
	TYPE *,'of the form:xxx,xxx,xxx,xxx   where xxx is one of'
	TYPE *,'the following colors: BLU,RED,WHT,GRN,YEL,BLK'
	TYPE *,'after the guess is entered, the computer will'
	TYPE *,'respond with a clue of the form:XXXX'
	TYPE *,'where X will be a blank,B, or W.'
	TYPE *,' '
	TYPE *,'PRESS CARRAIGE RETURN FOR MORE RULES'
	TYPE *,' '
	READ(5,100,END=999)Z9
100	FORMAT(A1)
	TYPE *,'A blank indicates none of your choices is contained'
	TYPE *,'in his sequence.  A W indicates one choice'
	TYPE *,'is right but in the wrong place.  A B indicates'
	TYPE *,'a correct choice and in the right place.  More'
	TYPE *,'than one B or W indicates the number of correct'
	TYPE *,'choices and gives a clue as to the place.'
	TYPE *,'you will also be asked to think up a sequence of the six'
	TYPE *,'colors in the four places for the computer to guess.'
	TYPE *,'respond to the computers guess with the B and W responce.'
	TYPE *,'to try the computer''s ability you may want'
	TYPE *,'to use the same sequence as he gave you.'
	TYPE *,'at the end of the game the score will be'
	TYPE *,'printed out.  The number is the total number'
	TYPE *,'of guesses by each of you.'
	RETURN
999	CALL EXIT
	END
	SUBROUTINE ME(SCORE,IR,JR)
C
C	This subroutine will do the guessing for the computer.
C
	INTEGER*2 GUESS,ARRAY,BRRAY,B,W,SCORE
	DIMENSION ARRAY(1296),BRRAY(1296),SCORE(2)
	BYTE ANS
	TYPE *,'OK... NOW ITS MY TURN.  GET A SEQUENCE'
	TYPE *,'PRESS CARRAIGE RETURN WHEN READY'
	READ(5,106,END=999)Z9
C	FIRST GENERATE THE COMPLETE ARRAY WITH ALL COMBINATIONS.
5	CALL GNRATE(ARRAY)
	J=0
	NUM=1296
10	I=INT((NUM)*RAN(IR,JR))+1
	J=J+1
C	NOW RANDOMLY GUESS ONE OF THE ARRAY ELEMENTS.
	GUESS=ARRAY(I)
C	OUTPUT THE GUESS TO THE TERMINAL
	CALL OUTPUT(GUESS)
C	GET THE NUMBER OF BLACK PEGS AND WHITE PEGS
	CALL INPUT(B,W)
C	IF 4 BLACK PEGS WE HAVE WON.
	IF(B.EQ.4)GO TO 20
C	OTHERWISE WHITTLE NUMBER OF ARRAY ELEMENTS DUE TO THE
C	TOTAL NUMBER OF PEGS WE GOT. (NUMBER OF CORRECT COLORS)
	CALL PEG(ARRAY,BRRAY,NUM,B+W,GUESS)
D	PRINT 104
D	PRINT 110,GUESS,B,W
D	PRINT 103,NUM
D	DO 14,JK=1,NUM+10,10
D14	PRINT 102,(BRRAY(JL),JL=JK,JK+9)
C	THE NUMBER OF ELEMENTS LEFT IN THE ARRAY IS NUM.
	IF(NUM.EQ.0)GO TO 19
C	NOW WHITTLE DOWN THE NUMBER OF ARRAY ELEMENTS DUE TO NOT BEING IN
C	THE CORRECT POSITION.
	CALL BLACK(BRRAY,ARRAY,NUM,B,GUESS)
D	PRINT 103,NUM
D	DO 15,JK=1,NUM+10,10
D15	PRINT 102,(ARRAY(JL),JL=JK,JK+9)
C	IF THE USER GIVES CONFLICTING CLUES ON DIFFERENT TURNS
C	THE TOTAL NUMBER OF ARRAY ELEMENTS COULD GO TO ZERO.
C	IF NOT ZERO GET ANOTHER CLUE.
	IF(NUM.NE.0)GO TO 10
C	THE USER HAD AN ERROR.  (HOW ELSE COULD WE HAVE GOT HERE?)
19	TYPE 105
	CALL EXIT
C	WE GUESSED IT RIGHT. TELL HIM STATS.
20	TYPE 100,J
	SCORE(1)=SCORE(1)+J
	RETURN
999	CALL EXIT
100	FORMAT(1X,'NUMBER OF GUESSES=',I3)
102	FORMAT(10X,10(I5,4X))
103	FORMAT(30X,'NUM=',I4)
104	FORMAT(1H1)
105	FORMAT(1X,'LOGIC DOES NOT COMPUT.  CHECK YOUR RESPONCES FOR',
	1/,' ACCURACY AND TRY AGAIN.  MASTERMIND EXITING')
106	FORMAT(A1)
110	FORMAT(20X,'GUESS=',I4,10X,'B=',I1,10X,'W=',I1)
	END
	SUBROUTINE GNRATE(IRRAY)
C+
C	This subroutine will generate a fres array to hold the responses.
C	Each array element contains four numbers (four places) and each
C	number is between 0 and 7 (six colors).
C-
	DIMENSION IRRAY(1296),IJ(4)
	DO 5,I=1,4
5	IJ(I)=1
	IRRAY(1)=1111
	DO 50,J=2,1296
	IF(IJ(1).EQ.6)GO TO 10
	IJ(1)=IJ(1)+1
	GO TO 40
10	IF(IJ(2).EQ.6)GO TO 20
	IJ(2)=IJ(2)+1
	IJ(1)=1
	GO TO 40
20	IF(IJ(3).EQ.6)GO TO 30
	IJ(3)=IJ(3)+1
	IJ(2)=1
	IJ(1)=1
	GO TO 40
30	IJ(4)=IJ(4)+1
	IJ(3)=1
	IJ(2)=1
	IJ(1)=1
40	IRRAY(J)=1000*IJ(4)+100*IJ(3)+10*IJ(2)+IJ(1)
50	CONTINUE
	RETURN
999	CALL EXIT
	END
	SUBROUTINE OUTPUT(GUESS)
C+
C	This subroutine will put out to the terminal the computer's
C	guess. The guess consists of a four place number with the
C	representations as below.
C
C	1-Blue
C	2-Black
C	3-Red
C	4-Green
C	5-White
C	6-Yellow
C-
	BYTE COLOR,OUT
	INTEGER GUESS,POS,HOLD
	DIMENSION POS(4),OUT(3,4),COLOR(3,6)
	DATA COLOR/'B','L','U','B','L','K','R','E','D'
	1,'G','R','N','W','H','T','Y','E','L'/
	HOLD=GUESS
	DO 10,I=4,1,-1
	POS(5-I)=HOLD/(10**(I-1))
10	HOLD=HOLD-POS(5-I)*10**(I-1)
	DO 20,I=1,4
	DO 20,J=1,3
20	OUT(J,I)=COLOR(J,POS(I))
	TYPE 100,OUT
100	FORMAT(1X,4(3A1,3X))
	RETURN
999	CALL EXIT
	END
	SUBROUTINE INPUT(B,W)
C+
C	This subroutine will get from the terminal the clue as to how
C	the computer did on guessing.
C-
	BYTE LINE(80)
	INTEGER B,W
C	ISSUE PROMPT
	TYPE 101
101	FORMAT($,1X,':')
C	GET THE CLUE
	READ(5,100,END=999)NCH,(LINE(I),I=1,NCH)
100	FORMAT(Q,80A1)
	B=0
	W=0
	DO 10,I=1,NCH
	IF(LINE(I).EQ.'B')B=B+1
	IF(LINE(I).EQ.'W')W=W+1
10	CONTINUE
	RETURN
999	CALL EXIT
	END
	SUBROUTINE PEG(ARRAY,BRRAY,NUM,P,GUESS)
C+
C	This subroutine is the one of two main processing routine in the
C	machines ability to guess.  This routine uses the total number of
C	pegs it got as a clue to decrease the number of array elements.
C-
	INTEGER ARRAY,BRRAY,P,GUESS,GHOLD,POS,GPOS,HOLD
	DIMENSION ARRAY(NUM),BRRAY(NUM),POS(4),GPOS(4),L(4)
	DO 5,I=1,4
5	L(I)=0
c	HOLD THE GUESS FOR LATER USE.
	GHOLD=GUESS
C	FIND THE VALUE IN EACH POSITION
	DO 10,I=4,1,-1
	GPOS(5-I)=GHOLD/(10**(I-1))
10	GHOLD=GHOLD-GPOS(5-I)*10**(I-1)
	N=0
C	CHECK EACH ARRAY ELEMENT
	DO 100,J=1,NUM
C	HOLD THE ARRAY ELEMENT FOR LATER USE
	HOLD=ARRAY(J)
C	BREAK DOWN THE ARRAY ELEMENT INTO COMPONENTS
	DO 20,I=4,1,-1
	POS(5-I)=HOLD/(10**(I-1))
20	HOLD=HOLD-POS(5-I)*10**(I-1)
	K=0
C	IF ONE OF THE COLORS IN THE ARRAY ELEMENT IS NOT INCLUDED IN THE
C	GUESS, NO MATTER THE POSITION, THEN THAT ARRAY ELEMENT CANNOT
C	BE THE CORRECT ANSWER.  IT IS THEN THROWN AWAY AND THE NEXT CHECKED.
	DO 40,I=1,4
	DO 30 II=1,4
	IF(GPOS(I).NE.POS(II))GO TO 30
	IF(K.EQ.0)GO TO 26
	DO 25,KK=1,K
	IF(II.EQ.L(KK))GO TO 30
25	CONTINUE
26	K=K+1
	L(K)=II
	GO TO 40
30	CONTINUE
40	CONTINUE
C	THIS ONE CAN BE IT SO SAVE IT IN OTHER ARRAY
	IF(K.EQ.P)N=N+1
	IF(K.EQ.P)BRRAY(N)=ARRAY(J)
100	CONTINUE
C	WE HAVE DONE ALL THE ARRAY ELEMENTS SENT TO US.  RETURN
	NUM=N
	RETURN
999	CALL EXIT
	END
	SUBROUTINE BLACK(BRRAY,ARRAY,NUM,B,GUESS)
C+
C	This subroutine uses the total number of black pegs sent
C	from the main routine.  Each black peg represents the
C	correct color is displayed and it is in the correct position.
C-
	INTEGER ARRAY,BRRAY,B,GUESS,HOLD,GHOLD,POS,GPOS
	DIMENSION ARRAY(NUM),BRRAY(NUM),POS(4),GPOS(4)
	GHOLD=GUESS
C	GET THE COLOR OF EACH POSITION IN THE GUESS
	DO 10,I=5,1,-1
	GPOS(5-I)=GHOLD/(10**(I-1))
10	GHOLD=GHOLD-GPOS(5-I)*10**(I-1)
	N=0
C	CHECK EACH ARRAY ELEMENT
	DO 100,J=1,NUM
	HOLD=BRRAY(J)
C	GET THE COLOR OF EACH POSITION FOR THIS ARRAY ELEMENT.
	DO 20,I=4,1,-1
	POS(5-I)=HOLD/(10**(I-1))
20	HOLD=HOLD-POS(5-I)*10**(I-1)
	K=0
C	IF THIS AARRAY ELEMENT DOES NOT HAVE AT LEAST THE NUMBER OF BLACK
C	PEGS AS THE GUESS DISCARD IT AS IT CANNOT BE THE ONE.
	DO 30,I=1,4
	IF(GPOS(I).EQ.POS(I))K=K+1
30	CONTINUE
	IF(K.EQ.B)N=N+1
C	COPY THE ARRAY BACK INTO THE ORIGINAL ONE.
	IF(K.EQ.B)ARRAY(N)=BRRAY(J)
100	CONTINUE
	NUM=N
	RETURN
999	CALL EXIT
	END
	SUBROUTINE YOU(SCORE,IR,JR)
C+
C	This subroutine generates a random combination for the player
C	to guess and keeps track of the guesses by the player and delivers
C	clues.
C-
	INTEGER SCORE,GUESS,TARGET,ARRAY,B,W
	DIMENSION SCORE(2),ARRAY(1296)
	TYPE *,'NOW IT''S YOUR TURN TO GUESS'
	TYPE *,' '
	TYPE *,' '
C	GENERATE STARTING ARRAY
	CALL GNRATE(ARRAY)
	N=0
	NUM=1296
	I=INT((NUM)*RAN(IR,JR))+1
C	THIS IS THE ONE HE WILL TRY TO GUESS
	TARGET=ARRAY(I)
C	GET GUESS FROM PLAYER
10	CALL RECVE(GUESS)
	N=N+1
C	CHECK TO SEE HOW HE DID
	CALL CHECK(GUESS,TARGET,B,W)
C	GIVE THE PLAYER A CLUE
	CALL GIVE(B,W)
C	IF FOUR BLUES HE GOT IT.
	IF(B.EQ.4)GO TO 20
	GO TO 10
20	TYPE *,'CORRECT'
	TYPE 100,N
	SCORE(2)=SCORE(2)+N
100	FORMAT(1X,'NUMBER OF GUESSES=',I3)
	RETURN
	END
	SUBROUTINE RECVE(GUESS)
C+
C	This subroutine will get a guess from the player.
C-
	INTEGER POS(4),GUESS
	BYTE LINE(80)
5	TYPE 101
101	FORMAT($,1X,'*')
	READ(5,100,END=999)NCH,(LINE(I),I=1,NCH)
100	FORMAT(Q,80A1)
	DO 10,I=4,12,4
	IF(LINE(I).NE.',')GO TO 20
10	CONTINUE
	GO TO 30
20	TYPE *,'NONSTANDARD INPUT'
	GO TO 5
C	CONVERT THE COLORS INTO INTEGERS
30	DO 40,J=1,4
	IF(LINE(4*(J-1)+1).EQ.'B'.AND.LINE(4*(J-1)+2).EQ.'L'
	1.AND.LINE(4*(J-1)+3).EQ.'U')POS(J)=1
	IF(LINE(4*(J-1)+1).EQ.'B'.AND.LINE(4*(J-1)+2).EQ.'L'
	1.AND.LINE(4*(J-1)+3).EQ.'K')POS(J)=2
	IF(LINE(4*(J-1)+1).EQ.'R')POS(J)=3
	IF(LINE(4*(J-1)+1).EQ.'G')POS(J)=4
	IF(LINE(4*(J-1)+1).EQ.'W')POS(J)=5
	IF(LINE(4*(J-1)+1).EQ.'Y')POS(J)=6
40	CONTINUE
	GUESS=1000*POS(1)+100*POS(2)+10*POS(3)+POS(4)
	RETURN
999	CALL EXIT
	END
	SUBROUTINE CHECK(GUESS,TARGET,B,W)
C+
C	This subroutine will find the number of white and black pegs
C	the user is deserving of for his clue.
C
C	Remember that one white peg for each color that is guessed
C	correct but not in the correct position.  One black peg
C	for each correct color in the correct position.
C-
	INTEGER GUESS,TARGET,W,B,GHOLD,THOLD,GPOS,TPOS
	DIMENSION GPOS(4),TPOS(4),L(4)
	DO 5,I=1,4
5	L(I)=0
	B=0
	W=0
	GHOLD=GUESS
	THOLD=TARGET
	DO 10,I=4,1,-1
	GPOS(I)=GHOLD/(10**(I-1))
	GHOLD=GHOLD-GPOS(I)*10**(I-1)
	TPOS(I)=THOLD/(10**(I-1))
10	THOLD=THOLD-TPOS(I)*10**(I-1)
	B=0
	DO 11,I=1,4
	IF(GPOS(I).EQ.TPOS(I))B=B+1
11	CONTINUE
	K=0
	DO 30,I=1,4
	DO 20,II=1,4
	IF(GPOS(I).NE.TPOS(II))GO TO 20
	DO 15,KK=1,K
	IF((TPOS(II).EQ.GPOS(I)).AND.(II.EQ.L(KK)))GO TO 20
15	CONTINUE
	K=K+1
	L(K)=II
	GO TO 30
20	CONTINUE
30	CONTINUE
	W=K-B
	RETURN
999	CALL EXIT
	END
	SUBROUTINE GIVE(B,W)
C+
C	This subroutine will give the player his clues in a semi correct
C	manner - 1 B for each Black peg and 1 W for each white peg.  The
C	position of the B and W are not significant.
C-
	BYTE B1,W1,LINE(4)
	INTEGER B,W
	DATA B1,W1/'B','W'/
	DO 5,I=1,4
5	LINE(I)=' '
	K=0
	IF(B.EQ.0)GO TO 15
	DO 10,J=1,B
	K=K+1
10	LINE(K)=B1
15	IF(W.EQ.0)GO TO 25
	DO 20,J=1,W
	K=K+1
20	LINE(K)=W1
25	TYPE 100,LINE
100	FORMAT(1X,'CLUE:',4A1)
	RETURN
	END