2000-08-15 16:15

' 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

2000-08-15 16:15