Random Tessellations

[Kernelpanic]

Nullo problemo! It runs.

Code: (Select All)

' Option _Explicit to find undim variables
_Title "Tessellation 4" ' b+ 2023-05-19
' Inspired by Charlie's BAM example:
' https://staging.qb64phoenix.com/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
Dim K$, t$
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
  Dim As Long n, i
  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
  Dim As Long y, x, q
  For y = 0 To Scale * Pix Step Scale
    For x = 0 To Scale * Pix Step Scale
      If B Then q = Int(Rnd * 4) + 1 Else q = Int(Rnd * 3) + 1
      Line (x, y)-Step(Scale, Scale), Pal(q), BF ' this should be integer since Tile is
      Line (2 * Scale * Pix - x - 1, y)-Step(Scale, Scale), Pal(q), BF
      Line (x, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
      Line (2 * Scale * Pix - x - 1, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
    Next
  Next
  _Dest 0
End Sub

Sub Tessellate ' just covering the screen with our Tile
  Dim As Long y, x
  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