Recursive fill
#1
Like Persian carpets, this is a recursive quartering of squares unlike Persian carpets this draws a small box instead of a cross, keys h, d or space will alter variables, always enter for next screen:
Code:
' recursive fill tester.bas SmallBASIC 0.12.9 (B+=MGA) 2017-09-27

' ================================================================================
'  Intructions:  seed spacer > h=half, d=double   seed color > spacebar to change
' ================================================================================

RANDOMIZE TIMER
xoff = (xmax - 512) / 2: yoff = (ymax - 512) / 2
seedSpacer = 16
WHILE 1
   seedColor = RGB(RND * 200 + 55, RND * 200 + 55, RND * 200 + 55)
   WHILE 1        
       IF k = " " THEN
           k = ""
           EXIT loop
       ELSEIF k = "h" THEN
           seedSpacer = seedSpacer \ 2
           IF seedSpacer = 1 THEN seedSpacer = 2
       ELSEIF k = "d" THEN
           seedSpacer = seedSpacer * 2
           IF seedSpacer = 512 THEN seedSpacer = 256
       ENDIF
       CLS
       PRINT " seed spacer: "; seedSpacer; "   seed color: "; seedColor; "   Rnd mixer: "; mixer
       FOR y = 0 TO 512 STEP seedSpacer
           FOR x = 0 TO 512 STEP seedSpacer
               PSET x + xoff, y + yoff, seedColor
           NEXT
       NEXT
       mixer = RND * 10
       rfill 0 + xoff, 0 + yoff, 512 + xoff, 512 + yoff
       showpage
       input " Seed Spacer: h to half, d to double    Seed Color: space for new   enter next screen > ",k
   WEND
WEND

SUB rfill(l, t, r, b)
   local mx, my, pc
   IF l < r - 1 AND t < b - 1 THEN
       mx = INT((r - l) / 2) + l: my = INT((b - t) / 2) + t
       pc = (POINT(l, t) + POINT(r, t) + POINT(l, b) + POINT(r, b)) * mixer
       rect mx-1, my-1, mx+1, my+1, -pc mod 16 filled
       rfill l, t, mx, my
       rfill mx, t, r, my
       rfill l, my, mx, b
       rfill mx, my, r, b
   ELSE
       EXIT SUB
   END IF
END SUB


Attached Files Thumbnail(s)

B += x
Reply
#2
And some more shots...


Attached Files Thumbnail(s)

B += x
Reply