Random Tessellations

[bplus]

@bplus -  Where is the << coming from?

You need more inner relaxation @bplus!   Hm, "unexpected character" . . . did you forget "Option Explicit" again? - The old Basic veterans. 

Go ahead and type ( r ) without the spaces here in editor and see how it comes out as (r).

[Kernelpanic]

@bplus -  Where is the << coming from?

You need more inner relaxation @bplus!   Hm, "unexpected character" . . . did you forget "Option Explicit" again? - The old Basic veterans. 

Go ahead and type ( r ) without the spaces here in editor and see how it comes out as (r).

Is this now an English or an Ameran joke? I do not know what You mean. 

You need more relaxations! Really! 

[bplus]

You need more inner relaxation @bplus!   Hm, "unexpected character" . . . did you forget "Option Explicit" again? - The old Basic veterans. 

Go ahead and type ( r ) without the spaces here in editor and see how it comes out as (r).

Is this now an English or an Ameran joke? I do not know what You mean. 

You need more relaxations! Really! 

Type "("  then "r" then ")" in this here editor and watch it turned into (r), no joke.

but

Code: (Select All)

print "(r)"

should be ok

but

Code: (Select All)

print "(r)" 

might not be ok

Here is what I see:
   

[bplus]

OK now try in qbjs

Code: (Select All)

' Option _Explicit to find undim variables

_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

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

Not having much luck with qbjs, every time I try some stupid thing hangs things up.
What is it this time? @dbox

[Kernelpanic]

@bplus -  Type "("  then "r" then ")" in this here editor and watch it turned into ®, no joke.

Well, not with me. It stays as it is.

[bplus]

OK all colons removed and still nutt'n in QBJS

Code: (Select All)

Option _Explicit

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

' Inspired by Charlie's BAM example

' https(colon)//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

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

   

[bplus]

@bplus -  Type "("  then "r" then ")" in this here editor and watch it turned into ®, no joke.

Well, not with me. It stays as it is.

You funny guy!

[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://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
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

[Kernelpanic]

With Option Explicit It runs too! Where is the problem? 

[bplus]

With Option Explicit It runs too! Where is the problem? 

It doesn't work in QBJS. Have you tried QBJS? pretty nice when it works

I always have bad luck, now can't even get QBJS tags to work???