1 2(********************************************************************) 3(* *) 4(* mind.sd7 Guess a four digit number game *) 5(* Copyright (C) 1991, 1992, 1993, 1994, 2004 Thomas Mertes *) 6(* *) 7(* This program is free software; you can redistribute it and/or *) 8(* modify it under the terms of the GNU General Public License as *) 9(* published by the Free Software Foundation; either version 2 of *) 10(* the License, or (at your option) any later version. *) 11(* *) 12(* This program is distributed in the hope that it will be useful, *) 13(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 14(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 15(* GNU General Public License for more details. *) 16(* *) 17(* You should have received a copy of the GNU General Public *) 18(* License along with this program; if not, write to the *) 19(* Free Software Foundation, Inc., 51 Franklin Street, *) 20(* Fifth Floor, Boston, MA 02110-1301, USA. *) 21(* *) 22(********************************************************************) 23 24 25$ include "seed7_05.s7i"; 26 include "stdio.s7i"; 27 28var integer: initial_try is 0; 29 30const type: guess is new struct 31 var integer: digit1 is 0; 32 var integer: digit2 is 0; 33 var integer: digit3 is 0; 34 var integer: digit4 is 0; 35 var integer: right_place is 0; 36 var integer: wrong_place is 0; 37 end struct; 38 39const guess: GUESS_REC is guess.value; 40 41var array guess: guesses is 0 times GUESS_REC; 42 43 44const proc: read_number (in string: prompt, in integer: low, in integer: up, 45 inout integer: number, inout boolean: quit) is func 46 local 47 var string: stri is ""; 48 var boolean: okay is TRUE; 49 begin 50 repeat 51 okay := TRUE; 52 write(prompt); 53 readln(stri); 54 if stri = "" and low <= 0 and up >= 0 then 55 number := 0; 56 elsif upper(stri) = "Q" then 57 quit := TRUE; 58 else 59 block 60 number := integer(stri); 61 if number < low or number > up then 62 writeln("This number is not between " <& low <& " and " <& up <& "."); 63 okay := FALSE; 64 end if; 65 exception 66 catch RANGE_ERROR: 67 writeln("\"" <& stri <& "\" is not a number."); 68 okay := FALSE; 69 end block; 70 end if; 71 until okay; 72 end func; 73 74 75const func guess: question (in integer: num, inout boolean: quit) is func 76 result 77 var guess: new_guess is GUESS_REC; 78 local 79 var string: stri is ""; 80 begin 81 new_guess := GUESS_REC; 82 new_guess.digit1 := num rem 10; 83 new_guess.digit2 := (num div 10) rem 10; 84 new_guess.digit3 := (num div 100) rem 10; 85 new_guess.digit4 := num div 1000; 86 writeln("I guess " <& num); 87 read_number("How many digits are right and at the right place? ", 88 0, 4, new_guess.right_place, quit); 89 if not quit then 90 read_number("How many digits are right but at the wrong place? ", 91 0, 4, new_guess.wrong_place, quit); 92 end if; 93 end func; 94 95 96const proc: compare (in integer: try, in integer: solution, inout integer: right, inout integer: wrong) is func 97 local 98 var integer: t_digit1 is 0; 99 var integer: t_digit2 is 0; 100 var integer: t_digit3 is 0; 101 var integer: t_digit4 is 0; 102 var integer: s_digit1 is 0; 103 var integer: s_digit2 is 0; 104 var integer: s_digit3 is 0; 105 var integer: s_digit4 is 0; 106 begin 107 t_digit1 := try rem 10; 108 t_digit2 := (try div 10) rem 10; 109 t_digit3 := (try div 100) rem 10; 110 t_digit4 := try div 1000; 111 s_digit1 := solution rem 10; 112 s_digit2 := (solution div 10) rem 10; 113 s_digit3 := (solution div 100) rem 10; 114 s_digit4 := solution div 1000; 115 right := 0; 116 if t_digit1 = s_digit1 then 117 incr(right); 118 t_digit1 := 10; 119 s_digit1 := 11; 120 end if; 121 if t_digit2 = s_digit2 then 122 incr(right); 123 t_digit2 := 10; 124 s_digit2 := 11; 125 end if; 126 if t_digit3 = s_digit3 then 127 incr(right); 128 t_digit3 := 10; 129 s_digit3 := 11; 130 end if; 131 if t_digit4 = s_digit4 then 132 incr(right); 133 t_digit4 := 10; 134 s_digit4 := 11; 135 end if; 136 wrong := 0; 137 if t_digit1 = s_digit2 then 138 incr(wrong); 139 s_digit2 := 11; 140 elsif t_digit1 = s_digit3 then 141 incr(wrong); 142 s_digit3 := 11; 143 elsif t_digit1 = s_digit4 then 144 incr(wrong); 145 s_digit4 := 11; 146 end if; 147 if t_digit2 = s_digit1 then 148 incr(wrong); 149 s_digit1 := 11; 150 elsif t_digit2 = s_digit3 then 151 incr(wrong); 152 s_digit3 := 11; 153 elsif t_digit2 = s_digit4 then 154 incr(wrong); 155 s_digit4 := 11; 156 end if; 157 if t_digit3 = s_digit1 then 158 incr(wrong); 159 s_digit1 := 11; 160 elsif t_digit3 = s_digit2 then 161 incr(wrong); 162 s_digit2 := 11; 163 elsif t_digit3 = s_digit4 then 164 incr(wrong); 165 end if; 166 if t_digit4 = s_digit1 then 167 incr(wrong); 168 elsif t_digit4 = s_digit2 then 169 incr(wrong); 170 elsif t_digit4 = s_digit3 then 171 incr(wrong); 172 end if; 173 end func; 174 175 176const func boolean: legal (in integer: try_digit1, in integer: try_digit2, in integer: try_digit3, in integer: try_digit4) is func 177 result 178 var boolean: legal is TRUE; 179 local 180 var integer: index is 1; 181 var integer: leng is 0; 182 var guess: guess_ref is GUESS_REC; 183 var integer: t_digit1 is 0; 184 var integer: t_digit2 is 0; 185 var integer: t_digit3 is 0; 186 var integer: t_digit4 is 0; 187 var integer: s_digit1 is 0; 188 var integer: s_digit2 is 0; 189 var integer: s_digit3 is 0; 190 var integer: s_digit4 is 0; 191 var integer: right is 0; 192 var integer: wrong is 0; 193 begin 194 leng := length(guesses); 195 while legal and index <= leng do 196 t_digit1 := try_digit1; 197 t_digit2 := try_digit2; 198 t_digit3 := try_digit3; 199 t_digit4 := try_digit4; 200 guess_ref := guesses[index]; 201 s_digit1 := guess_ref.digit1; 202 s_digit2 := guess_ref.digit2; 203 s_digit3 := guess_ref.digit3; 204 s_digit4 := guess_ref.digit4; 205 right := 0; 206 if t_digit1 = s_digit1 then 207 incr(right); 208 t_digit1 := 10; 209 s_digit1 := 11; 210 end if; 211 if t_digit2 = s_digit2 then 212 incr(right); 213 t_digit2 := 10; 214 s_digit2 := 11; 215 end if; 216 if t_digit3 = s_digit3 then 217 incr(right); 218 t_digit3 := 10; 219 s_digit3 := 11; 220 end if; 221 if t_digit4 = s_digit4 then 222 incr(right); 223 t_digit4 := 10; 224 s_digit4 := 11; 225 end if; 226 if right <> guess_ref.right_place then 227 legal := FALSE; 228 else 229 wrong := 0; 230 if t_digit1 = s_digit2 then 231 incr(wrong); 232 s_digit2 := 11; 233 elsif t_digit1 = s_digit3 then 234 incr(wrong); 235 s_digit3 := 11; 236 elsif t_digit1 = s_digit4 then 237 incr(wrong); 238 s_digit4 := 11; 239 end if; 240 if t_digit2 = s_digit1 then 241 incr(wrong); 242 s_digit1 := 11; 243 elsif t_digit2 = s_digit3 then 244 incr(wrong); 245 s_digit3 := 11; 246 elsif t_digit2 = s_digit4 then 247 incr(wrong); 248 s_digit4 := 11; 249 end if; 250 if t_digit3 = s_digit1 then 251 incr(wrong); 252 s_digit1 := 11; 253 elsif t_digit3 = s_digit2 then 254 incr(wrong); 255 s_digit2 := 11; 256 elsif t_digit3 = s_digit4 then 257 incr(wrong); 258 end if; 259 if t_digit4 = s_digit1 then 260 incr(wrong); 261 elsif t_digit4 = s_digit2 then 262 incr(wrong); 263 elsif t_digit4 = s_digit3 then 264 incr(wrong); 265 end if; 266 if wrong <> guess_ref.wrong_place then 267 legal := FALSE; 268 end if; 269 end if; 270(* write(str(try_digit4) & str(try_digit3) & str(try_digit2) & str(try_digit1)); 271 write(" " & (right lpad 2) & (wrong lpad 2) & " "); 272 write(str(guess_ref.digit4) & str(guess_ref.digit3) & str(guess_ref.digit2) & str(guess_ref.digit1)); 273 writeln(" " & (guess_ref.right_place lpad 2) & (guess_ref.wrong_place lpad 2)); *) 274 incr(index); 275 end while; 276 end func; 277 278 279const proc: search_try (inout integer: try) is func 280 begin 281 write("Thinking ."); 282 flush(OUT); 283 repeat 284 try +:= 37; 285 if try > 9999 then 286 try -:= 9000; 287 write("."); 288 flush(OUT); 289 end if; 290 until legal(try rem 10, (try div 10) rem 10, 291 (try div 100) rem 10, try div 1000) or try = initial_try; 292 writeln; 293 end func; 294 295 296const proc: verify (in integer: solution) is func 297 local 298 var boolean: searching is TRUE; 299 var integer: index is 0; 300 var integer: leng is 0; 301 var guess: guess_ref is GUESS_REC; 302 var integer: right is 0; 303 var integer: wrong is 0; 304 var integer: try is 0; 305 begin 306 if solution < 1000 or solution > 9999 then 307 writeln("This number is not between 1000 and 9999."); 308 else 309 leng := length(guesses); 310 while searching and index < leng do 311 incr(index); 312 guess_ref := guesses[index]; 313 try := guess_ref.digit4 * 1000 + guess_ref.digit3 * 100 + 314 guess_ref.digit2 * 10 + guess_ref.digit1; 315 compare(try, solution, right, wrong); 316 if right <> guess_ref.right_place or wrong <> guess_ref.wrong_place then 317 searching := FALSE; 318 end if; 319 end while; 320 writeln("When I guessed " <& try <& " your answer was " <& 321 guess_ref.right_place <& " " <& guess_ref.wrong_place <& "."); 322 writeln("But the correct answer was " <& right <& " " <& wrong <& "."); 323 end if; 324 end func; 325 326 327const proc: round_computer_guesses is func 328 local 329 var integer: current_try is 0; 330 var guess: current_guess is GUESS_REC; 331 var boolean: quit_round is FALSE; 332 begin 333 writeln; 334 writeln("Think of a four digit number (between 1000 and 9999)."); 335 writeln("Press ENTER if you have the number "); 336 readln; 337 guesses := 0 times GUESS_REC; 338 initial_try := rand(1000, 9999); 339 current_try := initial_try; 340 current_guess := question(current_try, quit_round); 341 if not quit_round then 342 if current_guess.right_place <> 4 then 343 repeat 344 guesses := guesses & [](current_guess); 345 search_try(current_try); 346 if current_try <> initial_try then 347 current_guess := question(current_try, quit_round); 348 end if; 349 until current_guess.right_place = 4 or 350 current_try = initial_try or quit_round; 351 if not quit_round then 352 writeln; 353 if current_guess.right_place = 4 then 354 writeln("I guessed it in " <& length(guesses) + 1 <& " tries."); 355 else 356 writeln("This is not possible."); 357 writeln("Some of your answers must be wrong."); 358 write("Please enter your number for verification "); 359 current_try := 0; 360 readln(current_try); 361 verify(current_try); 362 end if; 363 end if; 364 else 365 writeln; 366 writeln("I guessed it immediately, how lucky!"); 367 end if; 368 end if; 369 end func; 370 371 372const proc: round_human_guesses is func 373 local 374 var integer: secret_number is 0; 375 var integer: current_try is 0; 376 var integer: right is 0; 377 var integer: wrong is 0; 378 var integer: number_of_tries is 0; 379 var boolean: quit_round is FALSE; 380 begin 381 writeln; 382 writeln("Guess my secret four digit number (between 1000 and 9999)."); 383 writeln; 384 secret_number := rand(1000, 9999); 385 number_of_tries := 0; 386 repeat 387 read_number("Your guess? ", 1000, 9999, current_try, quit_round); 388 if not quit_round then 389 incr(number_of_tries); 390 compare(current_try, secret_number, right, wrong); 391 writeln(right <& " digits are right and at the right place."); 392 writeln(wrong <& " digits are right but at the wrong place."); 393 end if; 394 until right = 4 or quit_round; 395 writeln; 396 if quit_round then 397 writeln("The secret number was " <& secret_number <& "."); 398 else 399 if number_of_tries > 1 then 400 writeln("You guessed it in " <& number_of_tries <& " tries."); 401 else 402 writeln("You guessed it immediately, how lucky!"); 403 end if; 404 end if; 405 end func; 406 407 408const proc: main is func 409 local 410 var string: answer is " "; 411 begin 412 writeln; 413 writeln("MIND - Guess a four digit number."); 414 repeat 415 repeat 416 writeln; 417 write("Who should guess (Computer/Human/Quit)? "); 418 readln(answer); 419 answer := upper(answer); 420 until answer = "C" or answer = "H" or answer = "Q"; 421 if answer = "C" then 422 repeat 423 round_computer_guesses; 424 repeat 425 write("Should the computer guess another number (Y/N)? "); 426 readln(answer); 427 answer := upper(answer); 428 until answer = "Y" or answer = "N" or answer = "Q"; 429 until answer = "N" or answer = "Q"; 430 elsif answer = "H" then 431 repeat 432 round_human_guesses; 433 repeat 434 write("Do you want to guess another number (Y/N)? "); 435 readln(answer); 436 answer := upper(answer); 437 until answer = "Y" or answer = "N" or answer = "Q"; 438 until answer = "N" or answer = "Q"; 439 end if; 440 until answer = "Q"; 441 writeln("Goodbye"); 442 end func; 443