{Ben Allen
 Master Mind Program
 10/28/96}


uses
crt;

var
cfn,csn,ctn,cln,ufn,usn,utn,uln,guess,pcor,ncor,x,ans,uinput,count:integer;
chec:boolean;

{-------------Generates a welcome start up screen---------------}
procedure start;

begin
clrscr;
gotoxy (27,10);
writeln ('Welcome to Number Puzzler 1.0');
gotoxy (25,11);
writeln ('This program is for 1 or 2 players');
gotoxy (19,12);
writeln('In 1 player mode, the computer will generate a');
gotoxy (13,13);
writeln (' 4 digit number using different numbers between 1 and 9.');
gotoxy (22,14);
writeln ('The object of the game is to guess the');
gotoxy (22,15);
writeln (' number in the least number of tries.');
gotoxy (17,16);
writeln ('In 2 player mode, Player 1 will make up a 4 digit');
gotoxy (20,17);
writeln (' number and Player 2 will try to guess it.');
gotoxy (31,18);
writeln ('Press Enter to Begin');
readln;
end;

{-------------Generates Computer Secret Num---------------}

procedure secretnum (var cfn,csn,ctn,cln:integer);

{cfn- Computer first num,csn-Computer second num,
ctn-Computer third nun,cln-Computer last num}

begin
cfn:=random (9) +1;
	repeat
		csn:=random (9) +1;
	until csn <> cfn;
	repeat
		ctn:=random (9) +1;
	until (ctn <> cfn) and (ctn <> csn);
	repeat
		cln:=random (9) +1;
	until (cln <> cfn) and (cln <> csn) and (cln <> ctn);
end;

{-----------------Asks user for a number---------------------}

procedure user (var uinput:integer);

begin
write ('Enter a four digit number repeating none of the digits: ');
readln (uinput);
end;

{--------Divides 4 digit num into 4 seperate digits----------}

procedure seperate (var fn,sn,tn,ln:integer; ug:integer);

begin
  	fn:=ug div 1000;
	sn:=(ug div 100)mod 10;
	tn:=((ug div 10)mod 100)mod 10;
	ln:=((ug mod 1000)mod 100)mod 10;
end;

{------------Checks to see if all 4 numbers are different---------------}

procedure check (var checker:boolean; fn,sn,tn,ln,input:integer);

begin
if (fn=sn) or (fn=tn) or (fn=ln) or (sn=tn) or (sn=ln) or (tn=ln) or
(input>9876) then
	checker:=false
else
	checker:=True;
end;

{------------Compares User num to Computer num---------------}

procedure compare (fn,sn,tn,ln:integer; var ncorrect,pcorrect:integer);

begin
ncorrect:=0;
pcorrect:=0;
if (fn=cfn) or (fn=csn) or (fn=ctn) or (fn=cln) then
	ncorrect:=ncorrect+1;
if (sn=cfn) or (sn=csn) or (sn=ctn) or (sn=cln) then
	ncorrect:=ncorrect+1;
if (tn=cfn) or (tn=csn) or (tn=ctn) or (tn=cln) then
	ncorrect:=ncorrect+1;
if (ln=cfn) or (ln=csn) or (ln=ctn) or (ln=cln) then
	ncorrect:=ncorrect+1;

if fn = cfn then
	pcorrect:=pcorrect+1;
if sn = csn then
	pcorrect:=pcorrect+1;
if tn = ctn then
	pcorrect:=pcorrect+1;
if ln = cln then
	pcorrect:=pcorrect+1;
end;


{=================================================================}

begin
count:=0;
start;
clrscr;
randomize;
chec:=true;
write ('Would like a one player or two player game? ');
readln (ans);
if ans = 1 then
       	secretnum (cfn,csn,ctn,cln)
else
	begin
		repeat
		user (uinput);
		seperate (cfn,csn,ctn,cln,uinput);
		check (chec,cfn,csn,ctn,cln,uinput);
			if chec=false then
				begin
				writeln ('Sorry that is an invalid number.');
				writeln ('Number must not contain 2 of the same digit or more than 4 digits.');
				end;
		until chec=True;
                clrscr;
	end;
gotoxy (1,23);
writeln ('  Guess a 4 digit number');
writeln ('Using digits between 1 and 9', 'Correct Numbers':20,
'Correct Placement':26);
repeat
count:=count+1;
      repeat
     	 read (guess);
     	 seperate (ufn,usn,utn,uln,guess);
     	 check (chec,ufn,usn,utn,uln,guess);
    	 if chec=false then
				begin
				writeln ('Sorry that is an invalid number.');
				writeln ('Number must not contain 2 of the same digit or more than 4 digits.');
				end;
	  until chec=True;
	  compare (ufn,usn,utn,uln,ncor,pcor);
      gotoxy (10,24);
      write (ncor:32);
      writeln (pcor:25);
      until (ufn = cfn) and (usn = csn) and (utn = ctn) and (uln = cln);
writeln ('Congratulations, You Win.  The Number was ', cfn,csn,ctn,cln,'.');
writeln ('It took you ',count, ' guesses');
readln;
readln;
end.