home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG165.ARC / MMIND.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  6KB  |  208 lines
  1. program mastermind;
  2. label 870;
  3.  
  4. type
  5.   colors=(colorless,red,blue,brown,green,yellow,orange,space);
  6.   row=array [1..4] of colors;
  7.   eval = record
  8.          black,white:0..4
  9.          end;
  10.  
  11. var
  12.   evaluations: array [1..10] of eval;
  13.   rows: array [1..10] of row;
  14.   name: array[colors] of packed array [1..6] of char;
  15.   color: array [0..7] of colors;
  16.   redrow: row;
  17.   last: row;
  18.   version: 1..2;
  19.   maxcolor: orange..space;
  20.   i,j: integer;
  21.   ch: char;
  22.   done: boolean;
  23.  
  24. procedure printscreen;
  25. begin
  26.   done:=true;
  27.   writeln;
  28.   writeln('Mastermind is a logic game -');
  29.   writeln;
  30.   writeln('  In this version you are the code maker and the computer');
  31.   writeln('  the code breaker. At the beginning you form a code consisting');
  32.   writeln('  of 4 colors (e.g. RED,GREEN,RED,YELLOW ).');
  33.   writeln;
  34.   writeln('  The computer then attempts to deduce the code by guessing.');
  35.   writeln('  You then give the computer clues to indicate how close the');
  36.   writeln('  guess was to the code.');
  37.   writeln;
  38.   writeln('Press <RETURN> to continue');
  39.   readln(ch);
  40.   clrscr;
  41.   writeln;
  42.   writeln('  For every right color AND in the right position, the computer');
  43.   writeln('  gets a Black peg.');
  44.   writeln;
  45.   writeln('  For every color that is right BUT NOT in the right position,');
  46.   writeln('  the computer gets a White peg.');
  47.   writeln;
  48.   writeln('  For example if the code was :');
  49.   writeln;
  50.   writeln('    YELLOW  RED  RED  GREEN');
  51.   writeln;
  52.   writeln('  and the computer''s guess was :');
  53.   writeln;
  54.   writeln('    RED  RED  YELLOW  BLACK');
  55.   writeln;
  56.   writeln('  You would give the computer 1 Black peg (for the RED',
  57.              ' in position 2');
  58.   writeln('  and 2 White pegs (for RED and YELLOW) the correct colors');
  59.   writeln('  but in the wrong position.');
  60.   writeln;
  61.   writeln('  The computer is given 10 chances to deduce the code.');
  62.   writeln;
  63.   writeln('Press <RETURN> to continue');
  64.   read(kbd,ch);
  65.   clrscr;
  66. end;
  67.  
  68.  
  69. procedure initialization;
  70. var
  71.   c: colors;
  72.   i: 1..4;
  73.  
  74. begin
  75.   name[red] :='  RED ';   name[green] :=' GREEN';  name[yellow]:='YELLOW';
  76.   name[blue]:='  BLUE';   name[orange]:='ORANGE';  name[brown] :=' BROWN';
  77.   name[space]:=' SPACE';
  78.   for c:=colorless to space do
  79.     color[ord(c)]:=c;
  80.   for i:=1 to 4 do
  81.     redrow[i]:=red;
  82.   last:=redrow;
  83.   clrscr;
  84.   writeln(' ':17,'M A S T E R M I N D   C O D E B R E A K E R');
  85.   writeln;
  86.   writeln('Please be patient, sometimes I take a few minutes on my move.');
  87.   if not done then printscreen;
  88.   writeln;
  89.   writeln('Two versions are available:');
  90.   writeln;
  91.   writeln(' ':10,'Version (1) is easier with colors: red,green,yellow,blue,');
  92.   writeln(' ':45,'orange and brown');
  93.   writeln;
  94.   writeln(' ':10,'Version (2) is harder with the same colors + Space');
  95.   writeln;
  96.   repeat
  97.     write('Which version would you like (1 or 2) ? ');
  98.     readln(version);
  99.   until (version in [1..2]);
  100.   maxcolor:=color[version+5];
  101.   for i:=1 to 4 do rows[1,i]:=color[trunc((version+5)*random+1)];
  102. end;
  103.  
  104. procedure checkconsistency (hypothesis,previousrow:row;var e:eval);
  105. label 1090;
  106. var
  107.   j1,j2:integer;
  108.  
  109. begin
  110.   e.black:=0;
  111.   for j1:=1 to 4 do if hypothesis[j1]=previousrow[j1] then e.black:=e.black+1;
  112.   e.white:=0;
  113.   for j1:=1 to 4 do
  114.   begin
  115.     for j2:=1 to 4 do
  116.     if (j1<>j2) and (hypothesis[j1]<>previousrow[j1]) and
  117.                     (hypothesis[j2]<>previousrow[j2]) and
  118.                     (hypothesis[j1]= previousrow[j2]) then
  119.     begin
  120.       e.white:=e.white+1;
  121.       previousrow[j2]:=colorless;
  122.       goto 1090;
  123.     end;
  124.     1090:end
  125. end;
  126.  
  127. function formhypothesis:boolean;
  128. label 820;
  129. var
  130.   i1,i2,i3,i4:colors;
  131.   r:integer;
  132.   hyp:row;
  133.   eval1:eval;
  134.   viable,ok,ok2:boolean;
  135.  
  136. begin
  137.   viable:=true;
  138.   for i1:=last[1] to maxcolor do
  139.   for i2:=last[2] to maxcolor do
  140.   for i3:=last[3] to maxcolor do
  141.   for i4:=last[4] to maxcolor do
  142.   begin
  143.     last:=redrow;
  144.     hyp[1]:=i1; hyp[2]:=i2; hyp[3]:=i3; hyp[4]:=i4;
  145.     r:=0;
  146.     repeat
  147.       r:=r+1;
  148.       checkconsistency(hyp,rows[r],eval1);
  149.  
  150.       ok:= (eval1.black=evaluations[r].black)
  151.            and (eval1.white=evaluations[r].white);
  152.  
  153.     until (not ok) or (r=i);
  154.     ok2:= (hyp[1]=rows[1,1]) and (hyp[2]=rows[1,2])
  155.           and (hyp[3]=rows[1,3]) and (hyp[4]=rows[1,4]);
  156.     if ok then if (not ok2) then goto 820;
  157.   end;
  158.   viable:=false;
  159.   820: if viable then
  160.   begin
  161.     last:=hyp;
  162.     rows[i+1]:=hyp;
  163.   end
  164.  else
  165.   begin
  166.     writeln;
  167.     writeln('I have reached an impasse....');
  168.     writeln('Could you have made an error ?');
  169.   end;
  170.   formhypothesis:=viable
  171. end;
  172.  
  173. begin
  174.   done:=false;
  175.   repeat
  176.     initialization;
  177.     for i:=1 to 9 do
  178.     begin
  179.       writeln;
  180.       writeln('My move for row',i:2,' is ');
  181.       for j:=1 to 4 do
  182.       write(name[rows[i,j]]:8);
  183.       writeln;
  184.       write('How many black pegs ? ');
  185.       readln(evaluations[i].black);
  186.       if evaluations[i].black = 4 then
  187.       begin
  188.         writeln;
  189.         writeln('Thanks for the game');
  190.         goto 870
  191.       end;
  192.       if evaluations[i].black=3 then evaluations[i].white:=0
  193.       else
  194.       begin
  195.         write('How many white pegs ? ');
  196.         readln(evaluations[i].white)
  197.       end;
  198.       if not formhypothesis then goto 870
  199.     end;
  200.     writeln('I am STUMPED --- you win !!');
  201.     870:
  202.     repeat
  203.       write('Another game ?');
  204.       readln(ch)
  205.     until upcase(ch) in ['Y','N'];
  206.   until upcase(ch)='N';
  207. end.
  208.