1 2(********************************************************************) 3(* *) 4(* pac.sd7 Pacman game *) 5(* Copyright (C) 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 "console.s7i"; 27 include "window.s7i"; 28 include "keybd.s7i"; 29 include "float.s7i"; 30 include "time.s7i"; 31 include "duration.s7i"; 32 33 34var text: scr is STD_NULL; 35var text: labyrinth is STD_NULL; 36var text: info_sheet is STD_NULL; 37 38const type: place_type is new enum 39 FREE_PLACE, DOT_PLACE, WALL_PLACE, POWER_PLACE 40 end enum; 41 42const string: str(DOT_PLACE) is "."; 43const string: str(POWER_PLACE) is "*"; 44const string: str(FREE_PLACE) is " "; 45const string: str(WALL_PLACE) is "#"; 46 47const func string: str (in place_type: aPlace) is DYNAMIC; 48 49enable_output(place_type); 50 51const type: direct_type is new enum 52 NOWHERE, RIGHTWARD, LEFTWARD, UPWARD, DOWNWARD 53 end enum; 54 55const type: pacman_type is new object struct 56 var integer: line is 0; 57 var integer: column is 0; 58 var integer: line_move is 0; 59 var integer: column_move is 0; 60 end struct; 61 62var pacman_type: PACMAN is pacman_type.value; 63 64const string: str (in pacman_type: pacman) is "P"; 65 66enable_output(pacman_type); 67 68const type: ghost_struct is new object struct 69 var integer: line is 0; 70 var integer: column is 0; 71 var integer: line_move is 0; 72 var integer: column_move is 0; 73 var boolean: at_home is TRUE; 74 end struct; 75 76var ghost_struct: ghost_1 is ghost_struct.value; 77var ghost_struct: ghost_2 is ghost_struct.value; 78var ghost_struct: ghost_3 is ghost_struct.value; 79var ghost_struct: ghost_4 is ghost_struct.value; 80 81const string: str (in ghost_struct: ghost) is "G"; 82 83enable_output(ghost_struct); 84 85const type: ghost_type is varptr ghost_struct; 86 87const array ghost_type: GHOST_LIST is [](&ghost_1, &ghost_2, &ghost_3, &ghost_4); 88 89var char: next_command is KEY_NONE; 90 91var boolean: quit is FALSE; 92var boolean: playing is TRUE; 93var integer: points_eaten is 0; 94var integer: score is 0; 95var integer: high_score is 0; 96var array array place_type: labyrinth_map is 23 times 40 times FREE_PLACE; 97var array array place_type: map is 0 times 0 times FREE_PLACE; 98var integer: number_of_lifes is 0; 99var integer: ghosts_flee is 0; 100var integer: number_of_points is 351; 101const array string: field is []( 102 "#######################################", 103 "#..................#..................#", 104 "#*#####.##########.#.##########.#####*#", 105 "#.#####.##########.#.##########.#####.#", 106 "#.....................................#", 107 "#.#####.##########.#.##########.#####.#", 108 "#.# #............#............# #.#", 109 "#.#####.###.###############.###.#####.#", 110 "#.......# #.................# #.......#", 111 "#######.###.###############.###.#######", 112 " ...........# #........... ", 113 "#######.###.###############.###.#######", 114 "#.......# #.................# #.......#", 115 "#.#####.# ########.#.######## #.#####.#", 116 "#.# #.# #........#........# #.# #.#", 117 "#.#####.###.###############.###.#####.#", 118 "#.....#.........................#.....#", 119 "#####.#.##########.#.##########.#.#####", 120 "#.......# #........#........# #.......#", 121 "#*#########.###############.#########*#", 122 "#.....................................#", 123 "#######################################"); 124 125 126const proc: set_color (in integer: foreground, in integer: background) is noop; 127 128 129const proc: sound (in integer: frequency, in float: duration) is noop; 130 131 132const proc: show_lifes is func 133 134 local 135 var integer: life is 0; 136 137 begin (* show_lifes *) 138 set_color(0, 0); 139 setPos(info_sheet, 3, 1); 140 write(info_sheet, " "); 141 set_color(14, 0); 142 setPos(info_sheet, 3, 1); 143 for life range 1 to pred(number_of_lifes) do 144 write(info_sheet, PACMAN); 145 end for; 146 end func; (* show_lifes *) 147 148 149const proc: left (PACMAN) is func 150 151 begin (* left (PACMAN) *) 152 if map[PACMAN.line][pred(PACMAN.column)] <> WALL_PLACE then 153 PACMAN.line_move := 0; 154 PACMAN.column_move := -1; 155 next_command := KEY_NONE; 156 else 157 next_command := KEY_LEFT; 158 end if; 159 end func; (* left (PACMAN) *) 160 161 162const proc: right (PACMAN) is func 163 164 begin (* right (PACMAN) *) 165 if map[PACMAN.line][succ(PACMAN.column)] <> WALL_PLACE then 166 PACMAN.line_move := 0; 167 PACMAN.column_move := 1; 168 next_command := KEY_NONE; 169 else 170 next_command := KEY_RIGHT; 171 end if; 172 end func; (* right (PACMAN) *) 173 174 175const proc: up (PACMAN) is func 176 177 begin (* up (PACMAN) *) 178 if map[pred(PACMAN.line)][PACMAN.column] <> WALL_PLACE then 179 PACMAN.line_move := -1; 180 PACMAN.column_move := 0; 181 next_command := KEY_NONE; 182 else 183 next_command := KEY_UP; 184 end if; 185 end func; (* up (PACMAN) *) 186 187 188const proc: down (PACMAN) is func 189 190 begin (* down (PACMAN) *) 191 if map[succ(PACMAN.line)][PACMAN.column] <> WALL_PLACE then 192 PACMAN.line_move := 1; 193 PACMAN.column_move := 0; 194 next_command := KEY_NONE; 195 else 196 next_command := KEY_DOWN; 197 end if; 198 end func; (* down (PACMAN) *) 199 200 201const proc: send_home (inout ghost_type: ghost) is func 202 begin 203 ghost->line := 11; 204 ghost->column := 16 + rand(1, 8); 205 ghost->line_move := 0; 206 if rand(FALSE, TRUE) then 207 ghost->column_move := 1; 208 else 209 ghost->column_move := -1; 210 end if; 211 ghost->at_home := TRUE; 212 end func; 213 214 215const proc: read_command is func 216 217 local 218 var char: inp is ' '; 219 220 begin (* read_command *) 221 inp := busy_getc(KEYBOARD); 222 if inp = KEY_NONE then 223 inp := next_command; 224 next_command := KEY_NONE; 225 end if; 226 if inp <> KEY_NONE then 227 repeat 228 case inp of 229 when {KEY_LEFT, '4'}: left(PACMAN); 230 when {KEY_RIGHT, '6'}: right(PACMAN); 231 when {KEY_UP, '8'}: up(PACMAN); 232 when {KEY_DOWN, '2'}: down(PACMAN); 233 when {'q', 'Q'}: 234 playing := FALSE; 235 quit := TRUE; 236 end case; 237 inp := busy_getc(KEYBOARD); 238 until inp = KEY_NONE; 239 end if; 240 end func; (* read_command *) 241 242 243const proc: write_map_position (in integer: line, in integer: column) is func 244 245 begin (* write_map_position *) 246 setPos(labyrinth, line, column); 247 write(labyrinth, map[line][column]); 248 end func; (* write_map_position *) 249 250 251const proc: pacman_cought is func 252 253 local 254 var integer: frequency is 0; 255 var ghost_type: ghost is ghost_type.NIL; 256 257 begin (* pacman_cought *) 258 for frequency range 1000 downto 200 do 259 sound(frequency, 0.001); 260 end for; 261 decr(number_of_lifes); 262 show_lifes(); 263 if number_of_lifes = 0 then 264 playing := FALSE; 265 end if; 266 PACMAN.line := 17; 267 PACMAN.column := 20; 268 PACMAN.line_move := 0; 269 PACMAN.column_move := 0; 270 for ghost range GHOST_LIST do 271 write_map_position(ghost->line, ghost->column); 272 end for; 273 for ghost range GHOST_LIST do 274 send_home(ghost); 275 end for; 276 end func; (* pacman_cought *) 277 278 279const proc: ghost_cought (inout ghost_type: ghost) is func 280 281 local 282 var integer: frequency is 0; 283 284 begin (* ghost_cought *) 285 frequency := 200; 286 while frequency <= 900 do 287 sound(frequency, 0.001); 288 sound(succ(frequency), 0.001); 289 frequency := frequency + 3; 290 end while; 291 send_home(ghost); 292 end func; (* ghost_cought *) 293 294 295const proc: someone_cought (inout ghost_type: ghost) is func 296 297 begin (* someone_cought *) 298 if ghosts_flee > 0 then 299 ghost_cought(ghost); 300 else 301 pacman_cought; 302 end if; 303 end func; (* someone_cought *) 304 305 306const proc: EAT (in place_type: aPlace) is DYNAMIC; 307 308 309const proc: EAT (FREE_PLACE) is noop; 310 311 312const proc: EAT (DOT_PLACE) is func 313 314 begin (* EAT (DOT_PLACE *) 315 map[PACMAN.line][PACMAN.column] := FREE_PLACE; 316 incr(points_eaten); 317 incr(score); 318 set_color(15, 0); 319 setPos(info_sheet, 2, 8); 320 write(info_sheet, score); 321 end func; (* EAT (DOT_PLACE) *) 322 323 324const proc: EAT (POWER_PLACE) is func 325 local 326 var integer: frequency is 0; 327 328 begin (* EAT (POWER_PLACE *) 329 map[PACMAN.line][PACMAN.column] := FREE_PLACE; 330 incr(points_eaten); 331 incr(score); 332 set_color(15, 0); 333 setPos(info_sheet, 2, 8); 334 write(info_sheet, score); 335 frequency := 300; 336 while frequency <= 700 do 337 sound(frequency, 0.001); 338 frequency := frequency + 2; 339 end while; 340 ghosts_flee := 80; 341 end func; (* EAT (POWER_PLACE) *) 342 343 344const proc: check_all_ghosts (PACMAN) is func 345 local 346 var ghost_type: ghost is ghost_type.NIL; 347 348 begin (* check_all_ghosts *) 349 for ghost range GHOST_LIST do 350 if PACMAN.line = ghost->line and 351 PACMAN.column = ghost->column then 352 someone_cought(ghost); 353 end if; 354 end for; 355 end func; (* check_all_ghosts *) 356 357 358const proc: move_pacman is func 359 360 begin (* move_pacman *) 361 if map[PACMAN.line + PACMAN.line_move] 362 [PACMAN.column + PACMAN.column_move] = WALL_PLACE then 363 PACMAN.column_move := 0; 364 PACMAN.line_move := 0; 365 end if; 366 set_color(14, 0); 367 setPos(labyrinth, PACMAN.line, PACMAN.column); 368 write(labyrinth, str(FREE_PLACE)); 369 PACMAN.line := PACMAN.line + PACMAN.line_move; 370 PACMAN.column := PACMAN.column + PACMAN.column_move; 371 if PACMAN.column = 1 then 372 (* left tunnel *) 373 PACMAN.column := 38; 374 elsif PACMAN.column = 39 then 375 (* right tunnel *) 376 PACMAN.column := 2; 377 end if; 378 EAT(map[PACMAN.line][PACMAN.column]); 379 if ghosts_flee > 0 then 380 decr(ghosts_flee); 381 end if; 382 setPos(labyrinth, PACMAN.line, PACMAN.column); 383 write(labyrinth, PACMAN); 384 check_all_ghosts(PACMAN); 385 end func; (* move_pacman *) 386 387 388const func direct_type: select_direction ( 389 in boolean: rightward_possible, 390 in boolean: leftward_possible, 391 in boolean: upward_possible, 392 in boolean: downward_possible) is func 393 result 394 var direct_type: direction is NOWHERE; 395 local 396 var array direct_type: possible is 5 times NOWHERE; 397 var integer: num_directions is 0; 398 399 begin (* select_direction *) 400 num_directions := 0; 401 if rightward_possible then 402 incr(num_directions); 403 possible[num_directions] := RIGHTWARD; 404 end if; 405 if leftward_possible then 406 incr(num_directions); 407 possible[num_directions] := LEFTWARD; 408 end if; 409 if upward_possible then 410 incr(num_directions); 411 possible[num_directions] := UPWARD; 412 end if; 413 if downward_possible then 414 incr(num_directions); 415 possible[num_directions] := DOWNWARD 416 end if; 417 if num_directions <> 0 then 418 direction := possible[rand(1, num_directions)]; 419 end if; 420 end func; (* select_direction *) 421 422 423const proc: turn (in ghost_type: ghost, in direct_type: direction) is DYNAMIC; 424 425 426const proc: turn (inout ghost_type: ghost, RIGHTWARD) is func 427 428 begin (* turn (ghost_type, RIGHTWARD) *) 429 ghost->column_move := 1; 430 ghost->line_move := 0; 431 end func; (* turn (ghost_type, RIGHTWARD) *) 432 433 434const proc: turn (inout ghost_type: ghost, LEFTWARD) is func 435 436 begin (* turn (ghost_type, LEFTWARD) *) 437 ghost->column_move := -1; 438 ghost->line_move := 0; 439 end func; (* turn (ghost_type, LEFTWARD) *) 440 441 442const proc: turn (inout ghost_type: ghost, UPWARD) is func 443 444 begin (* turn (ghost_type, UPWARD) *) 445 ghost->column_move := 0; 446 ghost->line_move := -1; 447 end func; (* turn (ghost_type, UPWARD) *) 448 449 450const proc: turn (inout ghost_type: ghost, DOWNWARD) is func 451 452 begin (* turn (ghost_type, DOWNWARD) *) 453 ghost->column_move := 0; 454 ghost->line_move := 1; 455 end func; (* turn (ghost_type, DOWNWARD) *) 456 457 458const proc: move (inout ghost_type: ghost) is func 459 local 460 var boolean: rightward_possible is FALSE; 461 var boolean: leftward_possible is FALSE; 462 var boolean: upward_possible is FALSE; 463 var boolean: downward_possible is FALSE; 464 var direct_type: direction is NOWHERE; 465 466 begin (* move (ghost_type) *) 467 if ghost->at_home and ghosts_flee = 0 then 468 ghost->line_move := 0; 469 if ghost = &ghost_1 or ghost = &ghost_2 then 470 (* Leave home to the left *) 471 ghost->column_move := -1; 472 else 473 (* Leave home to the right *) 474 ghost->column_move := 1; 475 end if; 476 if ghost->column <= 13 or ghost->column >= 27 then 477 ghost->at_home := FALSE; 478 end if; 479 else 480 if ghost->line_move = 0 then 481 downward_possible := 482 map[succ(ghost->line)][ghost->column] <> WALL_PLACE; 483 upward_possible := 484 map[pred(ghost->line)][ghost->column] <> WALL_PLACE; 485 elsif ghost->line_move = 1 then 486 if map[succ(ghost->line)][ghost->column] <> WALL_PLACE then 487 downward_possible := TRUE; 488 else 489 upward_possible := 490 map[pred(ghost->line)][ghost->column] <> WALL_PLACE; 491 end if; 492 elsif ghost->line_move = -1 then 493 if map[pred(ghost->line)][ghost->column] <> WALL_PLACE then 494 upward_possible := TRUE; 495 else 496 downward_possible := 497 map[succ(ghost->line)][ghost->column] <> WALL_PLACE; 498 end if; 499 end if; 500 if ghost->column_move = 0 then 501 rightward_possible := 502 map[ghost->line][succ(ghost->column)] <> WALL_PLACE; 503 leftward_possible := 504 map[ghost->line][pred(ghost->column)] <> WALL_PLACE; 505 elsif ghost->column_move = 1 then 506 if map[ghost->line][succ(ghost->column)] <> WALL_PLACE then 507 rightward_possible := TRUE; 508 else 509 leftward_possible := 510 map[ghost->line][pred(ghost->column)] <> WALL_PLACE 511 end if; 512 elsif ghost->column_move = -1 then 513 if map[ghost->line][pred(ghost->column)] <> WALL_PLACE then 514 leftward_possible := TRUE; 515 else 516 rightward_possible := 517 map[ghost->line][succ(ghost->column)] <> WALL_PLACE 518 end if; 519 end if; 520 if ghosts_flee = 0 then 521 if rand(1, 100) <= 20 then 522 direction := select_direction(rightward_possible, 523 leftward_possible, upward_possible, downward_possible); 524 else 525 direction := select_direction( 526 rightward_possible and ghost->column < PACMAN.column, 527 leftward_possible and ghost->column > PACMAN.column, 528 upward_possible and ghost->line > PACMAN.line, 529 downward_possible and ghost->line < PACMAN.line); 530 if direction = NOWHERE then 531 direction := select_direction(rightward_possible, 532 leftward_possible, upward_possible, downward_possible); 533 end if; 534 end if; 535 else 536 direction := select_direction( 537 rightward_possible and ghost->column > PACMAN.column, 538 leftward_possible and ghost->column < PACMAN.column, 539 upward_possible and ghost->line < PACMAN.line, 540 downward_possible and ghost->line > PACMAN.line); 541 if direction = NOWHERE then 542 direction := select_direction(rightward_possible, 543 leftward_possible, upward_possible, downward_possible); 544 end if; 545 end if; 546 turn(ghost, direction); 547 end if; 548 write_map_position(ghost->line, ghost->column); 549 ghost->line +:= ghost->line_move; 550 ghost->column +:= ghost->column_move; 551 if ghost->column = 1 then 552 (* left tunnel *) 553 ghost->column := 38; 554 elsif ghost->column = 39 then 555 (* right tunnel *) 556 ghost->column := 2; 557 end if; 558 if ghosts_flee > 0 then 559 if ghosts_flee < 20 then 560 if odd(ghosts_flee) then 561 set_color(9, 0); 562 else 563 set_color(15, 0); 564 end if; 565 else 566 set_color(9, 0); 567 end if; 568 else 569 set_color(13, 0); 570 end if; 571 setPos(labyrinth, ghost->line, ghost->column); 572 write(labyrinth, ghost^); 573 if ghost->line = PACMAN.line and 574 ghost->column = PACMAN.column then 575 someone_cought(ghost); 576 end if; 577 end func; (* move (ghost_type) *) 578 579 580const proc: move_ghosts is func 581 582 local 583 var ghost_type: ghost is ghost_type.NIL; 584 585 begin (* move_ghosts *) 586 for ghost range GHOST_LIST do 587 move(ghost); 588 end for; 589 end func; (* move_ghosts *) 590 591 592const proc: read_map is func 593 594 local 595 var integer: line is 0; 596 var integer: column is 0; 597 var string: field_line is ""; 598 599 begin (* read_map *) 600 number_of_points := 0; 601 for line range 1 to 22 do 602 field_line := field[line]; 603 for column range 1 to 39 do 604 case field_line[column] of 605 when {' '}: labyrinth_map[line][column] := FREE_PLACE; 606 when {'.'}: labyrinth_map[line][column] := DOT_PLACE; 607 incr(number_of_points); 608 when {'#'}: labyrinth_map[line][column] := WALL_PLACE; 609 when {'*'}: labyrinth_map[line][column] := POWER_PLACE; 610 incr(number_of_points); 611 end case; 612 end for; 613 end for; 614 end func; (* read_map *) 615 616 617const proc: show_map is func 618 619 local 620 var integer: line is 0; 621 var integer: column is 0; 622 623 begin (* show_map *) 624 set_color(1, 1); 625 for line range 1 to 22 do 626 setPos(labyrinth, line, 1); 627 write(labyrinth, field[line]); 628(* 629 for column range 1 to 39 do 630 write_map_position(line, column); 631 end for; 632*) 633 end for; 634 end func; (* show_map *) 635 636 637const proc: main_control is func 638 639 local 640 var integer: frequency is 0; 641 var time: start_time is time.value; 642 643 begin (* main_control *) 644 while playing do 645 start_time := time(NOW); 646 read_command; 647 move_pacman(); 648 if points_eaten = number_of_points then 649 (* Round finished *) 650 playing := FALSE; 651 else 652 move_ghosts(); 653(* frequency := 50; 654 while frequency <= 200 do 655 sound(frequency, 0.001); 656 frequency := frequency + 2; 657 end while; *) 658 end if; 659 await(start_time + 150000 . MICRO_SECONDS); 660 end while; 661 end func; (* main_control *) 662 663 664const proc: main is func 665 666 local 667 var ghost_type: ghost is ghost_type.NIL; 668 var char: command is ' '; 669 670 begin (* main *) 671 quit := FALSE; 672 high_score := 0; 673 scr := open(CONSOLE); 674 labyrinth := openWindow(scr, 2, 2, 22, 39); 675 info_sheet := openWindow(scr, 2, 44, 22, 20); 676 box(labyrinth); 677 box(info_sheet); 678 clear(labyrinth); 679 read_map(); 680 while not quit do 681 playing := TRUE; 682 map := labyrinth_map; 683 points_eaten := 0; 684 score := 0; 685 PACMAN.line := 17; 686 PACMAN.column := 20; 687 PACMAN.line_move := 0; 688 PACMAN.column_move := 0; 689 for ghost range GHOST_LIST do 690 send_home(ghost); 691 end for; 692 number_of_lifes := 3; 693 show_map(); 694 show_lifes(); 695 set_color(15, 0); 696 setPos(info_sheet, 2, 1); 697 write(info_sheet, "Score: "); 698 set_color(14, 0); 699 setPos(labyrinth, PACMAN.line, PACMAN.column); 700 write(labyrinth, PACMAN); 701 for ghost range GHOST_LIST do 702 set_color(9, 0); 703 setPos(labyrinth, ghost->line, ghost->column); 704 write(labyrinth, ghost^); 705 end for; 706 main_control(); 707 if not quit then 708 if score > high_score then 709 high_score := score; 710 set_color(15, 0); 711 setPos(info_sheet, 1, 1); 712 write(info_sheet, "Highscore:"); 713 set_color(15, 0); 714 setPos(info_sheet, 1, 12); 715 write(info_sheet, score); 716 end if; 717 set_color(15, 0); 718 setPos(labyrinth, 11, 14); 719 write(labyrinth, " GAME OVER "); 720 command := getc(KEYBOARD); 721 if command = 'Q' or command = 'q' then 722 quit := TRUE; 723 end if; 724 end if; 725 end while; 726 end func; (* main *) 727