1 2(********************************************************************) 3(* *) 4(* sokoban.sd7 Sokoban puzzle game *) 5(* Copyright (C) 2008 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 "float.s7i"; 27 include "text.s7i"; 28 include "draw.s7i"; 29 include "pic_util.s7i"; 30 include "stdfont9.s7i"; 31 include "pixmap_file.s7i"; 32 include "keybd.s7i"; 33 include "editline.s7i"; 34 include "echo.s7i"; 35 include "line.s7i"; 36 include "dialog.s7i"; 37 include "sokoban1.s7i"; 38 39 40const integer: TILE_SIZE is 32; 41 42var integer: numberOfMoves is 0; 43var integer: numberOfPushes is 0; 44var integer: levelNumber is 1; 45var integer: numberOfPackets is 0; 46var integer: savedPackets is 0; 47var integer: xPos is -1; 48var integer: yPos is -1; 49 50const type: categoryType is new enum 51 WALL, GROUND, PLAYER, PACKET, OUTSIDE 52 end enum; 53 54const type: fieldType is new struct 55 var categoryType: fieldCategory is GROUND; 56 var boolean: isGoalField is FALSE; 57 var boolean: dirty is TRUE; 58 end struct; 59 60var array array fieldType: levelMap is 0 times 0 times fieldType.value; 61 62var char: keyChar is ' '; 63 64var text: win is STD_NULL; 65 66 67var PRIMITIVE_WINDOW: player_pixmap is PRIMITIVE_WINDOW.value; 68var PRIMITIVE_WINDOW: goal_pixmap is PRIMITIVE_WINDOW.value; 69var PRIMITIVE_WINDOW: wall_pixmap is PRIMITIVE_WINDOW.value; 70var PRIMITIVE_WINDOW: packet_pixmap is PRIMITIVE_WINDOW.value; 71var PRIMITIVE_WINDOW: player_at_goal_pixmap is PRIMITIVE_WINDOW.value; 72var PRIMITIVE_WINDOW: packet_at_goal_pixmap is PRIMITIVE_WINDOW.value; 73 74 75const type: moveMode is new enum 76 MOVE, PUSH 77 end enum; 78 79const type: moveDirection is new enum 80 UP, DOWN, LEFT, RIGHT 81 end enum; 82 83const type: moveType is new struct 84 var moveMode: mode is MOVE; 85 var moveDirection: direction is UP; 86 end struct; 87 88var array moveType: playerMoves is 0 times moveType.value; 89var integer: moveNumber is 0; 90 91 92const array string: player_pic is []( 93 "bbbbbbbbbbbbbbYYYYYbbbbbbbbbbbbb", 94 "bbbbbbbbbbbbbYYYYYYYbbbbbbbbbbbb", 95 "bbbbbbbbbbbbYYWWWWWYYbbbbbbbbbbb", 96 "bbbbbbbbbbbbYYWBWBWYYbbbbbbbbbbb", 97 "bbbbbbbbbbbbYYWWWWWYYbbbbbbbbbbb", 98 "bbbbbbbbbbbbYYWOWOWYYbbbbbbbbbbb", 99 "bbbbbbbbbbbbbbWWOWWbbbbbbbbbbbbb", 100 "bbbbbbbbbbbbbbbWWWbbbbbbbbbbbbbb", 101 "bbbbbbbbbbbbOOOWWWOOObbbbbbbbbbb", 102 "bbbbbbbbbbbOOOOOOOOOOObbbbbbbbbb", 103 "bbbbbbbbbbOOOOOOOOOOOOObbbbbbbbb", 104 "bbbbbbbbbOOOMOOMOMOOMOOObbbbbbbb", 105 "bbbbbbbbWWObbMMOOOMMbbOWWbbbbbbb", 106 "bbbbbbWWWWbbbbOOOOObbbbWWWWbbbbb", 107 "bbbbbWWWWbbbbbOOOOObbbbbWWWWbbbb", 108 "bbbbbWWWbbbbbOOOOOOObbbbbWWWbbbb", 109 "bbbbbbbbbbbbXXXXXXXXXbbbbbbbbbbb", 110 "bbbbbbbbbbbbBBBBBBBBBbbbbbbbbbbb", 111 "bbbbbbbbbbbbBBBBBBBBBbbbbbbbbbbb", 112 "bbbbbbbbbbbbBBBBBBBBBbbbbbbbbbbb", 113 "bbbbbbbbbbbbbBBBbBBBbbbbbbbbbbbb", 114 "bbbbbbbbbbbbbBBBbBBBbbbbbbbbbbbb", 115 "bbbbbbbbbbbbbBBBbBBBbbbbbbbbbbbb", 116 "bbbbbbbbbbbbbBBBbBBBbbbbbbbbbbbb", 117 "bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb", 118 "bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb", 119 "bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb", 120 "bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb", 121 "bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb", 122 "bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb", 123 "bbbbbbbbbbbbbbBBbBBbbbbbbbbbbbbb", 124 "bbbbbbbbbbbbbWWWbWWWbbbbbbbbbbbb"); 125 126 127const array string: goal_pic is []( 128 " ", 129 " MMMMM MMMMM MMMMM MMMMM MMMMM ", 130 " M MMM M MMM M MMM M MMM M MMM ", 131 " MM M MMM M MMM M MMM M MMM M M ", 132 " MMM MMMMM MMMMM MMMMM MMMMM MM ", 133 " MM M MMM M MMM M MMM M MMM M M ", 134 " M MMM M MMM M MMM M MMM M MMM ", 135 " MMMMM MMMMM MMMMM MMMMM MMMMM ", 136 " M MMM M MMM M MMM M MMM M MMM ", 137 " MM M MMM M MMM M MMM M MMM M M ", 138 " MMM MMMMM MMMMM MMMMM MMMMM MM ", 139 " MM M MMM M MMM M MMM M MMM M M ", 140 " M MMM M MMM M MMM M MMM M MMM ", 141 " MMMMM MMMMM MMMMM MMMMM MMMMM ", 142 " M MMM M MMM M MMM M MMM M MMM ", 143 " MM M MMM M MMM M MMM M MMM M M ", 144 " MMM MMMMM MMMMM MMMMM MMMMM MM ", 145 " MM M MMM M MMM M MMM M MMM M M ", 146 " M MMM M MMM M MMM M MMM M MMM ", 147 " MMMMM MMMMM MMMMM MMMMM MMMMM ", 148 " M MMM M MMM M MMM M MMM M MMM ", 149 " MM M MMM M MMM M MMM M MMM M M ", 150 " MMM MMMMM MMMMM MMMMM MMMMM MM ", 151 " MM M MMM M MMM M MMM M MMM M M ", 152 " M MMM M MMM M MMM M MMM M MMM ", 153 " MMMMM MMMMM MMMMM MMMMM MMMMM ", 154 " M MMM M MMM M MMM M MMM M MMM ", 155 " MM M MMM M MMM M MMM M MMM M M ", 156 " MMM MMMMM MMMMM MMMMM MMMMM MM ", 157 " MM M MMM M MMM M MMM M MMM M M ", 158 " M MMM M MMM M MMM M MMM M MMM ", 159 " "); 160 161 162const array string: wall_pic is []( 163 "xxxxWxxxxxxxWxxxxxxxxxWxxxxxxxxx", 164 "xxxxWxxxxxxxWxxxxxxxxxWxxxxxxxxx", 165 "xxxxWWWWWWWWWWWWWWWWWWWxxxxxxxxx", 166 "xxxxWxxxxxxxxxxxWxxxxxWxxxxxxxxx", 167 "WWWWWxxxxxxxxxxxWxxxxxWWWWWWWWWW", 168 "xxxxWxxxxxxxxxxxWxxxxxWxxxxxxxxx", 169 "xxxxWxxxxxxxxxxxWxxxxxWxxxxxxxxx", 170 "WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW", 171 "xxxxxxxxxWxxxxxxxxxWxxxxxxxWxxxx", 172 "xxxxxxxxxWxxxxxxxxxWxxxxxxxWxxxx", 173 "xxxxxxxxxWxxxxxxxxxWxxxxxxxWxxxx", 174 "WWWWWWWWWWxxxxxxxxxWWWWWWWWWWWWW", 175 "xxxWxxxxxWWWWWWWWWWWxxxxxxxxxxxx", 176 "xxxWxxxxxWxxxxxxxxxWxxxxxxxxxxxx", 177 "xxxWxxxxxWxxxxxxxxxWxxxxxxxxxxxx", 178 "xxxWxxxxxWxxxxxxxxxWxxxxxxxxxxxx", 179 "WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW", 180 "xxxxxWxxxxxxxxWxxxxxxxxxxxWxxxxx", 181 "xxxxxWxxxxxxxxWxxxxxxxxxxxWxxxxx", 182 "xxxxxWxxxxxxxxWxxxxxxxxxxxWxxxxx", 183 "xxxxxWWWWWWWWWWWWWWWWWWWWWWxxxxx", 184 "xxxxxWxxxxxxxxxxxWxxxxxxxxWxxxxx", 185 "xxxxxWxxxxxxxxxxxWxxxxxxxxWxxxxx", 186 "xxxxxWxxxxxxxxxxxWxxxxxxxxWxxxxx", 187 "WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW", 188 "xxxxxxxxxxxxWxxxxxxxxxWxxxxxWxxx", 189 "xxxxxxxxxxxxWxxxxxxxxxWxxxxxWxxx", 190 "xxxxxxxxxxxxWxxxxxxxxxWxxxxxWxxx", 191 "xxxxxxxxxxxxWWWWWWWWWWWxxxxxWxxx", 192 "WWWWWWWWWWWWWxxxxxxxxxWWWWWWWWWW", 193 "xxxxWxxxxxxxWxxxxxxxxxWxxxxxxxxx", 194 "xxxxWxxxxxxxWxxxxxxxxxWxxxxxxxxx"); 195 196 197const array string: packet_pic is []( 198 "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", 199 "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", 200 "bbbbbbbbbbbbXXXXXXXXXbbbbbbbbbbb", 201 "bbbbbbbbbbXXXWWWWWWWXXXbbbbbbbbb", 202 "bbbbbbbbXXXWWWWWWWWWWWXXXbbbbbbb", 203 "bbbbbbbXXWWWWRRRRRRRWWWWXXbbbbbb", 204 "bbbbbbXXWWWRRRRRRRRRRRWWWXXbbbbb", 205 "bbbbbXXWWRRRRRRYYYYRRRRRWWXXbbbb", 206 "bbbbbXWWRRRRRRRRRYYYYRRRRWWXbbbb", 207 "bbbbXXWWRRRRRRRRRRRYYYRRRWWXXbbb", 208 "bbbbXWWRRRRRRRRRRRRRYYYRRRWWXbbb", 209 "bbbbXWWRRRRRRRRRRRRRRYYYRRWWXbbb", 210 "bbbXWWRRRRRRRRRRRRRRRRYYRRRWWXbb", 211 "bbbXWWRRRRRRRRRRRRRRRRRYRRRWWXbb", 212 "bbbXWWRRRRRRRRRRRRRRRRRYRRRWWXbb", 213 "bbbXWWRRRRRRRRRRRRRRRRRRRRRWWXbb", 214 "bbbXWWRRRBRRRRRRRRRRRRRRRRRWWXbb", 215 "bbbXWWRRRBRRRRRRRRRRRRRRRRRWWXbb", 216 "bbbXWWRRRBBRRRRRRRRRRRRRRRRWWXbb", 217 "bbbXXWWRRBBBRRRRRRRRRRRRRRWWXXbb", 218 "bbbbXWWRRRBBBRRRRRRRRRRRRRWWXbbb", 219 "bbbbXXWWRRRBBBRRRRRRRRRRRWWXXbbb", 220 "bbbbbXWWRRRRBBBBRRRRRRRRRWWXbbbb", 221 "bbbbbXXWWRRRRRBBBBRRRRRRWWXXbbbb", 222 "bbbbbbXXWWWRRRRRRRRRRRWWWXXbbbbb", 223 "bbbbbbbXXWWWWRRRRRRRWWWWXXbbbbbb", 224 "bbbbbbbbXXXWWWWWWWWWWWXXXbbbbbbb", 225 "bbbbbbbbbbXXXWWWWWWWXXXbbbbbbbbb", 226 "bbbbbbbbbbbbXXXXXXXXXbbbbbbbbbbb", 227 "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", 228 "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", 229 "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"); 230 231 232const array string: player_at_goal_pic is []( 233 " YYYYY ", 234 " MMMMM MMMMMYYYYYYYMMMMM MMMMM ", 235 " M MMM M MMMYYWWWWWYYMMM M MMM ", 236 " MM M MMM M YYWBWBWYY M MMM M M ", 237 " MMM MMMMM MYYWWWWWYYM MMMMM MM ", 238 " MM M MMM M YYWOWOWYY M MMM M M ", 239 " M MMM M MMM MWWOWWM MMM M MMM ", 240 " MMMMM MMMMM MWWWM MMMMM MMMMM ", 241 " M MMM M MMMOOOWWWOOOMMM M MMM ", 242 " MM M MMM MOOOOOOOOOOOM MMM M M ", 243 " MMM MMMMMOOOOOOOOOOOOOMMMMM MM ", 244 " MM M MMMOOOMOOMOMOOMOOOMMM M M ", 245 " M MMM MWWOM MMOOOMM MOWWM MMM ", 246 " MMMMWWWWMMM OOOOO MMMWWWWMMMM ", 247 " M MMWWWWMMM MOOOOOM MMMWWWWMM ", 248 " MM MWWWM M MOOOOOOOM M MWWWM M ", 249 " MMM MMMMM MXXXXXXXXXM MMMMM MM ", 250 " MM M MMM M BBBBBBBBB M MMM M M ", 251 " M MMM M MMMBBBBBBBBBMMM M MMM ", 252 " MMMMM MMMMBBBBBBBBBMMMM MMMMM ", 253 " M MMM M MMM BBBMBBB MMM M MMM ", 254 " MM M MMM M MBBBMBBBM M MMM M M ", 255 " MMM MMMMM MMBBB BBBMM MMMMM MM ", 256 " MM M MMM M MBBBMBBBM M MMM M M ", 257 " M MMM M MMM MBBMBBM MMM M MMM ", 258 " MMMMM MMMMM BBMBB MMMMM MMMMM ", 259 " M MMM M MMM MBBMBBM MMM M MMM ", 260 " MM M MMM M MMBBMBBMM M MMM M M ", 261 " MMM MMMMM MMMBB BBMMM MMMMM MM ", 262 " MM M MMM M MMBBMBBMM M MMM M M ", 263 " M MMM M MMMSMBBMBBM MMM M MMM ", 264 " WWW WWW "); 265 266 267const array string: packet_at_goal_pic is []( 268 " ", 269 " MMMMM MMMMM MMMMM MMMMM MMMMM ", 270 " M MMM M MMM M MMM M MMM M MMM ", 271 " MM M MMM M MWWWWWWWM M MMM M M ", 272 " MMM MMMMMWWWWWWWWWWWWWMMMMM MM ", 273 " MM M MMMWWWWBBB WWWWMMM M M ", 274 " M MMM MWWWBBBBBB BBBWWM MMM ", 275 " MMMMMWW BBBBBYYYY BBBWWMMMMM ", 276 " M MMMWWB BBB YYYYBBBWWMMM ", 277 " MM MWWWBB B BBBYYYB WWWM M ", 278 " MMM WWBBBB BBBBBYYY WW MM ", 279 " MM MWWBBBBB BBBBBBBYY BWWM M ", 280 " M MWWBBBBB BBBBB Y BWWM ", 281 " MMWW BBB B BBB Y WWMM ", 282 " M MWW B BBB B BBB WWM ", 283 " MM WW BBBBB BBBBB WW M ", 284 " MMMWWB OBBBBBBB BBBBBBBWWMM ", 285 " MM WW O BBBBB BBBBB WW M ", 286 " M MWW BOO BBB B BBB WWM ", 287 " MMMWWBBOOO B BBB B WWMMM ", 288 " M MMWWBBBOOO BBBBB WWMM ", 289 " MM MWWWBBBOOO BBBBBBB WWWM M ", 290 " MMM MWWBBB OOOOBBBBB BWWM MM ", 291 " MM M MWWB BOOOOBB BWWM M M ", 292 " M MMM MWWWWBBB B WWWM MMM ", 293 " MMMMM MWWWWBBB WWWWM MMMMM ", 294 " M MMM M MMWWWWWWWWWWWMM M MMM ", 295 " MM M MMM M MWWWWWWWM M MMM M M ", 296 " MMM MMMMM MMMMM MMMMM MMMMM MM ", 297 " MM M MMM M MMM M MMM M MMM M M ", 298 " M MMM M MMM M MMM M MMM M MMM ", 299 " "); 300 301 302const proc: introduction is func 303 begin 304 setPos(win, 1, 1); 305 writeln(win, "S O K O B A N"); 306 writeln(win); 307 writeln(win, "Copyright (C) 2008 Thomas Mertes"); 308 writeln(win); 309 writeln(win, "This program is free software under the"); 310 writeln(win, "terms of the GNU General Public License"); 311 writeln(win); 312 writeln(win, "Sokoban is written in the Seed7"); 313 writeln(win, "programming language"); 314 writeln(win); 315 writeln(win, "Homepage: http://seed7.sourceforge.net"); 316 setPos(win, 20, 1); 317 writeln(win, "The following commands are accepted:"); 318 writeln(win, " cursor keys to move"); 319 writeln(win, " u to undo a move"); 320 writeln(win, " r to redo a move which was undone"); 321 writeln(win, " q to quit the game"); 322 writeln(win, " n for next level"); 323 writeln(win, " p for previous level"); 324 writeln(win, " s to restart current level"); 325 writeln(win, " l to select other level"); 326 end func; 327 328 329const proc: loadPixmaps is func 330 begin 331 player_pixmap := createPixmap(player_pic, 1, black); 332 goal_pixmap := createPixmap(goal_pic, 1, black); 333 wall_pixmap := createPixmap(wall_pic, 1, black); 334 packet_pixmap := createPixmap(packet_pic, 1, black); 335 player_at_goal_pixmap := createPixmap(player_at_goal_pic, 1, black); 336 packet_at_goal_pixmap := createPixmap(packet_at_goal_pic, 1, black); 337 end func; 338 339 340const proc: readLevel (inout char: keyChar) is func 341 local 342 var string: numberStri is ""; 343 var integer: newLevel is 0; 344 var boolean: okay is FALSE; 345 var integer: tries is 0; 346 begin 347 setPos(win, 30, 1); 348 write(win, "Indicate which level to play (1-" <& length(levels) <& ") "); 349 repeat 350 incr(tries); 351 readln(numberStri); 352 if IN.bufferChar = KEY_CLOSE then 353 keyChar := KEY_CLOSE; 354 elsif numberStri <> "" then 355 block 356 newLevel := integer(numberStri); 357 if newLevel >= 1 and newLevel <= length(levels) then 358 levelNumber := newLevel; 359 okay := TRUE; 360 else 361 raise RANGE_ERROR; 362 end if; 363 exception 364 catch RANGE_ERROR: 365 write(win, "This is not a correct level. Try again "); 366 end block; 367 end if; 368 until okay or numberStri = "" or tries >= 2 or keyChar = KEY_CLOSE; 369 end func; 370 371 372const proc: recognizeFieldsOutside (in integer: line, in integer: column) is func 373 begin 374 if levelMap[line][column].fieldCategory = GROUND then 375 levelMap[line][column].fieldCategory := OUTSIDE; 376 if line > 1 then 377 recognizeFieldsOutside(pred(line), column); 378 end if; 379 if line < length(levelMap) then 380 recognizeFieldsOutside(succ(line), column); 381 end if; 382 if column > 1 then 383 recognizeFieldsOutside(line, pred(column)); 384 end if; 385 if column < length(levelMap[line]) then 386 recognizeFieldsOutside(line, succ(column)); 387 end if; 388 end if; 389 end func; 390 391 392const proc: recognizeFieldsOutside is func 393 local 394 var integer: line is 0; 395 var integer: column is 0; 396 begin 397 if length(levelMap) >= 1 then 398 for column range 1 to length(levelMap[1]) do 399 recognizeFieldsOutside(1, column); 400 recognizeFieldsOutside(length(levelMap), column); 401 end for; 402 end if; 403 for line range 1 to length(levelMap) do 404 if length(levelMap[line]) >= 1 then 405 recognizeFieldsOutside(line, 1); 406 recognizeFieldsOutside(line, length(levelMap[line])); 407 end if; 408 end for; 409 end func; 410 411 412const proc: generateLevelMap (in array string: levelData) is func 413 local 414 var integer: line is 0; 415 var integer: column is 0; 416 var fieldType: currField is fieldType.value; 417 begin 418 numberOfMoves := 0; 419 numberOfPushes := 0; 420 levelMap := length(levelData) times length(levelData[1]) times fieldType.value; 421 numberOfPackets := 0; 422 savedPackets := 0; 423 xPos := -1; 424 yPos := -1; 425 for line range 1 to length(levelData) do 426 for column range 1 to length(levelData[line]) do 427 currField := fieldType.value; 428 case levelData[line][column] of 429 when {'#'}: 430 currField.fieldCategory := WALL; 431 when {' '}: 432 currField.fieldCategory := GROUND; 433 when {'.'}: 434 currField.fieldCategory := GROUND; 435 currField.isGoalField := TRUE; 436 when {'@'}: 437 currField.fieldCategory := PLAYER; 438 yPos := line; 439 xPos := column; 440 when {'+'}: 441 currField.fieldCategory := PLAYER; 442 currField.isGoalField := TRUE; 443 yPos := line; 444 xPos := column; 445 when {'$'}: 446 currField.fieldCategory := PACKET; 447 incr(numberOfPackets); 448 when {'*'}: 449 currField.fieldCategory := PACKET; 450 currField.isGoalField := TRUE; 451 incr(savedPackets); 452 incr(numberOfPackets); 453 end case; 454 levelMap[line][column] := currField; 455 end for; 456 end for; 457 recognizeFieldsOutside; 458 end func; 459 460 461const proc: readLevelMap (in integer: levelNumber) is func 462 begin 463 generateLevelMap(levels[levelNumber]); 464 end func; 465 466 467const proc: writeStatus is func 468 begin 469 setPos(win, 14, 1); 470 writeln(win, "Level = " <& levelNumber); 471 writeln(win, "Packets = " <& numberOfPackets); 472 writeln(win, "Saved Packets = " <& savedPackets <& " "); 473 writeln(win, "Movements = " <& numberOfMoves <& " "); 474 writeln(win, "Pushes = " <& numberOfPushes <& " "); 475 end func; 476 477 478const proc: drawMap is func 479 local 480 var integer: line is 0; 481 var integer: column is 0; 482 var PRIMITIVE_WINDOW: sprite is PRIMITIVE_WINDOW.value; 483 begin 484 for line range 1 to length(levelMap) do 485 for column range 1 to length(levelMap[line]) do 486 if levelMap[line][column].dirty then 487 case levelMap[line][column].fieldCategory of 488 when {WALL}: 489 sprite := wall_pixmap; 490 when {GROUND}: 491 if levelMap[line][column].isGoalField then 492 sprite := goal_pixmap; 493 else 494 rect(pred(column) * TILE_SIZE, pred(line) * TILE_SIZE, 495 TILE_SIZE, TILE_SIZE, brown); 496 sprite := PRIMITIVE_WINDOW.value; 497 end if; 498 when {PLAYER}: 499 if levelMap[line][column].isGoalField then 500 sprite := player_at_goal_pixmap; 501 else 502 sprite := player_pixmap; 503 end if; 504 when {PACKET}: 505 if levelMap[line][column].isGoalField then 506 sprite := packet_at_goal_pixmap; 507 else 508 sprite := packet_pixmap; 509 end if; 510 otherwise: 511 rect(pred(column) * TILE_SIZE, pred(line) * TILE_SIZE, 512 TILE_SIZE, TILE_SIZE, black); 513 sprite := PRIMITIVE_WINDOW.value; 514 end case; 515 if sprite <> PRIMITIVE_WINDOW.value then 516 put(curr_win, pred(column) * TILE_SIZE, 517 pred(line) * TILE_SIZE, sprite); 518 end if; 519 levelMap[line][column].dirty := FALSE; 520 end if; 521 end for; 522 end for; 523 end func; 524 525 526const proc: assignDxDy (in moveType: move, 527 inout integer: dx, inout integer: dy) is func 528 begin 529 dx := 0; 530 dy := 0; 531 case move.direction of 532 when {UP}: 533 dy := -1; 534 when {DOWN}: 535 dy := 1; 536 when {LEFT}: 537 dx := -1; 538 when {RIGHT}: 539 dx := 1; 540 end case; 541 end func; 542 543 544const proc: moveDxDy (in integer: dx, in integer: dy, 545 inout fieldType: currField, inout fieldType: nextField) is func 546 begin 547 currField.fieldCategory := GROUND; 548 nextField.fieldCategory := PLAYER; 549 currField.dirty := TRUE; 550 nextField.dirty := TRUE; 551 xPos +:= dx; 552 yPos +:= dy; 553 end func; 554 555 556const proc: pushDxDy (in integer: dx, in integer: dy, 557 inout fieldType: currField, inout fieldType: nextField, 558 inout fieldType: destField) is func 559 begin 560 currField.fieldCategory := GROUND; 561 nextField.fieldCategory := PLAYER; 562 destField.fieldCategory := PACKET; 563 currField.dirty := TRUE; 564 nextField.dirty := TRUE; 565 destField.dirty := TRUE; 566 xPos +:= dx; 567 yPos +:= dy; 568 if nextField.isGoalField then 569 if not destField.isGoalField then 570 decr(savedPackets); 571 end if; 572 else 573 if destField.isGoalField then 574 incr(savedPackets); 575 end if; 576 end if; 577 incr(numberOfPushes); 578 end func; 579 580 581const proc: pullDxDy (in integer: dx, in integer: dy, 582 inout fieldType: currField, inout fieldType: nextField, 583 inout fieldType: packetField) is func 584 begin 585 currField.fieldCategory := PACKET; 586 nextField.fieldCategory := PLAYER; 587 packetField.fieldCategory := GROUND; 588 currField.dirty := TRUE; 589 nextField.dirty := TRUE; 590 packetField.dirty := TRUE; 591 xPos +:= dx; 592 yPos +:= dy; 593 if packetField.isGoalField then 594 if not currField.isGoalField then 595 decr(savedPackets); 596 end if; 597 else 598 if currField.isGoalField then 599 incr(savedPackets); 600 end if; 601 end if; 602 decr(numberOfPushes); 603 end func; 604 605 606const proc: undoMove is func 607 local 608 var integer: dx is 0; 609 var integer: dy is 0; 610 var moveType: move is moveType.value; 611 begin 612 if moveNumber >= 1 then 613 move := playerMoves[moveNumber]; 614 assignDxDy(move, dx, dy); 615 if move.mode = MOVE then 616 moveDxDy(-dx, -dy, 617 levelMap[yPos][xPos], 618 levelMap[yPos - dy][xPos - dx]); 619 decr(numberOfMoves); 620 else 621 pullDxDy(-dx, -dy, 622 levelMap[yPos][xPos], 623 levelMap[yPos - dy][xPos - dx], 624 levelMap[yPos + dy][xPos + dx]); 625 end if; 626 decr(moveNumber); 627 end if; 628 end func; 629 630 631const proc: redoMove is func 632 local 633 var integer: dx is 0; 634 var integer: dy is 0; 635 var moveType: move is moveType.value; 636 begin 637 if moveNumber < length(playerMoves) then 638 incr(moveNumber); 639 move := playerMoves[moveNumber]; 640 assignDxDy(move, dx, dy); 641 if move.mode = MOVE then 642 moveDxDy(dx, dy, 643 levelMap[yPos][xPos], 644 levelMap[yPos + dy][xPos + dx]); 645 incr(numberOfMoves); 646 else 647 pushDxDy(dx, dy, 648 levelMap[yPos][xPos], 649 levelMap[yPos + dy][xPos + dx], 650 levelMap[yPos + 2 * dy][xPos + 2 * dx]); 651 end if; 652 end if; 653 end func; 654 655 656const proc: playLevel is func 657 local 658 var integer: dx is 0; 659 var integer: dy is 0; 660 var integer: line is 0; 661 var integer: column is 0; 662 var boolean: levelFinished is FALSE; 663 var moveType: move is moveType.value; 664 begin 665 playerMoves := 0 times moveType.value; 666 moveNumber := 0; 667 clear(black); 668 introduction; 669 writeStatus; 670 drawMap; 671 repeat 672 dx := 0; 673 dy := 0; 674 keyChar := getc(KEYBOARD); 675 case keyChar of 676 when {KEY_UP}: 677 move.direction := UP; 678 dy := -1; 679 when {KEY_DOWN}: 680 move.direction := DOWN; 681 dy := 1; 682 when {KEY_LEFT}: 683 move.direction := LEFT; 684 dx := -1; 685 when {KEY_RIGHT}: 686 move.direction := RIGHT; 687 dx := 1; 688 end case; 689 case levelMap[yPos + dy][xPos + dx].fieldCategory of 690 when {GROUND}: 691 moveDxDy(dx, dy, 692 levelMap[yPos][xPos], 693 levelMap[yPos + dy][xPos + dx]); 694 incr(numberOfMoves); 695 move.mode := MOVE; 696 if length(playerMoves) > moveNumber then 697 playerMoves := playerMoves[.. moveNumber]; 698 end if; 699 playerMoves &:= [] (move); 700 incr(moveNumber); 701 when {PACKET}: 702 if levelMap[yPos + 2 * dy][xPos + 2 * dx].fieldCategory = GROUND then 703 pushDxDy(dx, dy, 704 levelMap[yPos][xPos], 705 levelMap[yPos + dy][xPos + dx], 706 levelMap[yPos + 2 * dy][xPos + 2 * dx]); 707 move.mode := PUSH; 708 if length(playerMoves) > moveNumber then 709 playerMoves := playerMoves[.. moveNumber]; 710 end if; 711 playerMoves &:= [] (move); 712 incr(moveNumber); 713 end if; 714 end case; 715 writeStatus; 716 drawMap; 717 if keyChar = 'q' or keyChar = KEY_CLOSE then 718 levelFinished := TRUE; 719 elsif keyChar = 'u' then 720 if savedPackets = numberOfPackets then 721 setPos(win, 31, 1); 722 erase(win, "C O N G R A T U L A T I O N"); 723 writeln(win); 724 writeln(win); 725 erase(win, " The level is solved"); 726 writeln(win); 727 writeln(win); 728 erase(win, "Press n for the next level "); 729 end if; 730 undoMove; 731 writeStatus; 732 drawMap; 733 elsif keyChar = 'r' then 734 redoMove; 735 writeStatus; 736 drawMap; 737 elsif keyChar = 's' then 738 levelFinished := TRUE; 739 elsif keyChar = 'l' then 740 readLevel(keyChar); 741 levelFinished := TRUE; 742 elsif keyChar = 'n' then 743 while levelNumber < length(levels) and keyChar = 'n' do 744 incr(levelNumber); 745 levelFinished := TRUE; 746 keyChar := busy_getc(KEYBOARD); 747 end while; 748 elsif keyChar = 'p' then 749 while levelNumber > 1 and keyChar = 'p' do 750 decr(levelNumber); 751 levelFinished := TRUE; 752 keyChar := busy_getc(KEYBOARD); 753 end while; 754 elsif keyChar = KEY_ESC then 755 bossMode(levelFinished); 756 if levelFinished then 757 keyChar := 'q'; 758 end if; 759 end if; 760 if savedPackets = numberOfPackets then 761 setPos(win, 31, 1); 762 writeln(win, "C O N G R A T U L A T I O N"); 763 writeln(win); 764 writeln(win, " The level is solved"); 765 writeln(win); 766 write(win, "Press n for the next level "); 767 end if; 768 until levelFinished; 769 while keypressed(KEYBOARD) do 770 ignore(getc(KEYBOARD)); 771 end while; 772 end func; 773 774 775const proc: main is func 776 begin 777 screen(992, 544); 778 selectInput(curr_win, KEY_CLOSE, TRUE); 779 KEYBOARD := GRAPH_KEYBOARD; 780 win := openPixmapFontFile(curr_win, 650, 4); 781 setFont(win, stdFont9); 782 color(win, white, black); 783 IN := openEditLine(KEYBOARD, win); 784 loadPixmaps; 785 clear(black); 786 repeat 787 readLevelMap(levelNumber); 788 playLevel; 789 until keyChar = 'q' or keyChar = KEY_CLOSE; 790 end func; 791