' Shisen-Sho game for Rapid-Q by William Yu ' Set your display to at least 800x600 to play this game ' This game was inspired by the original game, with all of the tiles ' copied from the Linux/KDE version. ' ' Rules of the game: ' ------------------ ' Basically just join similar tiles together, with at most 3 lines in ' its path. You do not need to draw these paths, if the 2 tiles can be ' connected with 3 lines or less then they will be marked and removed ' from the playing field. The object therefore is to eliminate all tiles ' from the playing field as quick as possible. ' Not all games are solvable, but most of them should be. ' Click on a tile to select it, click on it again (or click a blank spot) ' to deselect the tile. $TYPECHECK ON $OPTIMIZE ON $INCLUDE "RAPIDQ.INC" $OPTION ICON "shisen.ico" $RESOURCE block1_BMP AS "block1.bmp" $RESOURCE block2_BMP AS "block2.bmp" $RESOURCE block3_BMP AS "block3.bmp" $RESOURCE block4_BMP AS "block4.bmp" $RESOURCE block5_BMP AS "block5.bmp" $RESOURCE block6_BMP AS "block6.bmp" $RESOURCE block7_BMP AS "block7.bmp" $RESOURCE block8_BMP AS "block8.bmp" $RESOURCE block9_BMP AS "block9.bmp" $RESOURCE block10_BMP AS "block10.bmp" $RESOURCE block11_BMP AS "block11.bmp" $RESOURCE block12_BMP AS "block12.bmp" $RESOURCE block13_BMP AS "block13.bmp" $RESOURCE block14_BMP AS "block14.bmp" $RESOURCE block15_BMP AS "block15.bmp" $RESOURCE block16_BMP AS "block16.bmp" $RESOURCE block17_BMP AS "block17.bmp" $RESOURCE block18_BMP AS "block18.bmp" $RESOURCE block19_BMP AS "block19.bmp" $RESOURCE block20_BMP AS "block20.bmp" $RESOURCE block21_BMP AS "block21.bmp" $RESOURCE block22_BMP AS "block22.bmp" $RESOURCE block23_BMP AS "block23.bmp" $RESOURCE block24_BMP AS "block24.bmp" $RESOURCE block25_BMP AS "block25.bmp" $RESOURCE block26_BMP AS "block26.bmp" $RESOURCE block27_BMP AS "block27.bmp" $RESOURCE block28_BMP AS "block28.bmp" $RESOURCE block29_BMP AS "block29.bmp" $RESOURCE block30_BMP AS "block30.bmp" $RESOURCE block31_BMP AS "block31.bmp" $RESOURCE block32_BMP AS "block32.bmp" $RESOURCE block33_BMP AS "block33.bmp" $RESOURCE block34_BMP AS "block34.bmp" $RESOURCE block35_BMP AS "block35.bmp" $RESOURCE block36_BMP AS "block36.bmp" '-- To highlight just a portion of the block CONST blockSideColor = CONST blockColor = RGB(208, 192, 160) CONST highlightBlockColor = RGB(255, 220, 190) CONST gapWidth = 40 CONST gapHeight = 40 CONST maxKinks = 2 TYPE TSelection x AS INTEGER y AS INTEGER END TYPE TYPE TSelectionPath x AS INTEGER y AS INTEGER kinks AS INTEGER END TYPE DIM blocks(1 TO 36) AS QBITMAP blocks(1).bmpHandle = block1_BMP blocks(2).bmpHandle = block2_BMP blocks(3).bmpHandle = block3_BMP blocks(4).bmpHandle = block4_BMP blocks(5).bmpHandle = block5_BMP blocks(6).bmpHandle = block6_BMP blocks(7).bmpHandle = block7_BMP blocks(8).bmpHandle = block8_BMP blocks(9).bmpHandle = block9_BMP blocks(10).bmpHandle = block10_BMP blocks(11).bmpHandle = block11_BMP blocks(12).bmpHandle = block12_BMP blocks(13).bmpHandle = block13_BMP blocks(14).bmpHandle = block14_BMP blocks(15).bmpHandle = block15_BMP blocks(16).bmpHandle = block16_BMP blocks(17).bmpHandle = block17_BMP blocks(18).bmpHandle = block18_BMP blocks(19).bmpHandle = block19_BMP blocks(20).bmpHandle = block20_BMP blocks(21).bmpHandle = block21_BMP blocks(22).bmpHandle = block22_BMP blocks(23).bmpHandle = block23_BMP blocks(24).bmpHandle = block24_BMP blocks(25).bmpHandle = block25_BMP blocks(26).bmpHandle = block26_BMP blocks(27).bmpHandle = block27_BMP blocks(28).bmpHandle = block28_BMP blocks(29).bmpHandle = block29_BMP blocks(30).bmpHandle = block30_BMP blocks(31).bmpHandle = block31_BMP blocks(32).bmpHandle = block32_BMP blocks(33).bmpHandle = block33_BMP blocks(34).bmpHandle = block34_BMP blocks(35).bmpHandle = block35_BMP blocks(36).bmpHandle = block36_BMP DIM playField AS QBITMAP playField.width = 720 + (2 * gapWidth) playField.height = 448 + (2 * gapHeight) playField.paint(0, 0, 0, 0) '-- PlayGrid stores the block values DIM playGrid(0 TO 9, 0 TO 19) AS BYTE '-- HighLightGrid indicates the blocks that are highlighted DIM highlightGrid(1 TO 8, 1 TO 18) AS BYTE DIM selectedBlock AS TSelection selectedBlock.x = 0 selectedBlock.y = 0 DIM selectedPath(0 TO 3) AS TSelectionPath DIM clockTicks AS INTEGER DECLARE SUB formPaint (sender AS QFORM) DECLARE SUB initPlayGrid (playGrid() AS BYTE) DECLARE SUB highlightBlock (x AS INTEGER, y AS INTEGER) DECLARE SUB deHighlightBlock (x AS INTEGER, y AS INTEGER) DECLARE FUNCTION findPath (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER) AS INTEGER DECLARE SUB removeBlock (x AS INTEGER, y AS INTEGER) DECLARE SUB formClick (sender AS QFORM) DECLARE SUB traverseUpperPath (kinkyPath() AS BYTE, x AS INTEGER, y AS INTEGER, stopCount AS INTEGER) DECLARE SUB traverseLowerPath (kinkyPath() AS BYTE, x AS INTEGER, y AS INTEGER, stopCount AS INTEGER) DECLARE SUB traverseLeftPath (kinkyPath() AS BYTE, x AS INTEGER, y AS INTEGER, stopCount AS INTEGER) DECLARE SUB traverseRightPath (kinkyPath() AS BYTE, x AS INTEGER, y AS INTEGER, stopCount AS INTEGER) DECLARE FUNCTION checkForLeftPath (kinkyPath() AS BYTE, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, kinks AS INTEGER) AS INTEGER DECLARE FUNCTION checkForLowerPath (kinkyPath() AS BYTE, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, kinks AS INTEGER) AS INTEGER DECLARE FUNCTION checkForRightPath (kinkyPath() AS BYTE, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, kinks AS INTEGER) AS INTEGER DECLARE FUNCTION checkForUpperPath (kinkyPath() AS BYTE, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, kinks AS INTEGER) AS INTEGER DECLARE SUB newItemClick (sender AS QMENUITEM) DECLARE SUB exitItemClick (sender AS QMENUITEM) DECLARE SUB timer1Expired (sender AS QTIMER) CREATE timer1 AS QTIMER enabled = 0 interval = 1000 onTimer = timer1Expired END CREATE CREATE form AS QFORM caption = "Shisen-Sho" clientWidth = playField.width height = playField.height + 80 onPaint = formPaint onClick = formClick CREATE mainMenu AS QMAINMENU CREATE fileMenu AS QMENUITEM caption = "&File" CREATE newItem AS QMENUITEM caption = "&New game" onClick = newItemClick END CREATE CREATE breakItem AS QMENUITEM caption = "-" END CREATE CREATE exitItem AS QMENUITEM caption = "E&xit" onClick = exitItemClick END CREATE END CREATE END CREATE CREATE statusBar AS QSTATUSBAR addPanels "", "" panel(0).alignment = taCenter panel(0).caption = "00:00" panel(1).caption = "Shisen-Sho for Rapid-Q created by William Yu" END CREATE END CREATE initPlayGrid(playGrid) clockTicks = 0 timer1.enabled = 1 form.showModal '------------------------- Subroutines ---------------------------- SUB initPlayGrid (playGrid() AS BYTE) DEFBYTE numBlocks(1 TO 36) DEFINT i, x, y FOR i = 1 TO 36 numBlocks(i) = 0 NEXT RANDOMIZE TIMER FOR y = 0 TO 9 FOR x = 0 TO 19 IF y = 0 OR y = 9 OR x = 0 OR x = 19 THEN playGrid(y, x) = 0 ELSE highlightGrid(y, x) = 0 i = INT(RND(36)) + 1 while numBlocks(i) = 4 i = INT(RND(36)) + 1 wend numBlocks(i) = numBlocks(i) + 1 playGrid(y, x) = i playField.draw((x - 1) * 40 + gapWidth, (y - 1) * 56 + gapHeight, blocks(i).bmp) END IF NEXT NEXT END SUB SUB formPaint (sender AS QFORM) sender.draw(0, 0, playField.bmp) END SUB SUB highlightBlock (x AS INTEGER, y AS INTEGER) '-- Highlights a block DEFINT i, j highlightGrid(y, x) = 1 selectedBlock.x = x selectedBlock.y = y x = (x - 1) * 40 + gapWidth + 5 y = (y - 1) * 56 + gapHeight + 1 FOR i = y TO y + 51 FOR j = x TO x + 38 IF playField.pixel(j, i) = blockColor THEN playField.pixel(j, i) = highlightBlockColor ' playField.pixel(j, i) - &H333333 END IF NEXT NEXT END SUB SUB deHighlightBlock (x AS INTEGER, y AS INTEGER) '-- Dehighlights a block highlightGrid(y, x) = 0 selectedBlock.x = 0 selectedBlock.y = 0 playField.draw((x - 1) * 40 + gapWidth, (y - 1) * 56 + gapHeight, blocks(playGrid(y, x)).bmp) END SUB SUB traverseUpperPath (kinkyPath() AS BYTE, x AS INTEGER, y AS INTEGER, stopCount AS INTEGER) '-- Check Upper side IF y = 0 THEN EXIT SUB WHILE y > 0 DEC(y) IF y = 0 THEN '-- On the upper edge traverseLeftPath(kinkyPath, x, y, stopCount) traverseRightPath(kinkyPath, x, y, stopCount) ELSE IF playGrid(y, x) = 0 AND kinkyPath(y, x) < stopCount THEN kinkyPath(y, x) = kinkyPath(y, x) + 1 traverseLowerPath(kinkyPath, x, y, stopCount) traverseLeftPath(kinkyPath, x, y, stopCount) traverseRightPath(kinkyPath, x, y, stopCount) ELSE EXIT WHILE END IF END IF WEND END SUB SUB traverseLowerPath (kinkyPath() AS BYTE, x AS INTEGER, y AS INTEGER, stopCount AS INTEGER) '-- Check Upper side IF y = 9 THEN EXIT SUB WHILE y < 9 INC(y) IF y = 9 THEN '-- On the lower edge traverseLeftPath(kinkyPath, x, y, stopCount) traverseRightPath(kinkyPath, x, y, stopCount) ELSE IF playGrid(y, x) = 0 AND kinkyPath(y, x) < stopCount THEN kinkyPath(y, x) = kinkyPath(y, x) + 1 traverseUpperPath(kinkyPath, x, y, stopCount) traverseLeftPath(kinkyPath, x, y, stopCount) traverseRightPath(kinkyPath, x, y, stopCount) ELSE EXIT WHILE END IF END IF WEND END SUB SUB traverseRightPath (kinkyPath() AS BYTE, x AS INTEGER, y AS INTEGER, stopCount AS INTEGER) '-- Check left side IF x = 19 THEN EXIT SUB WHILE x < 19 INC(x) IF x = 19 THEN '-- On the left edge traverseUpperPath(kinkyPath, x, y, stopCount) traverseLowerPath(kinkyPath, x, y, stopCount) ELSE IF playGrid(y, x) = 0 AND kinkyPath(y, x) < stopCount THEN kinkyPath(y, x) = kinkyPath(y, x) + 1 traverseUpperPath(kinkyPath, x, y, stopCount) traverseLowerPath(kinkyPath, x, y, stopCount) traverseLeftPath(kinkyPath, x, y, stopCount) ELSE EXIT WHILE END IF END IF WEND END SUB SUB traverseLeftPath (kinkyPath() AS BYTE, x AS INTEGER, y AS INTEGER, stopCount AS INTEGER) '-- Check left side IF x = 0 THEN EXIT SUB WHILE x > 0 DEC(x) IF x = 0 THEN '-- On the left edge traverseUpperPath(kinkyPath, x, y, stopCount) traverseLowerPath(kinkyPath, x, y, stopCount) ELSE IF playGrid(y, x) = 0 AND kinkyPath(y, x) < stopCount THEN kinkyPath(y, x) = kinkyPath(y, x) + 1 traverseUpperPath(kinkyPath, x, y, stopCount) traverseLowerPath(kinkyPath, x, y, stopCount) traverseRightPath(kinkyPath, x, y, stopCount) ELSE EXIT WHILE END IF END IF WEND END SUB FUNCTION checkForUpperPath (kinkyPath() AS BYTE, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, kinks AS INTEGER) AS INTEGER '-- Check path on Upper side result = 0 IF kinks > maxKinks THEN EXIT FUNCTION '-- Too many kinks ELSEIF y1 = 0 OR kinkyPath(y1 - 1, x1) < 2 THEN '-- Dead end EXIT FUNCTION ELSEIF x1 = x2 AND y1 - 1 = y2 THEN '-- Match found, we're done here selectedPath(kinks + 1).x = x2 selectedPath(kinks + 1).y = y2 selectedPath(0).kinks = kinks + 1 result = 1 EXIT FUNCTION END IF WHILE y1 > 0 DEC(y1) IF y1 = 0 THEN '-- On the upper edge selectedPath(kinks + 1).x = x1 selectedPath(kinks + 1).y = y1 IF checkForLeftPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF IF checkForRightPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF ELSEIF x1 = x2 AND y1 = y2 THEN '-- Match found, we're done here selectedPath(kinks + 1).x = x2 selectedPath(kinks + 1).y = y2 selectedPath(0).kinks = kinks + 1 result = 1 EXIT FUNCTION ELSE IF kinkyPath(y1, x1) <> 2 THEN '-- Dead end EXIT WHILE ELSE '-- Look around selectedPath(kinks + 1).x = x1 selectedPath(kinks + 1).y = y1 IF checkForLeftPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF IF checkForRightPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF END IF END IF WEND END FUNCTION FUNCTION checkForLowerPath (kinkyPath() AS BYTE, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, kinks AS INTEGER) AS INTEGER '-- Check path on Lower side result = 0 IF kinks > maxKinks THEN EXIT FUNCTION '-- Too many kinks ELSEIF y1 = 9 OR kinkyPath(y1 + 1, x1) < 2 THEN '-- Dead end EXIT FUNCTION ELSEIF x1 = x2 AND y1 + 1 = y2 THEN '-- Match found, we're done here selectedPath(kinks + 1).x = x2 selectedPath(kinks + 1).y = y2 selectedPath(0).kinks = kinks + 1 result = 1 EXIT FUNCTION END IF WHILE y1 < 9 INC(y1) IF y1 = 9 THEN '-- On the lower edge selectedPath(kinks + 1).x = x1 selectedPath(kinks + 1).y = y1 IF checkForLeftPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF IF checkForRightPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF ELSEIF x1 = x2 AND y1 = y2 THEN '-- Match found, we're done here selectedPath(kinks + 1).x = x2 selectedPath(kinks + 1).y = y2 selectedPath(0).kinks = kinks + 1 result = 1 EXIT FUNCTION ELSE IF kinkyPath(y1, x1) <> 2 THEN '-- Dead end EXIT WHILE ELSE '-- Look around selectedPath(kinks + 1).x = x1 selectedPath(kinks + 1).y = y1 IF checkForLeftPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF IF checkForRightPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF END IF END IF WEND END FUNCTION FUNCTION checkForLeftPath (kinkyPath() AS BYTE, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, kinks AS INTEGER) AS INTEGER '-- Check path on left side result = 0 IF kinks > maxKinks THEN EXIT FUNCTION '-- Too many kinks ELSEIF x1 = 0 OR kinkyPath(y1, x1 - 1) < 2 THEN '-- Dead end EXIT FUNCTION ELSEIF x1 - 1 = x2 AND y1 = y2 THEN '-- Match found, we're done here selectedPath(kinks + 1).x = x2 selectedPath(kinks + 1).y = y2 selectedPath(0).kinks = kinks + 1 result = 1 EXIT FUNCTION END IF WHILE x1 > 0 DEC(x1) IF x1 = 0 THEN '-- On the left edge selectedPath(kinks + 1).x = x1 selectedPath(kinks + 1).y = y1 IF checkForUpperPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF IF checkForLowerPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF ELSEIF x1 = x2 AND y1 = y2 THEN '-- Match found, we're done here selectedPath(kinks + 1).x = x2 selectedPath(kinks + 1).y = y2 selectedPath(0).kinks = kinks + 1 result = 1 EXIT FUNCTION ELSE IF kinkyPath(y1, x1) <> 2 THEN '-- Dead end EXIT WHILE ELSE '-- Look around selectedPath(kinks + 1).x = x1 selectedPath(kinks + 1).y = y1 IF checkForUpperPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF IF checkForLowerPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF END IF END IF WEND END FUNCTION FUNCTION checkForRightPath (kinkyPath() AS BYTE, x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, kinks AS INTEGER) AS INTEGER '-- Check path on right side result = 0 IF kinks > maxKinks THEN EXIT FUNCTION '-- Too many kinks ELSEIF x1 = 19 OR kinkyPath(y1, x1 + 1) < 2 THEN '-- Dead end EXIT FUNCTION ELSEIF x1 + 1 = x2 AND y1 = y2 THEN '-- Match found, we're done here selectedPath(kinks + 1).x = x2 selectedPath(kinks + 1).y = y2 selectedPath(0).kinks = kinks + 1 result = 1 EXIT FUNCTION END IF WHILE x1 < 19 INC(x1) IF x1 = 19 THEN '-- On the left edge selectedPath(kinks + 1).x = x1 selectedPath(kinks + 1).y = y1 IF checkForUpperPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF IF checkForLowerPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF ELSEIF x1 = x2 AND y1 = y2 THEN '-- Match found, we're done here selectedPath(kinks + 1).x = x2 selectedPath(kinks + 1).y = y2 selectedPath(0).kinks = kinks + 1 result = 1 EXIT FUNCTION ELSE IF kinkyPath(y1, x1) <> 2 THEN '-- Dead end EXIT WHILE ELSE '-- Look around selectedPath(kinks + 1).x = x1 selectedPath(kinks + 1).y = y1 IF checkForUpperPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF IF checkForLowerPath(kinkyPath, x1, y1, x2, y2, kinks + 1) THEN '-- Match found result = 1 EXIT FUNCTION END IF END IF END IF WEND END FUNCTION FUNCTION findPath (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER) AS INTEGER '-- Not quite shortest path, just find one with at most 3 kinks in it DEFBYTE kinkyPath(0 TO 9, 0 TO 19) DEFINT kinks = 0, x, y, count, pathExists '-- Try to eliminate options findPath = 0 '-- Find direct path IF x1 = x2 THEN '-- Direct vertical path count = 0 IF y1 > y2 THEN FOR y = y2+1 to y1-1 count += playGrid(y, x1) NEXT ELSE FOR y = y1+1 to y2-1 count += playGrid(y, x1) NEXT END IF IF count = 0 THEN '-- We have a direct path playField.fillRect((x1 - 1) * 40 + gapWidth + 20, (y1 - 1) * 56 + gapHeight + 28, _ (x1 - 1) * 40 + gapWidth + 25, (y2 - 1) * 56 + gapHeight + 28, &HFF) highlightBlock(x1, y1) formPaint(form) SLEEP 0.5 playField.fillRect((x1 - 1) * 40 + gapWidth + 20, (y1 - 1) * 56 + gapHeight + 28, _ (x1 - 1) * 40 + gapWidth + 25, (y2 - 1) * 56 + gapHeight + 28, 0) findPath = 1 removeBlock(x1, y1) removeBlock(x2, y2) selectedBlock.x = 0 selectedBlock.y = 0 EXIT FUNCTION END IF ELSEIF y1 = y2 THEN '-- Direct horizontal path count = 0 IF x1 > x2 THEN FOR x = x2+1 to x1-1 count += playGrid(y1, x) NEXT ELSE FOR x = x1+1 to x2-1 count += playGrid(y1, x) NEXT END IF IF count = 0 THEN '-- We have a direct path playField.fillRect((x1 - 1) * 40 + gapWidth + 20, (y1 - 1) * 56 + gapHeight + 25, _ (x2 - 1) * 40 + gapWidth + 20, (y1 - 1) * 56 + gapHeight + 30, &HFF) highlightBlock(x1, y1) formPaint(form) SLEEP 0.5 playField.fillRect((x1 - 1) * 40 + gapWidth + 20, (y1 - 1) * 56 + gapHeight + 25, _ (x2 - 1) * 40 + gapWidth + 20, (y1 - 1) * 56 + gapHeight + 30, 0) findPath = 1 removeBlock(x1, y1) removeBlock(x2, y2) selectedBlock.x = 0 selectedBlock.y = 0 EXIT FUNCTION END IF END IF '-- No direct path, try the indirect approach. FOR y = 0 TO 9 FOR x = 0 TO 19 kinkyPath(y, x) = 0 NEXT NEXT traverseLeftPath(kinkyPath, x1, y1, 1) traverseRightPath(kinkyPath, x1, y1, 1) traverseUpperPath(kinkyPath, x1, y1, 1) traverseLowerPath(kinkyPath, x1, y1, 1) traverseLeftPath(kinkyPath, x2, y2, 2) traverseRightPath(kinkyPath, x2, y2, 2) traverseUpperPath(kinkyPath, x2, y2, 2) traverseLowerPath(kinkyPath, x2, y2, 2) kinkyPath(y1, x1) = 9 kinkyPath(y2, x2) = 9 kinkyPath(0, 0) = 2 kinkyPath(9, 0) = 2 kinkyPath(0, 19) = 2 kinkyPath(9, 19) = 2 'FOR y = 0 TO 9 ' FOR x = 0 TO 19 ' PRINT kinkyPath(y, x); " "; ' NEXT ' PRINT 'NEXT IF (kinkyPath(y1-1, x1) = 2) OR (kinkyPath(y1+1, x1) = 2) OR (kinkyPath(y1, x1-1) = 2) OR (kinkyPath(y1, x1+1) = 2) THEN IF (kinkyPath(y2-1, x2) = 2) OR (kinkyPath(y2+1, x2) = 2) OR (kinkyPath(y2, x2-1) = 2) OR (kinkyPath(y2, x2+1) = 2) THEN x = x1: y = y1 IF y1 > y2 THEN SWAP y1, y2 SWAP x1, x2 END IF IF (kinkyPath(y1+1, x1) <> 2) AND (kinkyPath(y1, x1-1) <> 2) AND (kinkyPath(y1, x1+1) <> 2) THEN IF (kinkyPath(y2-1, x2) <> 2) AND (kinkyPath(y2, x2-1) <> 2) AND (kinkyPath(y2, x2+1) <> 2) THEN '-- Impossible move EXIT FUNCTION END IF END IF IF x1 > x2 THEN SWAP y1, y2 SWAP x1, x2 END IF IF (kinkyPath(y1+1, x1) <> 2) AND (kinkyPath(y1-1, x1) <> 2) AND (kinkyPath(y1, x1+1) <> 2) THEN IF (kinkyPath(y2+1, x2) <> 2) AND (kinkyPath(y2-1, x2) <> 2) AND (kinkyPath(y2, x2-1) <> 2) THEN '-- Impossible move EXIT FUNCTION END IF END IF pathExists = 0 IF y1 > y2 THEN IF checkForLowerPath(kinkyPath, x1, y1, x2, y2, 0) THEN pathExists = 1 ELSEIF checkForLeftPath(kinkyPath, x1, y1, x2, y2, 0) THEN pathExists = 1 ELSEIF checkForRightPath(kinkyPath, x1, y1, x2, y2, 0) THEN pathExists = 1 ELSEIF checkForUpperPath(kinkyPath, x1, y1, x2, y2, 0) THEN pathExists = 1 END IF ELSE IF checkForUpperPath(kinkyPath, x1, y1, x2, y2, 0) THEN pathExists = 1 ELSEIF checkForLeftPath(kinkyPath, x1, y1, x2, y2, 0) THEN pathExists = 1 ELSEIF checkForRightPath(kinkyPath, x1, y1, x2, y2, 0) THEN pathExists = 1 ELSEIF checkForLowerPath(kinkyPath, x1, y1, x2, y2, 0) THEN pathExists = 1 END IF END IF IF pathExists THEN findPath = 1 highlightBlock(x, y) selectedPath(0).x = x1 selectedPath(0).y = y1 FOR count = 1 TO selectedPath(0).kinks IF selectedPath(count - 1).y = selectedPath(count).y THEN '-- Horizontal playField.fillRect((selectedPath(count - 1).x - 1) * 40 + gapWidth + 18, (selectedPath(count - 1).y - 1) * 56 + gapHeight + 26, _ (selectedPath(count).x - 1) * 40 + gapWidth + 22, (selectedPath(count - 1).y - 1) * 56 + gapHeight + 30, &HFF) ELSE '-- Vertical playField.fillRect((selectedPath(count - 1).x - 1) * 40 + gapWidth + 18, (selectedPath(count - 1).y - 1) * 56 + gapHeight + 26, _ (selectedPath(count - 1).x - 1) * 40 + gapWidth + 22, (selectedPath(count).y - 1) * 56 + gapHeight + 30, &HFF) END IF NEXT formPaint(form) SLEEP 0.5 findPath = 1 removeBlock(x1, y1) removeBlock(x2, y2) selectedBlock.x = 0 selectedBlock.y = 0 FOR count = 1 TO selectedPath(0).kinks IF selectedPath(count - 1).y = selectedPath(count).y THEN '-- Horizontal playField.fillRect((selectedPath(count - 1).x - 1) * 40 + gapWidth + 18, (selectedPath(count - 1).y - 1) * 56 + gapHeight + 26, _ (selectedPath(count).x - 1) * 40 + gapWidth + 22, (selectedPath(count - 1).y - 1) * 56 + gapHeight + 30, 0) ELSE '-- Vertical playField.fillRect((selectedPath(count - 1).x - 1) * 40 + gapWidth + 18, (selectedPath(count - 1).y - 1) * 56 + gapHeight + 26, _ (selectedPath(count - 1).x - 1) * 40 + gapWidth + 22, (selectedPath(count).y - 1) * 56 + gapHeight + 30, 0) END IF NEXT END IF END IF END IF END FUNCTION SUB removeBlock (x AS INTEGER, y AS INTEGER) '-- Removes a block from the grid playGrid(y, x) = 0 x = (x - 1) * 40 + gapWidth y = (y - 1) * 56 + gapHeight playField.fillRect(x, y, x + 40, y + 56, 0) END SUB SUB formClick (sender AS QFORM) DEFINT x, y x = FLOOR((MouseX - gapWidth) / 40) + 1 y = FLOOR((MouseY - gapHeight) / 56) + 1 IF (x < 1 OR x > 18) OR (y < 1 OR y > 8) THEN IF selectedBlock.x > 0 THEN deHighlightBlock(selectedBlock.x, selectedBlock.y) formPaint(sender) EXIT SUB ELSEIF playGrid(y, x) = 0 THEN IF selectedBlock.x > 0 THEN deHighlightBlock(selectedBlock.x, selectedBlock.y) formPaint(sender) EXIT SUB END IF IF selectedBlock.x = x AND selectedBlock.y = y THEN deHighlightBlock(x, y) ELSE IF selectedBlock.x > 0 THEN '-- Check for matches IF playGrid(y, x) = playGrid(selectedBlock.y, selectedBlock.x) THEN IF findPath(x, y, selectedBlock.x, selectedBlock.y) THEN '-- Found match, now check if we're finished DEFINT count = 0 FOR y = 1 TO 8 FOR x = 1 TO 18 count += playGrid(y, x) NEXT NEXT IF count = 0 THEN timer1.enabled = 0 SHOWMESSAGE "Congratulations, you've won!" + CHR$(13) + _ "With a time of " + STR$(clockTicks) + " seconds!" END IF END IF END IF ELSE highlightBlock(x, y) END IF END IF formPaint(sender) END SUB SUB newItemClick (sender AS QMENUITEM) initPlayGrid(playGrid) clockTicks = 0 timer1.enabled = 1 timer1.interval = 1000 formPaint(form) END SUB SUB exitItemClick (sender AS QMENUITEM) form.close END SUB SUB timer1Expired (sender AS QTIMER) INC(clockTicks) statusBar.panel(0).caption = RIGHT$("00"+STR$(FLOOR(clockTicks / 60)), 2) + ":" + RIGHT$("00"+STR$(clockTicks MOD 60), 2) END SUB