|
Post by tsh73 on Mar 21, 2019 7:07:31 GMT -5
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
|
|
|
Post by tsh73 on Mar 22, 2019 14:14:44 GMT -5
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
|
|
|
Post by tenochtitlanuk on Mar 22, 2019 15:30:35 GMT -5
Nice bit of graphics programming!
|
|