Author Topic: TriQuad Puzzle inspired by Rick3137  (Read 4207 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
TriQuad Puzzle inspired by Rick3137
« on: January 09, 2022, 04:14:29 pm »
Welcome @Rick3137

Remember this (over 4 years ago)?
Code: QB64: [Select]
  1. _Title "TriQuad Puzzle" 'B+ start 2019-07-17 trans to QB64 from:
  2. ' TriQuad.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-03-26
  3. ' inspired by rick3137's recent post at Naalaa of cute puzzle
  4. ' 2019-07 Complete remake for N X N puzzles, not just 3 X 3's.
  5. ' post at QB64 forum 2019-10-14
  6.  
  7.  
  8. Const xmax = 1000, margin = 50 'screen size, margin that should allow a line above and below the puzzle display
  9. Const topLeftB1X = margin, topLeftB2X = xmax / 2 + .5 * margin, topY = margin
  10.  
  11. 'these have to be decided from user input from Intro screen
  12. Dim Shared ymax, N, Nm1, NxNm1, sq, sq2, sq4
  13. ymax = 500 'for starters in intro screen have resizing in pixels including ymax
  14.  
  15. ReDim Shared B1(2, 2), B2(2, 2) ' B1() box container for scrambled pieces of C(), B2 box container to build solution
  16. ReDim Shared C(8, 3) '9 squares 4 colored triangles, C() contains the solution as created by code, may not be the only one!
  17.  
  18. Dim mx, my, mb, bx, by, holdF, ky As String, again As String
  19.  
  20. Screen _NewImage(xmax, ymax, 32)
  21. _ScreenMove 300, 40
  22. intro
  23. restart:
  24. assignColors
  25. holdF = N * N
  26.     Cls
  27.     showB (1)
  28.     showB (2)
  29.     mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
  30.     If mb Then
  31.         Do While mb
  32.             While _MouseInput: Wend
  33.             mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
  34.         Loop
  35.         If topY <= my And my <= topY + N * sq Then
  36.             by = Int((my - topY) / sq)
  37.             If topLeftB1X <= mx And mx <= topLeftB1X + N * sq Then 'mx in b1
  38.                 bx = Int((mx - topLeftB1X) / sq)
  39.                 If holdF < N * N Then 'trying to put the piece on hold here?
  40.                     If B1(bx, by) = N * N Then
  41.                         B1(bx, by) = holdF: holdF = N * N
  42.                     End If
  43.                 ElseIf holdF = N * N Then
  44.                     If B1(bx, by) < N * N Then
  45.                         holdF = B1(bx, by): B1(bx, by) = N * N
  46.                     End If
  47.                 End If
  48.             ElseIf topLeftB2X <= mx And mx <= topLeftB2X + N * sq Then 'mx in b2
  49.                 bx = Int((mx - topLeftB2X) / sq)
  50.                 If holdF < N * N Then
  51.                     If B2(bx, by) = N * N Then
  52.                         B2(bx, by) = holdF: holdF = N * N
  53.                     End If
  54.                 ElseIf holdF = N * N Then
  55.                     If B2(bx, by) < N * N Then
  56.                         holdF = B2(bx, by): B2(bx, by) = N * N
  57.                     End If
  58.                 End If 'my out of range
  59.             End If
  60.         End If
  61.     End If
  62.     If solved Then
  63.         Color hue(9)
  64.         Locate 2, 1: centerPrint "Congratulations puzzle solved!"
  65.         _Display
  66.         _Delay 3
  67.         Exit While
  68.     End If
  69.     ky = InKey$
  70.     If Len(ky) Then
  71.         If ky = "q" Then
  72.             showSolution
  73.             Color hue(9)
  74.             Locate 2, 1: centerPrint "Here is solution (for 10 secs), Goodbye!"
  75.             _Display
  76.             _Delay 10
  77.             System
  78.         End If
  79.     End If
  80.     _Display
  81.     _Limit 100
  82. Color hue(9): Locate 2, 1: centerPrint Space$(50): Locate 2, 1
  83. centerPrint "Press enter to play again, any + enter ends... "
  84. again = InKey$
  85. While Len(again) = 0: again = InKey$: _Limit 200: Wend
  86. If Asc(again) = 13 Then GoTo restart Else System
  87.  
  88. Function solved
  89.     'since it is possible that a different tile combination could be a valid solution we have to check points
  90.     Dim x, y
  91.     'first check that there is a puzzle piece in every slot of b2
  92.     For y = 0 To Nm1
  93.         For x = 0 To Nm1
  94.             If B2(x, y) = N * N Then Exit Function
  95.         Next
  96.     Next
  97.     'check left and right triangle matches in b2
  98.     For y = 0 To Nm1
  99.         For x = 0 To Nm1 - 1
  100.             If Point(topLeftB2X + x * sq + sq2 + sq4, topY + y * sq + sq2) <> Point(topLeftB2X + (x + 1) * sq + sq4, topY + y * sq + sq2) Then Exit Function
  101.         Next
  102.     Next
  103.     'check to and bottom triangle matches in b2
  104.     For y = 0 To Nm1 - 1
  105.         For x = 0 To Nm1
  106.             'the color of tri4 in piece below = color tri1 of piece above
  107.             If Point(topLeftB2X + x * sq + sq2, topY + y * sq + sq2 + sq4) <> Point(topLeftB2X + x * sq + sq2, topY + (y + 1) * sq + sq4) Then Exit Function
  108.         Next
  109.     Next
  110.     'if made it this far then solved
  111.     solved = -1
  112.  
  113. Sub showSolution
  114.     Dim x, y, index
  115.     For y = 0 To Nm1
  116.         For x = 0 To Nm1
  117.             drawSquare index, x * sq + topLeftB2X, y * sq + topY
  118.             index = index + 1
  119.         Next
  120.     Next
  121.  
  122. Sub showB (board)
  123.     Dim x, y, index
  124.     For y = 0 To Nm1
  125.         For x = 0 To Nm1
  126.             If board = 1 Then
  127.                 index = B1(x, y)
  128.                 drawSquare index, x * sq + topLeftB1X, y * sq + topY
  129.             Else
  130.                 index = B2(x, y)
  131.                 drawSquare index, x * sq + topLeftB2X, y * sq + topY
  132.             End If
  133.         Next
  134.     Next
  135.  
  136. Sub drawSquare (index, x, y)
  137.     Line (x, y)-Step(sq, sq), &HFF000000, BF
  138.     Line (x, y)-Step(sq, sq), &HFFFFFFFF, B
  139.     If index < N * N Then
  140.         Line (x, y)-Step(sq, sq), &HFFFFFFFF
  141.         Line (x + sq, y)-Step(-sq, sq), &HFFFFFFFF
  142.         Paint (x + sq2 + sq4, y + sq2), hue(C(index, 0)), &HFFFFFFFF
  143.         Paint (x + sq2, y + sq2 + sq4), hue(C(index, 1)), &HFFFFFFFF
  144.         Paint (x + sq4, y + sq2), hue(C(index, 2)), &HFFFFFFFF
  145.         Paint (x + sq2, y + sq4), hue(C(index, 3)), &HFFFFFFFF
  146.     End If
  147.  
  148. Sub assignColors ()
  149.     'the pieces are indexed 0 to N X N -1  (NxNm1)
  150.     ' y(index) = int(index/N) : x(index) = index mod N
  151.     ' index(x, y) = (y - 1) * N + x
  152.  
  153.     Dim i, j, x, y
  154.     'first assign a random color rc to every triangle
  155.     For i = 0 To NxNm1 'piece index
  156.         For j = 0 To 3 'tri color index for piece
  157.             C(i, j) = rand(1, 9)
  158.         Next
  159.     Next
  160.     'next match c0 to c3 of square to right
  161.     For y = 0 To Nm1
  162.         For x = 0 To Nm1 - 1
  163.             'the color of tri3 of next square piece to right = color of tri0 to left of it
  164.             C(y * N + x + 1, 2) = C(y * N + x, 0)
  165.         Next
  166.     Next
  167.     For y = 0 To Nm1 - 1
  168.         For x = 0 To Nm1
  169.             'the color of tri4 in piece below = color tri1 of piece above
  170.             C((y + 1) * N + x, 3) = C(y * N + x, 1)
  171.         Next
  172.     Next
  173.  
  174.     ' C() now contains one solution for puzzle, may not be the only one
  175.  
  176.     ' scramble pieces to box1
  177.     Dim t(0 To NxNm1), index 'temp array
  178.     For i = 0 To NxNm1: t(i) = i: Next
  179.     For i = NxNm1 To 1 Step -1: Swap t(i), t(rand(0, i)): Next
  180.     For y = 0 To Nm1
  181.         For x = 0 To Nm1
  182.             B1(x, y) = t(index)
  183.             index = index + 1
  184.             B2(x, y) = N * N
  185.             'PRINT B1(x, y), B2(x, y)
  186.         Next
  187.     Next
  188.  
  189. Function hue~& (n)
  190.     Select Case n
  191.         Case 0: hue~& = &HFF000000
  192.         Case 1: hue~& = &HFFA80062
  193.         Case 2: hue~& = &HFF000050
  194.         Case 3: hue~& = &HFFE3333C
  195.         Case 4: hue~& = &HFFFF0000
  196.         Case 5: hue~& = &HFF008000
  197.         Case 6: hue~& = &HFF0000FF
  198.         Case 7: hue~& = &HFFFF64FF
  199.         Case 8: hue~& = &HFFFFFF00
  200.         Case 9: hue~& = &HFF00EEEE
  201.         Case 10: hue~& = &HFF663311
  202.     End Select
  203.  
  204. Function rand% (n1, n2)
  205.     Dim hi, lo
  206.     If n1 > n2 Then hi = n1: lo = n2 Else hi = n2: lo = n1
  207.     rand% = (Rnd * (hi - lo + 1)) \ 1 + lo
  208.  
  209. Sub intro 'use intro to select number of pieces
  210.     Dim test As Integer
  211.     Cls: Color hue(8): Locate 3, 1
  212.     centerPrint "TriQuad Instructions:": Print: Color hue(9)
  213.     centerPrint "This puzzle has two boxes that contain up to N x N square pieces of 4 colored triangles."
  214.     centerPrint "The object is to match up the triangle edges from left Box to fill the Box on the right.": Print
  215.     centerPrint "You may move any square piece to an empty space on either board by:"
  216.     centerPrint "1st clicking the piece to disappear it,"
  217.     centerPrint "then clicking any empty space for it to reappear.": Print
  218.     centerPrint "You may press q to quit and see the solution displayed.": Print
  219.     centerPrint "Hint: the colors without matching"
  220.     centerPrint "complement, are edge pieces.": Print
  221.     centerPrint "Good luck!": Color hue(5)
  222.     Locate CsrLin + 2, 1: centerPrint "Press number key for square pieces per side (3 to 9, 1 to quit)..."
  223.     While test < 3 Or test > 9
  224.         test = Val(InKey$)
  225.         If test = 1 Then System
  226.     Wend
  227.     N = test ' pieces per side of 2 boards
  228.     Nm1 = N - 1 ' FOR loops
  229.     NxNm1 = N * N - 1 ' FOR loop of piece index
  230.     'sizing
  231.     sq = (xmax / 2 - 1.5 * margin) / N 'square piece side size
  232.     sq2 = sq / 2: sq4 = sq / 4
  233.     ymax = sq * N + 2 * margin
  234.     ReDim B1(Nm1, Nm1), B2(Nm1, Nm1), C(NxNm1, 3)
  235.     Screen _NewImage(xmax, ymax, 32)
  236.     '_SCREENMOVE 300, 40    'need again?
  237.     'PRINT ymax
  238.  
  239. Sub centerPrint (s$)
  240.     Locate CsrLin, (xmax / 8 - Len(s$)) / 2: Print s$
  241.  

Quote
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)
TriQuad move 1 more piece.PNG


