Random Tessellations

[grymmjack]

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.

There is something strange going on with the way the sceditor javascript (which is what MyBB uses for it's rich editor) when it's using WYSIWYG mode vs. Source mode.

If you use a the qb bbcode in source mode, and paste, it honors all whitespace.

If you do the same in WYSIWYG mode, it does not.

Also, for some reason if you edit a post you made using purely Source mode, the whitespace gets screwed up.

I've banged my head against this all day almost and came up short. I'm not giving up, but yeah, it's a pain.

I even went so far as to find other people complaining:
https://community.mybb.com/thread-213230.html

@bplus FYI