1 2(********************************************************************) 3(* *) 4(* snake.sd7 Snake eats apple 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 "time.s7i"; 27 include "duration.s7i"; 28 include "console.s7i"; 29 include "window.s7i"; 30 include "keybd.s7i"; 31 32const char: BLANK is ' '; 33const char: BODY is '*'; 34 35const type: direction_type is new enum 36 STAY, UP, DOWN, LEFT, RIGHT 37 end enum; 38 39var integer: max_line is 0; 40var integer: max_column is 0; 41 42const type: char_line is array char; 43const type: pos_type is array integer; 44 45var array char_line: FIELD is 0 times 0 times ' '; 46 47const type: screen_object is new struct 48 var integer: line is 0; 49 var integer: column is 0; 50 var char: picture is ' '; 51 end struct; 52 53const type: apple_object is sub screen_object struct 54 end struct; 55 56var apple_object: APPLE is apple_object.value; 57APPLE.picture := 'o'; 58 59const type: snake_object is sub screen_object struct 60 var direction_type: direction is STAY; 61 var boolean: backward_movement is FALSE; 62 var boolean: fence_movement is FALSE; 63 var char: last_meal is ' '; 64 var integer: head_index is 1; 65 var integer: end_index is 1; 66 var array pos_type: position is 2000 times (2 times 0); 67 var integer: length is 0; 68 var integer: grow is 2; 69 end struct; 70 71var snake_object: SNAKE is snake_object.value; 72SNAKE.picture := 'S'; 73 74const proc: move (SNAKE, in direction_type: direction) is DYNAMIC; 75 76 77var text: scr is STD_NULL; 78var text: win is STD_NULL; 79var text: status is STD_NULL; 80 81 82const proc: beep is func 83 84 begin 85(* write("\G"); *) 86 noop; 87 end func; 88 89 90const proc: set_position (inout screen_object: scr_object) is func 91 92 local 93 var integer: lin is 0; 94 var integer: col is 0; 95 var char: ch is ' '; 96 begin 97 repeat 98 lin := rand(1, max_line - 2); 99 col := rand(1, max_column - 2); 100 ch := FIELD[lin][col]; 101 until ch = BLANK; 102 setPos(win, lin, col); 103 write(win, scr_object.picture); 104 FIELD[lin][col] := scr_object.picture; 105 scr_object.line := lin; 106 scr_object.column := col; 107 end func; 108 109 110const proc: show_status is func 111 112 begin 113 setPos(status, 1, max_column div 2 - 3); 114 write(status, " " <& SNAKE.length <& " "); 115 end func; 116 117 118const proc: turn (SNAKE, UP) is func 119 120 begin 121 if SNAKE.direction = DOWN then 122 SNAKE.backward_movement := TRUE; 123 else 124 SNAKE.direction := UP; 125 SNAKE.picture := 'v'; 126 end if; 127 end func; 128 129 130const proc: turn (SNAKE, DOWN) is func 131 132 begin 133 if SNAKE.direction = UP then 134 SNAKE.backward_movement := TRUE; 135 else 136 SNAKE.direction := DOWN; 137 SNAKE.picture := '^'; 138 end if; 139 end func; 140 141 142const proc: turn (SNAKE, LEFT) is func 143 144 begin 145 if SNAKE.direction = RIGHT then 146 SNAKE.backward_movement := TRUE; 147 else 148 SNAKE.direction := LEFT; 149 SNAKE.picture := '>'; 150 end if; 151 end func; 152 153 154const proc: turn (SNAKE, RIGHT) is func 155 156 begin 157 if SNAKE.direction = LEFT then 158 SNAKE.backward_movement := TRUE; 159 else 160 SNAKE.direction := RIGHT; 161 SNAKE.picture := '<'; 162 end if; 163 end func; 164 165 166const proc: move (SNAKE, UP) is func 167 168 begin 169 if SNAKE.line > 1 then 170 decr(SNAKE.line); 171 else 172 SNAKE.fence_movement := TRUE; 173 end if; 174 end func; 175 176 177const proc: move (SNAKE, DOWN) is func 178 179 begin 180 if SNAKE.line < max_line then 181 incr(SNAKE.line); 182 else 183 SNAKE.fence_movement := TRUE; 184 end if; 185 end func; 186 187 188const proc: move (SNAKE, LEFT) is func 189 190 begin 191 if SNAKE.column > 1 then 192 decr(SNAKE.column); 193 else 194 SNAKE.fence_movement := TRUE; 195 end if; 196 end func; 197 198 199const proc: move (SNAKE, RIGHT) is func 200 201 begin 202 if SNAKE.column < max_column then 203 incr(SNAKE.column); 204 else 205 SNAKE.fence_movement := TRUE; 206 end if; 207 end func; 208 209 210const proc: move (SNAKE, STAY) is func 211 212 begin 213 noop; 214 end func; 215 216 217const proc: move (SNAKE) is func 218 219 begin 220 move(SNAKE, SNAKE.direction); 221 if not SNAKE.fence_movement then 222 SNAKE.last_meal := FIELD[SNAKE.line][SNAKE.column]; 223 end if; 224 end func; 225 226 227const proc: enlarge (SNAKE) is func 228 229 local 230 var integer: number is 0; 231 begin 232 number := SNAKE.length div 2; 233 if number <= 5 then 234 SNAKE.grow +:= 5; 235 elsif number >= 30 then 236 SNAKE.grow +:= 30; 237 else 238 SNAKE.grow +:= number; 239 end if; 240 end func; 241 242 243const proc: show (SNAKE) is func 244 245 begin 246 if SNAKE.grow <> 0 then 247 if SNAKE.length = 0 then 248 setPos(win, SNAKE.position[SNAKE.end_index][1], 249 SNAKE.position[SNAKE.end_index][2]); 250 write(win, BODY); 251 FIELD[SNAKE.position[SNAKE.end_index][1]] 252 [SNAKE.position[SNAKE.end_index][2]] := BODY; 253 end if; 254 decr(SNAKE.grow); 255 incr(SNAKE.length); 256 show_status(); 257 else 258 setPos(win, SNAKE.position[SNAKE.end_index][1], 259 SNAKE.position[SNAKE.end_index][2]); 260 write(win, BLANK); 261 FIELD[SNAKE.position[SNAKE.end_index][1]] 262 [SNAKE.position[SNAKE.end_index][2]] := BLANK; 263 incr(SNAKE.end_index); 264 end if; 265 266 incr(SNAKE.head_index); 267 SNAKE.position[SNAKE.head_index][1] := SNAKE.line; 268 SNAKE.position[SNAKE.head_index][2] := SNAKE.column; 269 270 setPos(win, SNAKE.line, SNAKE.column); 271 write(win, SNAKE.picture); 272 FIELD[SNAKE.line][SNAKE.column] := SNAKE.picture; 273 setPos(win, SNAKE.position[pred(SNAKE.head_index)][1], 274 SNAKE.position[pred(SNAKE.head_index)][2]); 275 write(win, BODY); 276 FIELD[SNAKE.position[pred(SNAKE.head_index)][1]] 277 [SNAKE.position[pred(SNAKE.head_index)][2]] := BODY; 278 end func; 279 280 281const func boolean: play(ROUND) is func 282 283 result 284 var boolean: success is FALSE; 285 local 286 var char: inp is ' '; 287 var time: start_time is time.value; 288 var integer: apple_counter is 0; 289 begin 290 show_status(); 291 inp := busy_getc(KEYBOARD); 292 while inp <> 'q' do 293 start_time := time(NOW); 294 if inp <> KEY_NONE then 295 case inp of 296 when {KEY_UP}: 297 turn(SNAKE, UP); 298 when {KEY_DOWN}: 299 turn(SNAKE, DOWN); 300 when {KEY_LEFT}: 301 turn(SNAKE, LEFT); 302 when {KEY_RIGHT}: 303 turn(SNAKE, RIGHT); 304 end case; 305 end if; 306 307 move(SNAKE); 308 309 if SNAKE.fence_movement then 310 beep(); 311 setPos(scr, 1, 1); 312 write(scr, "FENCE"); 313 inp := 'q'; 314 else 315 316 if SNAKE.direction <> STAY then 317 show(SNAKE); 318 end if; 319 320 if SNAKE.last_meal = BODY then 321 beep(); 322 setPos(scr, 1, 1); 323 write(scr, "BODY"); 324 inp := 'q'; 325 elsif SNAKE.last_meal = '#' then 326 beep(); 327 setPos(scr, 1, 1); 328 write(scr, "#"); 329 inp := 'q'; 330 elsif apple_counter >= 10 then 331 inp := 'q'; 332 else 333 334 if SNAKE.last_meal = APPLE.picture then 335 incr(apple_counter); 336 if apple_counter < 10 then 337 enlarge(SNAKE); 338 beep(); 339 set_position(APPLE); 340 end if; 341 end if; 342 343 344 await(start_time + 100000 . MICRO_SECONDS); 345 346 inp := busy_getc(KEYBOARD); 347 348 end if; 349 end if; 350 end while; 351 success := apple_counter >= 10; 352 end func; 353 354 355const proc: init_level (in integer: level) is func 356 357 local 358 var integer: number is 0; 359 var integer: column is 0; 360 begin 361 case level of 362 when {1}: 363 noop; 364(* SNAKE(1).row = 25: SNAKE(2).row = 25 365 SNAKE(1).col = 50: SNAKE(2).col = 30 366 SNAKE(1).direction = 4: SNAKE(2).direction = 3 *) 367 368 369 when {2}: 370 for number range 19 to 59 do 371 FIELD[11][number] := '#'; 372 setPos(win, 11, number); 373 write(win, "#"); 374 end for; 375(* SNAKE(1).row = 7: SNAKE(2).row = 43 376 SNAKE(1).col = 60: SNAKE(2).col = 20 377 SNAKE(1).direction = 3: SNAKE(2).direction = 4 *) 378 379 when {3}: 380 for number range 6 to 16 do 381 FIELD[number][19] := '#'; 382 FIELD[number][59] := '#'; 383 setPos(win, number, 19); 384 write(win, "#"); 385 setPos(win, number, 59); 386 write(win, "#"); 387 end for; 388(* SNAKE(1).row = 25: SNAKE(2).row = 25 389 SNAKE(1).col = 50: SNAKE(2).col = 30 390 SNAKE(1).direction = 1: SNAKE(2).direction = 2 *) 391 392 when {4}: 393 for number range 1 to 12 do 394 FIELD[number][19] := '#'; 395 FIELD[22 - number][59] := '#'; 396 setPos(win, number, 19); 397 write(win, "#"); 398 setPos(win, 22 - number, 59); 399 write(win, "#"); 400 end for; 401 for number range 1 to 45 do 402 FIELD[16][number] := '#'; 403 FIELD[6][79 - number] := '#'; 404 setPos(win, 16, number); 405 write(win, "#"); 406 setPos(win, 6, 79 - number); 407 write(win, "#"); 408 end for; 409(* SNAKE(1).row = 7: SNAKE(2).row = 43 410 SNAKE(1).col = 60: SNAKE(2).col = 20 411 SNAKE(1).direction = 3: SNAKE(2).direction = 4 *) 412 413 when {5}: 414 for number range 6 to 16 do 415 FIELD[number][19] := '#'; 416 FIELD[number][59] := '#'; 417 setPos(win, number, 19); 418 write(win, "#"); 419 setPos(win, number, 59); 420 write(win, "#"); 421 end for; 422 for number range 21 to 57 do 423 FIELD[4][number] := '#'; 424 FIELD[18][number] := '#'; 425 setPos(win, 4, number); 426 write(win, "#"); 427 setPos(win, 18, number); 428 write(win, "#"); 429 end for; 430(* SNAKE(1).row = 25: SNAKE(2).row = 25 431 SNAKE(1).col = 50: SNAKE(2).col = 30 432 SNAKE(1).direction = 1: SNAKE(2).direction = 2 *) 433 434 when {6}: 435 for number range 1 to 21 do 436 if number <= 9 or number >= 13 then 437 FIELD[number][10] := '#'; 438 FIELD[number][20] := '#'; 439 FIELD[number][30] := '#'; 440 FIELD[number][40] := '#'; 441 FIELD[number][50] := '#'; 442 FIELD[number][60] := '#'; 443 FIELD[number][70] := '#'; 444 setPos(win, number, 10); 445 write(win, "#"); 446 setPos(win, number, 20); 447 write(win, "#"); 448 setPos(win, number, 30); 449 write(win, "#"); 450 setPos(win, number, 40); 451 write(win, "#"); 452 setPos(win, number, 50); 453 write(win, "#"); 454 setPos(win, number, 60); 455 write(win, "#"); 456 setPos(win, number, 70); 457 write(win, "#"); 458 end if; 459 end for; 460(* SNAKE(1).row = 7: SNAKE(2).row = 43 461 SNAKE(1).col = 65: SNAKE(2).col = 15 462 SNAKE(1).direction = 2: SNAKE(2).direction = 1 *) 463 464 when {7}: 465(* for number range 4 to 49 STEP 2 do 466 FIELD[number][40] := '#'; 467 setPos(win, number, 40); 468 write(win, "#"); 469 end for; *) 470 number := 1; 471 while number <= 21 do 472 FIELD[number][39] := '#'; 473 setPos(win, number, 39); 474 write(win, "#"); 475 number +:= 2; 476 end while; 477(* SNAKE(1).row = 7: SNAKE(2).row = 43 478 SNAKE(1).col = 65: SNAKE(2).col = 15 479 SNAKE(1).direction = 2: SNAKE(2).direction = 1 *) 480 481 when {8}: 482 for number range 1 to 18 do 483 FIELD[number][10] := '#'; 484 FIELD[22 - number][20] := '#'; 485 FIELD[number][30] := '#'; 486 FIELD[22 - number][40] := '#'; 487 FIELD[number][50] := '#'; 488 FIELD[22 - number][60] := '#'; 489 FIELD[number][70] := '#'; 490 setPos(win, number, 10); 491 write(win, "#"); 492 setPos(win, 22 - number, 20); 493 write(win, "#"); 494 setPos(win, number, 30); 495 write(win, "#"); 496 setPos(win, 22 - number, 40); 497 write(win, "#"); 498 setPos(win, number, 50); 499 write(win, "#"); 500 setPos(win, 22 - number, 60); 501 write(win, "#"); 502 setPos(win, number, 70); 503 write(win, "#"); 504 end for; 505(* SNAKE(1).row = 7: SNAKE(2).row = 43 506 SNAKE(1).col = 65: SNAKE(2).col = 15 507 SNAKE(1).direction = 2: SNAKE(2).direction = 1 *) 508 509 when {9}: 510 for number range 3 to 19 do 511 FIELD[number][2 * number] := '#'; 512 FIELD[number][2 * number + 1] := '#'; 513 FIELD[number][2 * number + 34] := '#'; 514 FIELD[number][2 * number + 35] := '#'; 515 setPos(win, number, 2 * number); 516 write(win, "#"); 517 setPos(win, number, 2 * number + 1); 518 write(win, "#"); 519 setPos(win, number, 2 * number + 28); 520 write(win, "#"); 521 setPos(win, number, 2 * number + 29); 522 write(win, "#"); 523 end for; 524(* SNAKE(1).row = 40: SNAKE(2).row = 15 525 SNAKE(1).col = 75: SNAKE(2).col = 5 526 SNAKE(1).direction = 1: SNAKE(2).direction = 2 *) 527 528 otherwise: 529(* for number range 4 to 49 STEP 2 do 530 FIELD[number][10] := '#'; 531 FIELD[number + 1][20] := '#'; 532 FIELD[number][30] := '#'; 533 FIELD[number + 1][40] := '#'; 534 FIELD[number][50] := '#'; 535 FIELD[number + 1][60] := '#'; 536 FIELD[number][70] := '#'; 537 end for; *) 538 number := 1; 539 while number <= 20 do 540 FIELD[number][10] := '#'; 541 FIELD[21 - number][20] := '#'; 542 FIELD[number][30] := '#'; 543 FIELD[21 - number][40] := '#'; 544 FIELD[number][50] := '#'; 545 FIELD[21 - number][60] := '#'; 546 FIELD[number][70] := '#'; 547 setPos(win, number, 10); 548 write(win, "#"); 549 setPos(win, 21 - number, 20); 550 write(win, "#"); 551 setPos(win, number, 30); 552 write(win, "#"); 553 setPos(win, 21 - number, 40); 554 write(win, "#"); 555 setPos(win, number, 50); 556 write(win, "#"); 557 setPos(win, 21 - number, 60); 558 write(win, "#"); 559 setPos(win, number, 70); 560 write(win, "#"); 561 number +:= 2; 562 end while; 563(* SNAKE(1).row = 7: SNAKE(2).row = 43 564 SNAKE(1).col = 65: SNAKE(2).col = 15 565 SNAKE(1).direction = 2: SNAKE(2).direction = 1 *) 566 567 end case; 568(* for number range 1 to 21 do 569 for column range 1 to 78 do 570 setPos(win, number, column); 571 write(win, FIELD[number][column]); 572 end for; 573 end for; *) 574 end func; 575 576 577const proc: main is func 578 579 local 580 var integer: level is 1; 581 begin 582 scr := open(CONSOLE); 583 win := openWindow(scr, 2, 2, 21, 78); 584 status := openWindow(scr, 23, 2, 1, 78); 585 586 max_line := 21; (* height(win); *) 587 max_column := 78; (* width(win); *) 588 589 repeat 590 box(win); 591 clear(win); 592 FIELD := 21 times (78 times BLANK); 593 init_level(level); 594 SNAKE.picture := 'S'; 595 set_position(APPLE); 596 set_position(SNAKE); 597 SNAKE.direction := STAY; 598 SNAKE.backward_movement := FALSE; 599 SNAKE.fence_movement := FALSE; 600 SNAKE.last_meal := ' '; 601 SNAKE.head_index := 1; 602 SNAKE.end_index := 1; 603 SNAKE.position[SNAKE.end_index][1] := SNAKE.line; 604 SNAKE.position[SNAKE.end_index][2] := SNAKE.column; 605 SNAKE.length := 0; 606 SNAKE.grow := 2; 607 608 if play(ROUND) then 609 incr(level); 610 end if; 611 612 until getc(KEYBOARD) = 'q'; 613 end func; 614