« Last Edit: January 09, 2022, 05:03:10 pm by bplus »

Offline Rick3137

  • Newbie
  • Posts: 1
    • View Profile
Re: TriQuad Puzzle inspired by Rick3137
« Reply #1 on: January 14, 2022, 09:33:33 am »
  Nice work, Mark

  I have my NaaLaa version on my computer desktop. Now I have 2 versions. It gives me something to tinker with when I get bored.

  This week I was working on a qb64 version with the purpose of learning the language.
Somehow you beat me to it. Is it possible that you read minds?

  It will take me awhile to learn qb64. It has a lot of code words and other quirks. The one that
gave me the worst trouble was when my subroutines changed some of my global variables. I ran
into that problem when I tried sdlbasic. C Sharp and C language never gave me that problem. going back
and forth between languages can be very confusing.


 

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: TriQuad Puzzle inspired by Rick3137
« Reply #2 on: January 14, 2022, 10:19:09 am »
@Rick3137 so nice to see you again!

Yes, when I saw you as our newest member I posted TriQuad, it's still nice to play once and awhile!
Quote
  It will take me awhile to learn qb64. It has a lot of code words and other quirks. The one that
gave me the worst trouble was when my subroutines changed some of my global variables. I ran
into that problem when I tried sdlbasic. C Sharp and C language never gave me that problem. going back
and forth between languages can be very confusing.

