' 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 = 6848648
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