Checkered Checkers

[bplus]

For some time now I've been trying do something like this recursively:

Code: (Select All)

_Title "Checkered Checkers, press any for another screen..." ' b+ 2023-02-17
Screen _NewImage(641, 641, 12)
_ScreenMove 300, 60
d = 8: sq = 640 / d: sq8 = sq / d: dm1 = d - 1
Dim arr(d, d)
While _KeyDown(27) = 0
    For j = 0 To dm1
        For i = 0 To dm1
            If Rnd < .5 Then arr(i, j) = 1 Else arr(i, j) = 0
        Next
    Next
    For y = 0 To dm1
        For x = 0 To dm1
            If arr(x, y) Then
                For yy = 0 To dm1
                    For xx = 0 To dm1
                        If arr(xx, yy) Then
                            Line (x * sq + xx * sq8, y * sq + yy * sq8)-(x * sq + xx * sq8 + sq8 - 1, y * sq + yy * sq8 + sq8 - 1), , BF
                        Else
                            Line (x * sq + xx * sq8, y * sq + yy * sq8)-(x * sq + xx * sq8 + sq8 - 1, y * sq + yy * sq8 + sq8 - 1), , B
                        End If
                    Next
                Next
            End If
            Line (x * sq, y * sq - 1)-(x * sq + sq, y * sq + sq - 1), , B
        Next
    Next
    Sleep
    Cls
Wend

So it wouldn't take more code lines to do deeper levels. With recursion you could just keep going deeper as long as the side length of a checker was >=1 pixel.

[bplus]

Today I've got it figured out and added the option to divide the sides of a screen from 2 to 10 cells:

Code: (Select All)

_Title "Checkered Checkers Recursive, press any for another screen..." ' b+ 2023-02-17
Screen _NewImage(740, 740, 12)
Randomize Timer
_ScreenMove 300, 0
Dim Shared As Long Divisor, DivisorMinusOne

While _KeyDown(27) = 0
    Divisor = Int(Rnd * 9) + 2
    DivisorMinusOne = Divisor - 1
    ReDim Shared arr(DivisorMinusOne, DivisorMinusOne) ' holds pattern
    For j = 0 To DivisorMinusOne
        For i = 0 To DivisorMinusOne
            If Rnd < .5 Then arr(i, j) = 1
        Next
    Next
    CheckRecur 0, 0, (_Width - 1) / Divisor
    Sleep
    Cls
Wend

Sub CheckRecur (FirstX, FirstY, Side)
    If Side <= 4 Then Exit Sub ' done
    For y = 0 To DivisorMinusOne
        For x = 0 To DivisorMinusOne
            Line (FirstX + x * Side, FirstY + y * Side)-Step(Side, Side), , B
            If Side / Divisor <= 4 Then
                If arr(x, y) Then
                    Line (FirstX + x * Side + 1, FirstY + y * Side + 1)-Step(Side - 3, Side - 3), 15, BF
                Else
                    Line (FirstX + x * Side + 1, FirstY + y * Side + 1)-Step(Side - 3, Side - 3), 0, BF
                End If
            Else
                If arr(x, y) Then
                    CheckRecur FirstX + x * Side, FirstY + y * Side, Side / Divisor
                End If
            End If
        Next
    Next
End Sub

Note: It is possible to get an all white screen or all black screen except for white grid.

[mnrvovrfc]

This would be awesome on one of those giant screens... much larger than that of my laptop.

[bplus]

Thankyou mnr...

I was surprised to see some of the screens look like Sierpinski work or TempodiBasic's "Chess Pattern" when the divisor was 2 or 3 even 4 and the checks make a pattern.

[bplus]

Now you can control where the checkers go, make your own patterns:

Code: (Select All)

_Title "Checkered Recursive, Left Click toggles Square, Right Draws | 2nd Click Restarts" ' b+ 2023-02-19
Screen _NewImage(740, 740, 12)
Randomize Timer
_ScreenMove 300, 0
Dim Shared As Long Divisor, DivisorMinusOne
Dim pSide
restart:
Cls
Locate 22, 20
Input "(0 quits) Enter 2 to 10, for screen Divisor "; Divisor
If Divisor = 0 Then End
If Divisor < 2 Or Divisor > 11 Then GoTo restart
DivisorMinusOne = Divisor - 1
pSide = (_Height - 1) / Divisor
ReDim Shared arr(DivisorMinusOne, DivisorMinusOne) ' holds pattern
Cls
For y = 0 To DivisorMinusOne
    For x = 0 To DivisorMinusOne
        Line (x * pSide, y * pSide)-Step(pSide, pSide), , B
    Next
Next
Do
    While _MouseInput: Wend
    LBM = _MouseButton(1): RBM = _MouseButton(2): mx = _MouseX: my = _MouseY
    If LBM Then
        _Delay .2
        x = Int(mx / pSide): y = Int(my / pSide)
        If arr(x, y) Then arr(x, y) = 0 Else arr(x, y) = 1
        If arr(x, y) Then
            Line (x * pSide, y * pSide)-Step(pSide, pSide), 15, BF
        Else
            Line (x * pSide, y * pSide)-Step(pSide, pSide), 0, BF
            Line (x * pSide, y * pSide)-Step(pSide, pSide), 15, B
        End If
    End If
    _Limit 100
Loop Until RBM
Cls
CheckRecur 0, 0, (_Width - 1) / Divisor
_Delay 2
Do
    While _MouseInput: Wend
    LBM = _MouseButton(1): RBM = _MouseButton(2)
    _Limit 60
Loop Until RBM Or LBM
GoTo restart

Sub CheckRecur (FirstX, FirstY, Side)
    If Side <= 4 Then Exit Sub ' done
    For y = 0 To DivisorMinusOne
        For x = 0 To DivisorMinusOne
            Line (FirstX + x * Side, FirstY + y * Side)-Step(Side, Side), , B
            If Side / Divisor <= 4 Then
                If arr(x, y) Then
                    Line (FirstX + x * Side + 1, FirstY + y * Side + 1)-Step(Side - 3, Side - 3), 15, BF
                Else
                    Line (FirstX + x * Side + 1, FirstY + y * Side + 1)-Step(Side - 3, Side - 3), 0, BF
                End If
            Else
                If arr(x, y) Then
                    CheckRecur FirstX + x * Side, FirstY + y * Side, Side / Divisor
                End If
            End If
        Next
    Next
End Sub

[mnrvovrfc]

Another greenback into your pocket! With so few lines of code.

Although for my computer I had to adjust it so the program window were a bit less tall. Otherwise I have to hide the bottom panel of the desktop.

[bplus]

Thankyou again mnr...

Yes to adjust for your screen make Ymax your maximum display height and then match it with Xmax. Most screens are wider than high and all that is needed is a square screen to divide up.