
(********************************************************************)
(*                                                                  *)
(*  mind.sd7      Guess a four digit number game                    *)
(*  Copyright (C) 1991, 1992, 1993, 1994, 2004  Thomas Mertes       *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "stdio.s7i";

var integer: initial_try is 0;

const type: guess is new struct
    var integer: digit1 is 0;
    var integer: digit2 is 0;
    var integer: digit3 is 0;
    var integer: digit4 is 0;
    var integer: right_place is 0;
    var integer: wrong_place is 0;
  end struct;

const guess: GUESS_REC is guess.value;

var array guess: guesses is 0 times GUESS_REC;


const proc: read_number (in string: prompt, in integer: low, in integer: up,
    inout integer: number, inout boolean: quit) is func
  local
    var string: stri is "";
    var boolean: okay is TRUE;
  begin
    repeat
      okay := TRUE;
      write(prompt);
      readln(stri);
      if stri = "" and low <= 0 and up >= 0 then
        number := 0;
      elsif upper(stri) = "Q" then
        quit := TRUE;
      else
        block
          number := integer parse stri;
          if number < low or number > up then
            writeln("This number is not between " <& low <& " and " <& up <& ".");
            okay := FALSE;
          end if;
        exception
          catch RANGE_ERROR:
            writeln("\"" <& stri <& "\" is not a number.");
            okay := FALSE;
        end block;
      end if;
    until okay;
  end func;


const func guess: question (in integer: num, inout boolean: quit) is func
  result
    var guess: new_guess is GUESS_REC;
  local
    var string: stri is "";
  begin
    new_guess := GUESS_REC;
    new_guess.digit1 := num rem 10;
    new_guess.digit2 := (num div 10) rem 10;
    new_guess.digit3 := (num div 100) rem 10;
    new_guess.digit4 := num div 1000;
    writeln("I guess " <& num);
    read_number("How many digits are right and at the right place? ",
        0, 4, new_guess.right_place, quit);
    if not quit then
      read_number("How many digits are right but at the wrong place? ",
          0, 4, new_guess.wrong_place, quit);
    end if;
  end func;


const proc: compare (in integer: try, in integer: solution, inout integer: right, inout integer: wrong) is func
  local
    var integer: t_digit1 is 0;
    var integer: t_digit2 is 0;
    var integer: t_digit3 is 0;
    var integer: t_digit4 is 0;
    var integer: s_digit1 is 0;
    var integer: s_digit2 is 0;
    var integer: s_digit3 is 0;
    var integer: s_digit4 is 0;
  begin
    t_digit1 := try rem 10;
    t_digit2 := (try div 10) rem 10;
    t_digit3 := (try div 100) rem 10;
    t_digit4 := try div 1000;
    s_digit1 := solution rem 10;
    s_digit2 := (solution div 10) rem 10;
    s_digit3 := (solution div 100) rem 10;
    s_digit4 := solution div 1000;
    right := 0;
    if t_digit1 = s_digit1 then
      incr(right);
      t_digit1 := 10;
      s_digit1 := 11;
    end if;
    if t_digit2 = s_digit2 then
      incr(right);
      t_digit2 := 10;
      s_digit2 := 11;
    end if;
    if t_digit3 = s_digit3 then
      incr(right);
      t_digit3 := 10;
      s_digit3 := 11;
    end if;
    if t_digit4 = s_digit4 then
      incr(right);
      t_digit4 := 10;
      s_digit4 := 11;
    end if;
    wrong := 0;
    if t_digit1 = s_digit2 then
      incr(wrong);
      s_digit2 := 11;
    elsif t_digit1 = s_digit3 then
      incr(wrong);
      s_digit3 := 11;
    elsif t_digit1 = s_digit4 then
      incr(wrong);
      s_digit4 := 11;
    end if;
    if t_digit2 = s_digit1 then
      incr(wrong);
      s_digit1 := 11;
    elsif t_digit2 = s_digit3 then
      incr(wrong);
      s_digit3 := 11;
    elsif t_digit2 = s_digit4 then
      incr(wrong);
      s_digit4 := 11;
    end if;
    if t_digit3 = s_digit1 then
      incr(wrong);
      s_digit1 := 11;
    elsif t_digit3 = s_digit2 then
      incr(wrong);
      s_digit2 := 11;
    elsif t_digit3 = s_digit4 then
      incr(wrong);
    end if;
    if t_digit4 = s_digit1 then
      incr(wrong);
    elsif t_digit4 = s_digit2 then
      incr(wrong);
    elsif t_digit4 = s_digit3 then
      incr(wrong);
    end if;
  end func;


const func boolean: legal (in integer: try_digit1, in integer: try_digit2, in integer: try_digit3, in integer: try_digit4) is func
  result
    var boolean: result is TRUE;
  local
    var integer: index is 1;
    var integer: leng is 0;
    var guess: guess_ref is GUESS_REC;
    var integer: t_digit1 is 0;
    var integer: t_digit2 is 0;
    var integer: t_digit3 is 0;
    var integer: t_digit4 is 0;
    var integer: s_digit1 is 0;
    var integer: s_digit2 is 0;
    var integer: s_digit3 is 0;
    var integer: s_digit4 is 0;
    var integer: right is 0;
    var integer: wrong is 0;
  begin
    leng := length(guesses);
    while result and index <= leng do
      t_digit1 := try_digit1;
      t_digit2 := try_digit2;
      t_digit3 := try_digit3;
      t_digit4 := try_digit4;
      guess_ref := guesses[index];
      s_digit1 := guess_ref.digit1;
      s_digit2 := guess_ref.digit2;
      s_digit3 := guess_ref.digit3;
      s_digit4 := guess_ref.digit4;
      right := 0;
      if t_digit1 = s_digit1 then
        incr(right);
        t_digit1 := 10;
        s_digit1 := 11;
      end if;
      if t_digit2 = s_digit2 then
        incr(right);
        t_digit2 := 10;
        s_digit2 := 11;
      end if;
      if t_digit3 = s_digit3 then
        incr(right);
        t_digit3 := 10;
        s_digit3 := 11;
      end if;
      if t_digit4 = s_digit4 then
        incr(right);
        t_digit4 := 10;
        s_digit4 := 11;
      end if;
      if right <> guess_ref.right_place then
        result := FALSE;
      else
        wrong := 0;
        if t_digit1 = s_digit2 then
          incr(wrong);
          s_digit2 := 11;
        elsif t_digit1 = s_digit3 then
          incr(wrong);
          s_digit3 := 11;
        elsif t_digit1 = s_digit4 then
          incr(wrong);
          s_digit4 := 11;
        end if;
        if t_digit2 = s_digit1 then
          incr(wrong);
          s_digit1 := 11;
        elsif t_digit2 = s_digit3 then
          incr(wrong);
          s_digit3 := 11;
        elsif t_digit2 = s_digit4 then
          incr(wrong);
          s_digit4 := 11;
        end if;
        if t_digit3 = s_digit1 then
          incr(wrong);
          s_digit1 := 11;
        elsif t_digit3 = s_digit2 then
          incr(wrong);
          s_digit2 := 11;
        elsif t_digit3 = s_digit4 then
          incr(wrong);
        end if;
        if t_digit4 = s_digit1 then
          incr(wrong);
        elsif t_digit4 = s_digit2 then
          incr(wrong);
        elsif t_digit4 = s_digit3 then
          incr(wrong);
        end if;
        if wrong <> guess_ref.wrong_place then
          result := FALSE;
        end if;
      end if;
(*    write(str(try_digit4) & str(try_digit3) & str(try_digit2) & str(try_digit1));
      write(" " & (right lpad 2) & (wrong lpad 2) & " ");
      write(str(guess_ref.digit4) & str(guess_ref.digit3) & str(guess_ref.digit2) & str(guess_ref.digit1));
      writeln(" " & (guess_ref.right_place lpad 2) & (guess_ref.wrong_place lpad 2)); *)
      incr(index);
    end while;
  end func;


const proc: search_try (inout integer: try) is func
  begin
    write("Thinking .");
    flush(OUT);
    repeat
      try +:= 37;
      if try > 9999 then
        try -:= 9000;
        write(".");
        flush(OUT);
      end if;
    until legal(try rem 10, (try div 10) rem 10,
        (try div 100) rem 10, try div 1000) or try = initial_try;
    writeln;
  end func;


const proc: verify (in integer: solution) is func
  local
    var boolean: searching is TRUE;
    var integer: index is 0;
    var integer: leng is 0;
    var guess: guess_ref is GUESS_REC;
    var integer: right is 0;
    var integer: wrong is 0;
    var integer: try is 0;
  begin
    if solution < 1000 or solution > 9999 then
      writeln("This number is not between 1000 and 9999.");
    else
      leng := length(guesses);
      while searching and index < leng do
        incr(index);
        guess_ref := guesses[index];
        try := guess_ref.digit4 * 1000 + guess_ref.digit3 * 100 +
            guess_ref.digit2 * 10 + guess_ref.digit1;
        compare(try, solution, right, wrong);
        if right <> guess_ref.right_place or wrong <> guess_ref.wrong_place then
          searching := FALSE;
        end if;
      end while;
      writeln("When I guessed " <& try <& " your answer was " <&
              guess_ref.right_place <& " " <& guess_ref.wrong_place <& ".");
      writeln("But the correct answer was " <& right <& " " <& wrong <& ".");
    end if;
  end func;


const proc: round_computer_guesses is func
  local
    var integer: current_try is 0;
    var guess: current_guess is GUESS_REC;
    var boolean: quit_round is FALSE;
  begin
    writeln;
    writeln("Think of a four digit number (between 1000 and 9999).");
    writeln("Press ENTER if you have the number ");
    readln;
    guesses := 0 times GUESS_REC;
    initial_try := rand(1000, 9999);
    current_try := initial_try;
    current_guess := question(current_try, quit_round);
    if not quit_round then
      if current_guess.right_place <> 4 then
        repeat
          guesses := guesses & [](current_guess);
          search_try(current_try);
          if current_try <> initial_try then
            current_guess := question(current_try, quit_round);
          end if;
        until current_guess.right_place = 4 or
            current_try = initial_try or quit_round;
        if not quit_round then
          writeln;
          if current_guess.right_place = 4 then
            writeln("I guessed it in " <& length(guesses) + 1 <& " tries.");
          else
            writeln("This is not possible.");
            writeln("Some of your answers must be wrong.");
            write("Please enter your number for verification ");
            current_try := 0;
            readln(current_try);
            verify(current_try);
          end if;
        end if;
      else
        writeln;
        writeln("I guessed it immediately, how lucky!");
      end if;
    end if;
  end func;


const proc: round_human_guesses is func
  local
    var integer: secret_number is 0;
    var integer: current_try is 0;
    var integer: right is 0;
    var integer: wrong is 0;
    var integer: number_of_tries is 0;
    var boolean: quit_round is FALSE;
  begin
    writeln;
    writeln("Guess my secret four digit number (between 1000 and 9999).");
    writeln;
    secret_number := rand(1000, 9999);
    number_of_tries := 0;
    repeat
      read_number("Your guess? ", 1000, 9999, current_try, quit_round);
      if not quit_round then
        incr(number_of_tries);
        compare(current_try, secret_number, right, wrong);
        writeln(right <& " digits are right and at the right place.");
        writeln(wrong <& " digits are right but at the wrong place.");
      end if;
    until right = 4 or quit_round;
    writeln;
    if quit_round then
      writeln("The secret number was " <& secret_number <& ".");
    else
      if number_of_tries > 1 then
        writeln("You guessed it in " <& number_of_tries <& " tries.");
      else
        writeln("You guessed it immediately, how lucky!");
      end if;
    end if;
  end func;


const proc: main is func
  local
    var string: answer is " ";
  begin
    writeln;
    writeln("MIND - Guess a four digit number.");
    repeat
      repeat
        writeln;
        write("Who should guess (Computer/Human/Quit)? ");
        readln(answer);
        answer := upper(answer);
      until answer = "C" or answer = "H" or answer = "Q";
      if answer = "C" then
        repeat
          round_computer_guesses;
          repeat
            write("Should the computer guess another number (Y/N)? ");
            readln(answer);
            answer := upper(answer);
          until answer = "Y" or answer = "N" or answer = "Q";
        until answer = "N" or answer = "Q";
      elsif answer = "H" then
        repeat
          round_human_guesses;
          repeat
            write("Do you want to guess another number (Y/N)? ");
            readln(answer);
            answer := upper(answer);
          until answer = "Y" or answer = "N" or answer = "Q";
        until answer = "N" or answer = "Q";
      end if;
    until answer = "Q";
    writeln("Goodbye");
  end func;
