Sign In
Create Account
Follow Us on Twitter
Subscribe on Youtube
1
program mastermind;
uses crt;
{ Master Mind generates a set of four digits from 0 to 9. The user is then
allowed to guess what the set of digits is. For every correct guess that
is in the correct position, a "2" will be displayed. For every correct
guess in the wrong position, a "1" will be displayed. For every wrong
guess, a "0" will be displayed. The user wins when four "2"s are
displayed. The user then has the option to play again. }
const
maxguesses=20;
maxdigits=10;
type
guesstype=array[1..maxdigits] of integer;
var
computerset,guess:guesstype;
maxnums,guesses:integer;
done,won:boolean;
{ ------------------------------------------------------------------------- }
procedure instruct;
{ Allows the user to have instructions to be printed to the screen. }
var
yn:char;
begin
clrscr;
repeat
write('Do you want instructions (Y/N)? ');readln(yn);
yn:=upcase(yn);
until yn in ['Y','N'];
if yn='Y' then
begin
clrscr;
writeln(' Master Mind generates a set of 1 to 10 digits from 0 to 9. You are then');
writeln('allowed ',maxguesses,' guesses to find the set of digits. For every correct guess that is');
writeln('in the correct position, a "2" will be displayed. For every correct guess in');
writeln('the wrong position, a "1" will be displayed. For every wrong guess, a "0"');
writeln('will be displayed. The you win when four "2"s are displayed. You then have');
writeln('the option to play again. Guesses are entered by typing the numbers in the');
writeln('order that you think the computer has them in. BACKSPACE lets you change a');
writeln('guess and ENTER lets you state that you have made your guess. If, while');
writeln('entering a guess, you want to make some notes, press RIGHT ARROW to enter the');
writeln('notemaking space on the right-hand part of the screen. Use the arrow keys to');
writeln('move around and the numbers 0 through 9 and SPACE to make changes. Press ENTER');
writeln('to return to making your guess.');
writeln;
writeln('Disclaimer, this game is NOT endorsed by ------------');
writeln;
writeln('Press ENTER to continue.');
readln;
end;
end; { instruct }
{ ------------------------------------------------------------------------- }
procedure generate(var comp:guesstype;var max:integer);
var
j,i:integer;
user:char;
begin
repeat
clrscr;
write('How many digits do you want (1 to ',maxdigits,')? ');readln(max);
until (max>0) and (max<=maxdigits);
repeat
clrscr;
write('Do you want the note section to have blank or filled (B/F)? ');readln(user);
user:=upcase(user);
until user in ['B','F'];
clrscr;
for i:=1 to max do
comp[i]:=random(10);
if user='F' then
for i:=0 to 9 do
begin
gotoxy(50,i+1);
for j:=1 to max do
write(i,' ');
end
else
for i:=0 to 9 do
begin
gotoxy(50,i+1);
for j:=1 to max do
write('* ');
end;
gotoxy(1,1);
end; { generate }
{ ------------------------------------------------------------------------- }
procedure input(var ch:integer;var bool:boolean);
{ This is a universal input routine for inputing data from the keyboard. The
boolean checks for function keys and other special keys. Ch stores the
ASCII code for the character. }
begin
ch:=ord(readkey);
if ch=0 then
begin
bool:=true;
ch:=ord(readkey);
end
else
bool:=false;
end; { input }
{ ------------------------------------------------------------------------- }
procedure analyze(lim:integer);
{ Allows the user to test data in a visible way. }
var
done,arrow:boolean;
x,y,result:integer;
begin
x:=50;
y:=1;
done:=false;
repeat
gotoxy(x,y);
input(result,arrow);
if (arrow and(result in [72,75,77,80])) then
case result of
72:if y<>1 then y:=y-1 else y:=10;
75:if x<>50 then x:=x-2 else x:=48+2*lim;
77:if x<>48+2*lim then x:=x+2 else x:=50;
80:if y<>10 then y:=y+1 else y:=1;
end { case }
else if (not arrow and (result in [ord(' '),ord('0')..ord('9')])) then
begin
if result<>ord(' ') then
write(chr(result))
else
write('*');
end
else if (not arrow and (result=13)) then
done:=true;
until done;
end;
{ ------------------------------------------------------------------------- }
procedure makeguess(var try:guesstype;var tries:integer;max:integer);
{ Allows the user to make a guess. }
var
i,j,temptry:integer;
special,guessmade,ready:boolean;
begin
for i:=1 to max do
try[i]:=-1;
tries:=tries+1;
write('Make guess ');
if tries<10 then
write('0',tries,': ')
else
write(tries,': ');
i:=1;
guessmade:=false;
repeat
input(temptry,special);
if not(special) and (temptry in [8,13,ord('0')..ord('9')]) then
begin
case temptry of
8:if i<>1 then
begin
i:=i-1;
write(chr(temptry));
write(chr(temptry));
end;
13:begin
ready:=true;
for j:=1 to max do
if try[j]=-1 then ready:=false;
if ready then
begin
guessmade:=true;
end;
end;
ord('0')..ord('9'):if i<>max+1 then
begin
try[i]:=ord(temptry)-ord('0');
write(chr(temptry));
if i<>max then write(',')
else write(chr(8));
if i<>max then i:=i+1;
end;
end; { case }
end;
if special and (temptry in [77]) then
begin
analyze(max);
gotoxy(16,tries);
i:=1;
end;
until guessmade;
end; { guess }
{ ------------------------------------------------------------------------- }
procedure evaluate(try,actual:guesstype;var allcorrect:boolean;tries,max:integer);
var
i,j,rights:integer;
begin
gotoxy(15+2*max,tries);
write(' ');
rights:=0;
for i:=1 to max do
if try[i]=actual[i] then
begin
write('2');
try[i]:=-1;
actual[i]:=-2;
rights:=rights+1;
end;
for i:=1 to max do
for j:=1 to max do
if try[i]=actual[j] then
begin
write('1');
try[i]:=-1;
actual[j]:=-2;
end;
for i:=1 to max do
if try[i]<>-1 then
write('0');
writeln(' ');
if rights=max then
begin
writeln('You won in only ',guesses,' tries.');
writeln;
writeln('Press ENTER to continue');
allcorrect:=true;
readln;
end
else if tries=maxguesses then
begin
writeln('Sorry, you lost!');
write(' The code is:');
for i:=1 to max do
write(computerset[i]:2);
writeln;
writeln;
writeln('Press ENTER to continue');
readln;
end;
end; { evaluate }
{ ------------------------------------------------------------------------- }
procedure quit(var bool:boolean);
var
yn:char;
begin
clrscr;
repeat
write('Do you want to quit (Y/N)? ');readln(yn);
yn:=upcase(yn);
until yn in ['Y','N'];
if yn='Y' then bool:=true else bool:=false;
end; { done }
{ ========================================================================= }
begin
randomize;
instruct;
repeat
generate(computerset,maxnums);
won:=false;
guesses:=0;
repeat
makeguess(guess,guesses,maxnums);
evaluate(guess,computerset,won,guesses,maxnums);
until won or (guesses=maxguesses);
quit(done);
until done;
end.
Note: you can download Turbo Pascal 5.5 here:Download Turbo Pascal, Turbo Pascal 5.5 Download or Antique Software: Turbo Pascal v5.5
No replies to this topic
#1
Posted 05 December 2009 - 07:03 AM
WingedPanther
-
- Moderators
-
- 16,831 posts
A spammer's worst nightmare
- Location:Upstate, South Carolina
- Programming Language:C, C++, PL/SQL, Delphi/Object Pascal, Pascal, Transact-SQL, Others
- Learning:Java, C#, PHP, JavaScript, Lisp, Fortran, Haskell, Others
I was digging around in my room when I found an old floppy disk (3.5", 1.44 MB!) from when I was in school... We're talking 1990. Here's the Master Mind program I wrote :)
Back to top|
|
|
1 user(s) are reading this topic
0 members, 1 guests, 0 anonymous users
