Author Topic: TriQuad Remake  (Read 267 times)

B+

  • Hero Member
  • *****
  • Posts: 847
    • View Profile
TriQuad Remake
« on: 21. July 2019, 03:51:05 »
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.3
Code: [Select]
OPTION _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
« Last Edit: 21. July 2019, 04:08:23 by B+ »

Rick3137

  • Full Member
  • ***
  • Posts: 131
    • View Profile
    • Rick's Programs
Re: TriQuad Remake
« Reply #1 on: 21. July 2019, 22:47:24 »
   Awesome!!

   Much better than the one I made. Thanks for sharing.

   I noticed a slight problem with qb64, when I was downloading. I have a habit of copy and paste to notepad or wordpad when I get a short program from a forum. This does not work with qb64.
   I had to paste straight to the qb64 editor. There is some problem somewhere with the text format that causes errors.

 
http://rb23.yolasite.com  Ricks Programs
http://rb27.synthasite.com   Sight and Sound

B+

  • Hero Member
  • *****
  • Posts: 847
    • View Profile
Re: TriQuad Remake
« Reply #2 on: 21. July 2019, 23:04:15 »
Hi Rick,

I am glad you approve of remake.

I don't think I've ever pasted a QB64 program into a third party editor, seems like an unnecessary step. But a third party editor has the advantage of a modern file manager that can create new folders and allow you see the other files you are Saving AS... as well as Rename, Delete and other file maintenance...