Proggies

[bplus]

Celtic Knot Puzzle

Click tiles in top left figure to make a 6 x 6 tile Celtic Knot much like my Avatar ;-))

Press escape and the image will be copied and rotated 45 degrees and be drawn in bottom right corner, to compare to my Avatar. Hint: I needed a solution image to use when building, it's not easy!

Code: (Select All)

_Title "A Celtic Knot Puzzle - click the piece build a knot!" ' b+ 2022-06-06
Screen _NewImage(1200, 700, 32)
_ScreenMove 130, 20
d& = _LoadImage("D tile.png")
d2& = _LoadImage("D2 tile.png")
_PutImage (0, 1), d&, 0
Bg~& = Point(3, 3)

iw = _Width(d&): ih = _Height(d&)
_PrintString (10, 280), Str$(iw) + Str$(ih)
For i = 0 To 6
    Line (0, i * 44)-(iw, i * 44), &HFFFFFF00
Next
For i = 0 To 16
    Line (i * 44, 0)-(i * 44, ih), &HFFFFFF00
Next
iw2 = _Width(d2&): ih2 = _Height(d2&)
iw2 = 16 * 44: ih2 = 8 * 44
_PutImage (1, 300), d2&, 0
For i = 0 To 8
    Line (0, i * 44 + 300)-(iw2, i * 44 + 300), &HFFFFFF00
Next
For i = 0 To 16
    Line (i * 44, 0 + 300)-(i * 44, ih2 + 300), &HFFFFFF00
Next
_PrintString (10, 660), Str$(iw2) + Str$(ih2)

For i = 0 To 8
    Line (0 + 800, i * 44)-(ih2 + 800, i * 44), &HFFFFFF00
Next
For i = 0 To 8
    Line (i * 44 + 800, 0)-(i * 44 + 800, ih2), &HFFFFFF00
Next

Do
    While _MouseInput: Wend
    mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
    If mx < 800 Then
        cellx = Int(mx / 44)
        If my >= 300 Then
            celly = Int((my - 300) / 44): fig = 2
        Else
            celly = Int(my / 44): fig = 1
        End If
    Else
        fig = 3
        cellx = Int((mx - 800) / 44)
        celly = Int(my / 44)
    End If
    If mb Then
        _PrintString (800, 400), Space$(50)
        _PrintString (800, 400), "Fig:" + Str$(fig) + " cell:" + Str$(cellx) + Str$(celly)

        If fig = 1 Then
            If cellx >= 0 And cellx <= 15 And celly >= 0 And celly <= 5 Then
                _PutImage (850, 450)-Step(44, 44), 0, 0, (cellx * 44, celly * 44)-Step(44, 44)
            End If
        ElseIf fig = 2 Then
            If cellx >= 0 And cellx <= 15 And celly >= 0 And celly <= 7 Then
                _PutImage (850, 450)-Step(44, 44), 0, 0, (cellx * 44, celly * 44 + 300)-Step(44, 44)
            End If
        ElseIf fig = 3 Then
            If cellx >= 0 And cellx <= 7 And celly >= 0 And celly <= 7 Then
                _PutImage (cellx * 44 + 800, celly * 44)-Step(44, 44), 0, 0, (850, 450)-Step(44, 44)
            End If
        End If
        _Delay .2
    End If
    ' 800, 450 step 44, 44  ' will be transfer spot   from fig 1 or 2 to fig 3
Loop Until _KeyDown(27)
_PrintString (800, 400), Space$(50) ' erase note
Line (850, 450)-Step(45, 45), &HFF000000, BF ' cover last puzzle piece
' grab image and twist 45 degrees!
trans& = _NewImage(264, 264, 32) 'container to hold image
_PutImage , 0, trans&, (800, 0)-Step(264, 264)
RotoZoom _Width - 190, _Height - 190, trans&, 1, 45
Sleep

Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)
    Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
    For i& = 0 To 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
        px(i&) = x2&: py(i&) = y2&
    Next
    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub

Here is the Puzzle with Solution:
   

Here is the zip with source, exe and 3 images 2 images are used for tiles but never used bottom left and you will want to use solution image to help tile solution.