Checkered Checkers

[plus]

This is a recursive update to 8 year old code so that it may do different divisors of the screen and go deeper into levels than hard coded loops.

global Xmax, Ymax, Divisor, DivisorMinusOne
Xmax = 740
Ymax = 740

WindowWidth = Xmax + 8
WindowHeight = Ymax + 32
UpperLeftX = (DisplayWidth - Xmax) / 2  'or delete if Xmax is 1200 or above
UpperLeftY = 0  'or delete if Ymax is 700 or above

nomainwin
open "Checkered Checkers Recursive" for graphics_nsb_nf as #gr  '<======================= title
#gr "trapclose quit"
#gr "fill black"
#gr "down"
#gr "color white"
#gr "backcolor white"
While 1
   scan
   Divisor = Int(Rnd(0) * 9) + 2
   DivisorMinusOne = Divisor - 1
   ReDim arr(DivisorMinusOne, DivisorMinusOne) ' holds pattern
   For j = 0 To DivisorMinusOne
       For i = 0 To DivisorMinusOne
           If Rnd(0) < .5 Then arr(i, j) = 1
       Next
   Next
   call CheckRecur 0, 0, 739 / Divisor
   call pause 5000
   #gr "fill black"
Wend
wait

sub quit H$
   close #gr '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

Sub CheckRecur FirstX, FirstY, Side
   If Side <= 4 Then Exit Sub ' done
   For y = 0 To DivisorMinusOne
       For x = 0 To DivisorMinusOne
           scan
           'Line (FirstX + x * Side, FirstY + y * Side)-Step(Side, Side), , B
           #gr "place ";FirstX + x * Side;" ";FirstY + y * Side
           #gr "box ";FirstX + x * Side + Side;" ";FirstY + y * Side + Side
           If Side / Divisor <= 4 Then
               If arr(x, y) Then
                   #gr "color white"
                   #gr "backcolor white"
               Else
                   #gr "color black"
                   #gr "backcolor black"
               End If
               #gr "place ";FirstX + x * Side + 1;" ";FirstY + y * Side + 1
               #gr "boxfilled ";FirstX + x * Side + Side - 2;" ";FirstY + y * Side + Side - 2
               #gr "color white"
               #gr "backcolor white"
           Else
               If arr(x, y) Then
                   call CheckRecur FirstX + x * Side, FirstY + y * Side, Side / Divisor
               End If
           End If
       Next
   Next
End Sub


Ymax is setup to just fit my screen go ahead and make it bigger or smaller for yours, just match Xmax to it.

[honky]

The ancestors of QR-codes !

[tsh73]

Wow
I did not pay attention first - run it and close it

But it supposed to be run and *looked at*
It changes patterns - and some of them come really neat.

[plus]

Yeah what does this one remind you of?

Sierpinski?

Attachments:

[plus]

OK now YOU can Click your own Checkered Patterns!
global Xmax, Ymax, Divisor, DivisorMinusOne, UserMode
Xmax = 740
Ymax = 740

WindowWidth = Xmax + 8
WindowHeight = Ymax + 32
UpperLeftX = (DisplayWidth - Xmax) / 2  'or delete if Xmax is 1200 or above
UpperLeftY = 0  'or delete if Ymax is 700 or above

nomainwin
open "Checkered Recurse User Input, Click Left to toggle checker, Right to Draw" for graphics_nsb_nf as #gr  '<==title
#gr "trapclose quit"
#gr "fill black"
#gr "down"
#gr "when rightButtonDown [Right]"
#gr "when leftButtonDown [LClick]"

[restart]
   scan
   Prompt "Divide screen side 2 to 10 times?"; reply$
   if reply$ = "" then call quit dummy$
   Divisor = val(reply$)
   if Divisor > 1 and Divisor < 11 then
       DivisorMinusOne = Divisor - 1
       Dim arr(DivisorMinusOne, DivisorMinusOne) ' holds pattern
       'grid
       #gr "fill black"
       #gr "color white"
       #gr "backcolor white"
       pSide = Ymax / Divisor
       For j = 0 To DivisorMinusOne
           For i = 0 To DivisorMinusOne
               #gr "place ";i * pSide;" ";j * pSide
               #gr "box ";i * pSide + pSide;" ";j * pSide + pSide
           Next
       Next
   else
       goto [restart]
   end if
   wait


[LClick] ' toggle cell clicked and update arr()
   if showMode = 0 then
       xx = int(MouseX / pSide) : yy = int(MouseY / pSide)
       if arr(xx, yy) then
           arr(xx, yy) = 0
           #gr "backcolor black"
       else
           arr(xx, yy) = 1
           #gr "backcolor white"
       end if
       #gr "place ";xx * pSide;" ";yy * pSide
       #gr "boxfilled ";xx * pSide + pSide;" ";yy * pSide + pSide
       wait
   end if

[Right] ' do the recursive drawing, pause then start over
   if showMode then
       showMode = 0
        #gr "fill black"
       Goto [restart]
   else
       #gr "fill black"
       call CheckRecur 0, 0, 739 / Divisor
       showMode = 1
       wait
   end if

sub quit H$
   close #gr '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

Sub CheckRecur FirstX, FirstY, Side
   If Side <= 4 Then Exit Sub ' done
   For y = 0 To DivisorMinusOne
       For x = 0 To DivisorMinusOne
           scan
           #gr "place ";FirstX + x * Side;" ";FirstY + y * Side
           #gr "box ";FirstX + x * Side + Side;" ";FirstY + y * Side + Side
           If Side / Divisor <= 4 Then
               If arr(x, y) Then
                   #gr "color white"
                   #gr "backcolor white"
               Else
                   #gr "color black"
                   #gr "backcolor black"
               End If
               #gr "place ";FirstX + x * Side + 1;" ";FirstY + y * Side + 1
               #gr "boxfilled ";FirstX + x * Side + Side - 2;" ";FirstY + y * Side + Side - 2
               #gr "color white"
               #gr "backcolor white"
           Else
               If arr(x, y) Then
                   call CheckRecur FirstX + x * Side, FirstY + y * Side, Side / Divisor
               End If
           End If
       Next
   Next
End Sub


Attachments:

[tsh73]

Sierpinski?

well, yes
Initial pattern occurred randomly, then recursive part completed it

Oh yes. Your last program allows to recreate it
size=2
pattern

11
01


[plus]

B+ ?

Attachments: