Split square into random rectangles

[tsh73]

Well, this is really weird formulation.
. How random?
. How many pieces?
This all left to the reader.

So here what I came with (called several times to see how random it looks like)
Though I don't like some big chunks (or even whole squares) left unpartitioned.

'kind of (randomly) (split) square into rectangles
'tsh73 march 2019
nomainwin

gosub [getSlack]

cellSize = 128
gap = 20
nx = int((DisplayWidth-gap)/(cellSize+gap))
ny = int((DisplayHeight-gap-100)/(cellSize+gap))    '-100 for toolbar etc

WindowWidth = gap+nx*(cellSize+gap)+slackX
WindowHeight = gap+ny*(cellSize+gap)+slackY

UpperLeftX = (DisplayWidth-WindowWidth)/2
UpperLeftY = (DisplayHeight-WindowHeight)/2

open "Splitting to random rectangles" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"

global numR
global maxNumR
global minSize      'split not less then
global probSplit    'probability to split
minSize = 7
probSplit = .95
maxNumR = 10
numR = 0    '???

for i = 0 to nx-1
   for j = 0 to ny -1
       call rect gap+i*(cellSize+gap),  gap+j*(cellSize+gap), cellSize, cellSize
   next
next

wait

sub rect x, y, w, h
   #gr "place ";x;" ";y
   #gr "backcolor ";rainbow$(rnd(0))
   #gr "boxfilled ";x+w+1;" ";y+h+1
   'print w, h
   'if numR <0 then exit sub
   'if not(rnd(0)<probSplit) then exit sub
   numR=numR+1
   if rnd(0)>0.5 then 'horisontal
       'w1=int(w/2) 'equally
       w1=int(rnd(0)*w)
       w2 = w-w1
       if w1 <minSize or w2 <minSize  then exit sub
       call rect x, y, w1, h
       call rect x+w1, y, w2, h
   else  'vertical
       'h1=int(h/2)
       h1=int(rnd(0)*h)
       h2 = h-h1
       if h1 <minSize or h2 <minSize  then exit sub
       call rect x, y, w, h1
       call rect x, y+h1, w, h2
   end if
end sub

[quit]
close #gr
end

'------------------------
[getSlack]
   WindowWidth=200:WindowHeight=200
   open "" for graphics_nsb as #t:#t,"home;posxy x y":close#t
   slackX=WindowWidth-2*x:slackY=WindowHeight-2*y
return

function rainbow$(x)
   hi = int((x*6) mod 6)+ 5*(x<0)  'fixed to 0..5
   f = (x*6) mod 1 + (x<0)         'frac, 0..1
   q = (1-f)
   select case hi
   case 0
       r = 1: g = f: b = 0
   case 1
       r = q: g = 1: b = 0
   case 2
       r = 0: g = 1: b = f
   case 3
       r = 0: g = q: b = 1
   case 4
       r = f: g = 0: b = 1
   case 5
       r = 1: g = 0: b = q
   end select
   R = int(r*255)
   G = int(g*255)
   B = int(b*255)
   rainbow$= R;" ";G;" ";B
end function


[tsh73]

Ok next version.
How I actually mean it.
NOT recursive.
Instead, keeps a list of rectangles - select one with longest side - split longest side.
'kind of (randomly) (split) square into rectangles
'tsh73 march 2019
'v. 02: last rectangle randomly splits or quits
'v. 03: biggest rectangle splits, till maxNumR
'    uses SORT so JB v2 or LB
nomainwin

gosub [getSlack]

cellSize = 128
gap = 20
nx = int((DisplayWidth-gap)/(cellSize+gap))
ny = int((DisplayHeight-gap-100)/(cellSize+gap))    '-100 for toolbar etc

WindowWidth = gap+nx*(cellSize+gap)+slackX
WindowHeight = gap+ny*(cellSize+gap)+slackY

UpperLeftX = (DisplayWidth-WindowWidth)/2
UpperLeftY = (DisplayHeight-WindowHeight)/2

open "Splitting to random rectangles" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"

global maxNumR
global minSize      'split not less then
'global probSplit    'probability to split
minSize = 5
'probSplit = .95
maxNumR = 15

dim rects(maxNumR, 6)    'x y w h maxSize area

for i = 0 to nx-1
   for j = 0 to ny -1
       call rect gap+i*(cellSize+gap),  gap+j*(cellSize+gap), cellSize, cellSize
       'wait
   next
next

wait

sub rect x, y, w, h
   'init list
   numR=1
   call setRect numR, x,y,w,h
   'loop
   while numR< maxNumR
       'now select biggest
       sort rects(),1,numR,5    ' by max size
       'call printArr
       call getRect numR, x,y,w,h
       'if not(rnd(0)<probSplit) then exit sub
       'split longest side
   'print numR, x, y, w, h, max(w,h), w = max(w,h)
   [again]
   scan
       if w = max(w,h) then 'horisontal
           'w1=int(w/2) 'equally
           w1=int(rnd(0)*w)
           w2 = w-w1
           if w1 <minSize or w2 <minSize  then [again]
               'last one is overwritten
               call setRect numR, x,y,w1,h
               numR=numR+1
               call setRect numR, x+w1,y,w2,h
       else  'vertical
           'h1=int(h/2)
           h1=int(rnd(0)*h)
           h2 = h-h1
           if h1 <minSize or h2 <minSize  then [again]
               call setRect numR, x,y,w,h1
               numR=numR+1
               call setRect numR, x,y+h1,w,h2

       end if
   wend

   for i = 1 to maxNumR
       call getRect i, x,y,w,h
       #gr "place ";x;" ";y
       #gr "backcolor ";rainbow$(rnd(0))
       #gr "boxfilled ";x+w+1;" ";y+h+1
   next

end sub

[quit]
close #gr
end

'------------------------
[getSlack]
   WindowWidth=200:WindowHeight=200
   open "" for graphics_nsb as #t:#t,"home;posxy x y":close#t
   slackX=WindowWidth-2*x:slackY=WindowHeight-2*y
return

function rainbow$(x)
   hi = int((x*6) mod 6)+ 5*(x<0)  'fixed to 0..5
   f = (x*6) mod 1 + (x<0)         'frac, 0..1
   q = (1-f)
   select case hi
   case 0
       r = 1: g = f: b = 0
   case 1
       r = q: g = 1: b = 0
   case 2
       r = 0: g = 1: b = f
   case 3
       r = 0: g = q: b = 1
   case 4
       r = f: g = 0: b = 1
   case 5
       r = 1: g = 0: b = q
   end select
   R = int(r*255)
   G = int(g*255)
   B = int(b*255)
   rainbow$= R;" ";G;" ";B
end function

sub printArr
   print "-----------------------"
   for i=1 to numR
       for j = 1 to 6
           print rects(i,j);" ";
       next
       print
   next
   print "======================="
end sub

sub setRect numR, x,y,w,h
   rects(numR,1)=x
   rects(numR,2)=y
   rects(numR,3)=w
   rects(numR,4)=h
   rects(numR,5)=max(w,h)
   rects(numR,6)=w*h
end sub

sub getRect numR, byRef x,byRef y,byRef w,byRef h
   x=rects(numR,1)
   y=rects(numR,2)
   w=rects(numR,3)
   h=rects(numR,4)
end sub


[tenochtitlanuk]

Nice bit of graphics programming!