Random Tessellations

[Kernelpanic]

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???

No, I don't have QBJS . . . Ha, ha, ha! I knew it, it was a joke.



The right mood is still missing:

[bplus]

This works fine in QB64pe but nothing happens in QBJS, nothing no error no nothing except the fan runs fast.

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 As Long Pix '  Pix is number of pixels to Tile side
Dim As Long Scale ' Change a pixel to a bigger square block for not so subtle patterns
Dim As Long Tile '  Handle that stores Tile Image in memory to call up with _PutImage
Dim As Long B '    Toggle color mode from 3 to 4 and back
Dim As Long C '    Toggle Contrast set and Random set of colors
ReDim 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 B, C, Pal() '                                          3 or 4 random colors according to b
    MakeTile B, Pix, Scale, Tile, Pal() '                          create a new random tiling pattern
    Tessellate Scale, Pix, Tile '                        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 (B As Long, C As Long, Pal() As _Unsigned Long)
    Dim As Long n, i, r, g, bb
    Dim t As Single
    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) = _RGB32(255, 255, 255)
                Else
                    t = C3(10 ^ (i - 1) * Int(Rnd * 10), r, g, bb)
                    Pal(i) = _RGB32(r, g, bb)
                End If
            Else
                t = C3(10 ^ (i - 1) * Int(Rnd * 10), r, g, bb)
                Pal(i) = _RGB32(r, g, bb)
            End If
        Else
            t = C3(Int(Rnd * 1000), r, g, bb)
            Pal(i) = _RGB32(r, g, bb)
        End If
    Next
End Sub

Sub MakeTile (B As Long, Pix As Long, Scale As Long, Tile As Long, Pal() As _Unsigned Long)
    ' 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 (Scale As Long, Pix As Long, Tile As Long) ' 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 As Long, r As Long, g As Long, b As Long) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
    Dim s3$
    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) ' ignore C3 value use r,g,b
End Function

So @dbox really curious whats wrong here?

[bplus]

dbox found the problem, now test the share


@Kernelpanic press the play button (triangle pointing right) to run the program here at forum!
Press the rectangle that replaces the triangle to stop run.

[Kernelpanic]

@bplus - @Kernelpanic press the play button

Yeah, I press the Play Button . . . and I see: