Random Tessellations

[bplus]

Testing new qb code tag

Code: (Select All)

 _Title "Tessellation 4" ' b+ 2023-05-19

' Inspired by Charlie's BAM example:

' https://qb64phoenix.com/forum/showthread...2#pid15772



' b+ 2023-05-09 - Tiling with a pattern

' Tessellation 2 will try color filled with more background black.

' Tessellation 3 Charlie mentions a mirror image for interesting tessellating,

' lets try mirroring both x and y axis.

'

' Tessellation 4

'   Use b key to toggle between:

'       1. 3 color tessellation

'       2. 4 color tessellation

'   and use c key to toggle between:

'       1. a random set of colors

'       2. contrast (a red, a green, a blue and 4th is white)

'

DefLng A-Z

Randomize Timer

Screen _NewImage(800, 600, 32) ' full rgb range here

_ScreenMove 250, 50

Dim Shared Pix '   Pix is number of pixels to Tile side

Dim Shared Scale ' Change a pixel to a bigger square block for not so subtle patterns

Dim Shared Tile '  Handle that stores Tile Image in memory to call up with _PutImage

Dim Shared B '     Toggle color mode from 3 to 4 and back

Dim Shared C '     Toggle Contrast set and Random set of colors

ReDim Shared Pal(1 To 4) As _Unsigned Long ' palette to hold 3 or 4 colors

Do

    k$ = InKey$

    If k$ = "b" Then B = 1 - B '        toggle mode for number of colors on a b keypress

    If k$ = "c" Then C = 1 - C '        toggle mode for coloring contrast on a c keypress



    ' update the title according current b and c toggles

    If B Then t$ = "4" Else t$ = "3"

    If C Then t$ = t$ + " Contrasted Colors" Else t$ = t$ + " Random Colors"

    _Title t$ + ": use b to toggle 3|4 colors, c to toggle random|contrast, any other for next screen"



    MakePalette '                       3 or 4 random colors according to b

    MakeTile '                          create a new random tiling pattern

    Tessellate '                        tile the screen with it

    _PrintString (740, 580), "ZZZ..." ' Show user we are sleeping awaiting a key press

    Sleep

Loop Until _KeyDown(27) ' quit when detect escape key on sleep



Sub MakePalette

    If B Then n = 4 Else n = 3

    ReDim Pal(1 To n) As _Unsigned Long

    For i = 1 To n

        If C Then

            If B Then

                If i = 4 Then Pal(i) = C3~&(999) Else Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))

            Else

                Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))

            End If

        Else

            Pal(i) = C3~&(Int(Rnd * 1000))

        End If

    Next

End Sub



Sub MakeTile ' make a random tile to Tesselate according to B Mode coloring

    Pix = Int(Rnd * 9) + 4 '           sets tile size: pix X pix or a 4X4 to 12X12 Tile coloring

    Scale = Int(Rnd * 6) + 4 '         to change pixels to square blocks

    If Tile Then _FreeImage Tile '     throw old image away

    Tile = _NewImage(2 * Scale * Pix - 1, 2 * Scale * Pix - 1) '   make new one

    _Dest Tile '                       draw in the memory area Tile not on screen

    For y = 0 To Scale * Pix Step Scale

        For x = 0 To Scale * Pix Step Scale

            If B Then r = Int(Rnd * 4) + 1 Else r = Int(Rnd * 3) + 1

            Line (x, y)-Step(Scale, Scale), Pal(r), BF ' this should be integer since Tile is

            Line (2 * Scale * Pix - x - 1, y)-Step(Scale, Scale), Pal(r), BF

            Line (x, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(r), BF

            Line (2 * Scale * Pix - x - 1, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(r), BF

        Next

    Next

    _Dest 0

End Sub



Sub Tessellate ' just covering the screen with our Tile

    For y = 0 To _Height Step 2 * Scale * Pix

        For x = 0 To _Width Step 2 * Scale * Pix

            _PutImage (x, y)-Step(2 * Scale * Pix, 2 * Scale * Pix), Tile, 0

        Next

    Next

End Sub



Function C3~& (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits

    Dim s3$, r As Long, g As Long, b As Long

    s3$ = Right$("000" + LTrim$(Str$(n)), 3)

    r = Val(Mid$(s3$, 1, 1)): If r Then r = 28 * r + 3

    g = Val(Mid$(s3$, 2, 1)): If g Then g = 28 * g + 3

    b = Val(Mid$(s3$, 3, 1)): If b Then b = 28 * b + 3

    C3~& = _RGB32(r, g, b)

End Function 

What is really cool is the url link really works when you click it!
Well it did when code was mostly one color? Right after I make an edit, it works, interesting!

Yeah the code print is all white but the link is darker, right after an edit. Then when I come back to this post, it is color coded and the link doesn't work.