This is total overhaul of Rick's TriQuad clone done in Naalaa some time ago. This game allows user to choose from 3 to 9 square pieces per side, uses a different method to build the puzzle and uses a different method to detect/check solutions since it is possible by random luck to have multiple solutions to a puzzle.
QB64v1.3OPTION _EXPLICIT
_TITLE "TriQuad Puzzle" 'B+ start 2019-07-17 trans to QB64 from:
' TriQuad.bas SmallBASIC 0.12.8 [B+=MGA] 2017-03-26
' inspired by rick3137's recent post at Naalaa of cute puzzle
' 2019-07 Complete remake for N X N puzzles, not just 3 X 3's.
RANDOMIZE TIMER
CONST xmax = 1000, margin = 50 'screen size, margin that should allow a line above and below the puzzle display
CONST topLeftB1X = margin, topLeftB2X = xmax / 2 + .5 * margin, topY = margin
'these have to be decided from user input from Intro screen
DIM SHARED ymax, N, Nm1, NxNm1, sq, sq2, sq4
ymax = 500 'for starters in intro screen have resizing in pixels including ymax
REDIM SHARED B1(2, 2), B2(2, 2) ' B1() box container for scrambled pieces of C(), B2 box container to build solution
REDIM SHARED C(8, 3) '9 squares 4 colored triangles, C() contains the solution as created by code, may not be the only one!
DIM mx, my, mb, bx, by, holdF, ky AS STRING, again AS STRING
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 40
intro
restart:
assignColors
holdF = N * N
WHILE 1
CLS
showB (1)
showB (2)
WHILE _MOUSEINPUT: WEND
mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
IF mb THEN
DO WHILE mb
WHILE _MOUSEINPUT: WEND
mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
LOOP
IF topY <= my AND my <= topY + N * sq THEN
by = INT((my - topY) / sq)
'LOCATE 1, 1: PRINT SPACE$(20)
'LOCATE 1, 1: PRINT "bY = "; by
IF topLeftB1X <= mx AND mx <= topLeftB1X + N * sq THEN 'mx in b1
bx = INT((mx - topLeftB1X) / sq)
'LOCATE 2, 1: PRINT SPACE$(20)
'LOCATE 2, 1: PRINT "bX = "; bx
IF holdF < N * N THEN 'trying to put the piece on hold here?
IF B1(bx, by) = N * N THEN
B1(bx, by) = holdF: holdF = N * N
END IF
ELSEIF holdF = N * N THEN
IF B1(bx, by) < N * N THEN
holdF = B1(bx, by): B1(bx, by) = N * N
END IF
END IF
ELSEIF topLeftB2X <= mx AND mx <= topLeftB2X + N * sq THEN 'mx in b2
bx = INT((mx - topLeftB2X) / sq)
'LOCATE 2, 1: PRINT SPACE$(20)
'LOCATE 2, 1: PRINT "bX = "; bx
IF holdF < N * N THEN
IF B2(bx, by) = N * N THEN
B2(bx, by) = holdF: holdF = N * N
END IF
ELSEIF holdF = N * N THEN
IF B2(bx, by) < N * N THEN
holdF = B2(bx, by): B2(bx, by) = N * N
END IF
END IF 'my out of range
END IF
END IF
END IF
IF solved THEN
COLOR hue(9)
LOCATE 2, 1: centerPrint "Congratulations puzzle solved!"
_DISPLAY
_DELAY 3
EXIT WHILE
END IF
ky = INKEY$
IF LEN(ky) THEN
IF ky = "q" THEN
showSolution
COLOR hue(9)
LOCATE 2, 1: centerPrint "Here is solution (for 10 secs), Goodbye!"
_DISPLAY
_DELAY 10
SYSTEM
END IF
END IF
_DISPLAY
_LIMIT 100
WEND
COLOR hue(9): LOCATE 2, 1: centerPrint SPACE$(50): LOCATE 2, 1
centerPrint "Press enter to play again, any + enter ends... "
_DISPLAY
again = INKEY$
WHILE LEN(again) = 0: again = INKEY$: _LIMIT 200: WEND
IF ASC(again) = 13 THEN GOTO restart ELSE SYSTEM
FUNCTION solved
'since it is possible that a different tile combination could be a valid solution we have to check points
DIM x, y
'first check that there is a puzzle piece in every slot of b2
FOR y = 0 TO Nm1
FOR x = 0 TO Nm1
IF B2(x, y) = N * N THEN EXIT FUNCTION
NEXT
NEXT
'check left and right triangle matches in b2
FOR y = 0 TO Nm1
FOR x = 0 TO Nm1 - 1
IF POINT(topLeftB2X + x * sq + sq2 + sq4, topY + y * sq + sq2) <> POINT(topLeftB2X + (x + 1) * sq + sq4, topY + y * sq + sq2) THEN EXIT FUNCTION
NEXT
NEXT
'check to and bottom triangle matches in b2
FOR y = 0 TO Nm1 - 1
FOR x = 0 TO Nm1
'the color of tri4 in piece below = color tri1 of piece above
IF POINT(topLeftB2X + x * sq + sq2, topY + y * sq + sq2 + sq4) <> POINT(topLeftB2X + x * sq + sq2, topY + (y + 1) * sq + sq4) THEN EXIT FUNCTION
NEXT
NEXT
'if made it this far then solved
solved = -1
END FUNCTION
SUB showSolution
DIM x, y, index
FOR y = 0 TO Nm1
FOR x = 0 TO Nm1
drawSquare index, x * sq + topLeftB2X, y * sq + topY
index = index + 1
NEXT
NEXT
END SUB
SUB showB (board)
DIM x, y, index
FOR y = 0 TO Nm1
FOR x = 0 TO Nm1
IF board = 1 THEN
index = B1(x, y)
drawSquare index, x * sq + topLeftB1X, y * sq + topY
ELSE
index = B2(x, y)
drawSquare index, x * sq + topLeftB2X, y * sq + topY
END IF
NEXT
NEXT
END SUB
SUB drawSquare (index, x, y)
LINE (x, y)-STEP(sq, sq), &HFF000000, BF
LINE (x, y)-STEP(sq, sq), &HFFFFFFFF, B
IF index < N * N THEN
LINE (x, y)-STEP(sq, sq), &HFFFFFFFF
LINE (x + sq, y)-STEP(-sq, sq), &HFFFFFFFF
PAINT (x + sq2 + sq4, y + sq2), hue(C(index, 0)), &HFFFFFFFF
PAINT (x + sq2, y + sq2 + sq4), hue(C(index, 1)), &HFFFFFFFF
PAINT (x + sq4, y + sq2), hue(C(index, 2)), &HFFFFFFFF
PAINT (x + sq2, y + sq4), hue(C(index, 3)), &HFFFFFFFF
END IF
END SUB
SUB assignColors ()
'the pieces are indexed 0 to N X N -1 (NxNm1)
' y(index) = int(index/N) : x(index) = index mod N
' index(x, y) = (y - 1) * N + x
DIM i, j, x, y
'first assign a random color rc to every triangle
FOR i = 0 TO NxNm1 'piece index
FOR j = 0 TO 3 'tri color index for piece
C(i, j) = rand(1, 9)
NEXT
NEXT
'next match c0 to c3 of square to right
FOR y = 0 TO Nm1
FOR x = 0 TO Nm1 - 1
'the color of tri3 of next square piece to right = color of tri0 to left of it
C(y * N + x + 1, 2) = C(y * N + x, 0)
NEXT
NEXT
FOR y = 0 TO Nm1 - 1
FOR x = 0 TO Nm1
'the color of tri4 in piece below = color tri1 of piece above
C((y + 1) * N + x, 3) = C(y * N + x, 1)
NEXT
NEXT
' C() now contains one solution for puzzle, may not be the only one
' scramble pieces to box1
DIM t(0 TO NxNm1), index 'temp array
FOR i = 0 TO NxNm1: t(i) = i: NEXT
FOR i = NxNm1 TO 1 STEP -1: SWAP t(i), t(rand(0, i)): NEXT
FOR y = 0 TO Nm1
FOR x = 0 TO Nm1
B1(x, y) = t(index)
index = index + 1
B2(x, y) = N * N
'PRINT B1(x, y), B2(x, y)
NEXT
NEXT
END SUB
FUNCTION hue~& (n)
SELECT CASE n
CASE 0: hue~& = &HFF000000
CASE 1: hue~& = &HFFA80062
CASE 2: hue~& = &HFF000050
CASE 3: hue~& = &HFFE3333C
CASE 4: hue~& = &HFFFF0000
CASE 5: hue~& = &HFF008000
CASE 6: hue~& = &HFF0000FF
CASE 7: hue~& = &HFFFF64FF
CASE 8: hue~& = &HFFFFFF00
CASE 9: hue~& = &HFF00EEEE
CASE 10: hue~& = &HFF663311
END SELECT
END FUNCTION
FUNCTION rand% (n1, n2)
DIM hi, lo
IF n1 > n2 THEN hi = n1: lo = n2 ELSE hi = n2: lo = n1
rand% = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION
SUB intro 'use intro to select number of pieces
DIM test AS INTEGER
CLS: COLOR hue(8): LOCATE 3, 1
centerPrint "TriQuad Instructions:": PRINT: COLOR hue(9)
centerPrint "This puzzle has two boxes that contain up to N x N square pieces of 4 colored triangles."
centerPrint "The object is to match up the triangle edges from left Box to fill the Box on the right.": PRINT
centerPrint "You may move any square piece to an empty space on either board by:"
centerPrint "1st clicking the piece to disappear it,"
centerPrint "then clicking any empty space for it to reappear.": PRINT
centerPrint "You may press q to quit and see the solution displayed.": PRINT
centerPrint "Hint: the colors without matching"
centerPrint "complement, are edge pieces.": PRINT
centerPrint "Good luck!": COLOR hue(5)
LOCATE CSRLIN + 2, 1: centerPrint "Press number key for square pieces per side (3 to 9, 1 to quit)..."
WHILE test < 3 OR test > 9
test = VAL(INKEY$)
IF test = 1 THEN SYSTEM
WEND
N = test ' pieces per side of 2 boards
Nm1 = N - 1 ' FOR loops
NxNm1 = N * N - 1 ' FOR loop of piece index
'sizing
sq = (xmax / 2 - 1.5 * margin) / N 'square piece side size
sq2 = sq / 2: sq4 = sq / 4
ymax = sq * N + 2 * margin
REDIM B1(Nm1, Nm1), B2(Nm1, Nm1), C(NxNm1, 3)
SCREEN _NEWIMAGE(xmax, ymax, 32)
'_SCREENMOVE 300, 40 'need again?
'PRINT ymax
END SUB
SUB centerPrint (s$)
LOCATE CSRLIN, (xmax / 8 - LEN(s$)) / 2: PRINT s$
END SUB