So right! Maybe my version will help get familiar with QB64. Have you figured out getting Help from IDE (see far right of menu bar). Also recommend bookmarking https://wiki.qb64.org//Main_Page the on-line Help and of course plenty of help here at forum or maybe on Discord.

Use Dim Shared for variable or array() for Global Variables in main code area usually at top where you can find listing fast.



Offline luke

  • Administrator
  • Seasoned Forum Regular
  • Posts: 324
    • View Profile
Re: TriQuad Puzzle inspired by Rick3137
« Reply #3 on: January 17, 2022, 08:51:12 am »
Small note: the hue~& function has a parameter called 'n', but there is a SHARED variable also called 'N'. This isn't actually a problem, but given  the above discussion I thought it worth pointing out.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: TriQuad Puzzle inspired by Rick3137
« Reply #4 on: January 17, 2022, 09:10:10 am »
Small note: the hue~& function has a parameter called 'n', but there is a SHARED variable also called 'N'. This isn't actually a problem, but given  the above discussion I thought it worth pointing out.

Interesting, looks like the IDE kept the different cases, taking the n as different from N.

OK for sake of non ambiguity:
Code: QB64: [Select]
  1. Function hue~& (cn)
  2.     Select Case cn
  3.         Case 0: hue~& = &HFF000000
  4.         Case 1: hue~& = &HFFA80062
  5.         Case 2: hue~& = &HFF000050
  6.         Case 3: hue~& = &HFFE3333C
  7.         Case 4: hue~& = &HFFFF0000
  8.         Case 5: hue~& = &HFF008000
  9.         Case 6: hue~& = &HFF0000FF
  10.         Case 7: hue~& = &HFFFF64FF
  11.         Case 8: hue~& = &HFFFFFF00
  12.         Case 9: hue~& = &HFF00EEEE
  13.         Case 10: hue~& = &HFF663311
  14.     End Select
  15.