Random Tessellations - Printable Version

Code: (Select All)

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

' Inspired by Charlie's BAM example:

' https://qb64phoenix.com/forum/showthread.php?tid=1646&pid=15772#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 coloring mode on a b keypress

    If k$ = "c" Then C = 1 - C '        toggle coloring mode on a b 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

_Title "Tessellation 4" ' b+ 2023-05-19 ' Inspired by Charlie's BAM example: ' https://qb64phoenix.com/forum/showthread.php?tid=1646&pid=15772#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