Persian Carpet update
#1
Code:
'Persian Carpet.bas for SmallBASIC 0.12.2 [B+=MGA] 2016-02-08
'modified from copy from Retrogamecoding link 2016-02-08
' 2017-09-23 mod for brighter colors and centered
' alas, some blank screens but much brighter!

REM BASIC Code: Persian Carpet Designs
REM A modification of original concept from Anne Burns

colorborder = 0 : a = 1
xo = (xmax - 512) / 2 : yo = (ymax - 512) / 2
while 1
 CLS
 lft = 1 + xo : rght = 513 + xo : top = 1 + yo: bot = 513 + yo
 LINE lft, top, rght, top, colorborder
 LINE lft, bot, rght, bot, colorborder
 LINE lft, top, lft, bot, colorborder
 LINE rght, top, rght, bot, colorborder
 DetermineColor lft, rght, top, bot, a
 at 10, 10 : ? "colorboarder = ";colorborder;" a = ";a
 showpage
 delay 500
 a = a + 1
 if a >= 16 then a = 1 : colorborder += 1
 if colorborder >= 16 then colorborder = 0
wend

rem Determine the color based on function f
sub DetermineColor(lft, rght, top, bot, a)
 local c, middlerow, middlecol
 IF (lft < rght - 2) THEN
   c = f(lft, rght, top, bot, a)
   middlecol = int((lft + rght) / 2)
   middlerow = int((top + bot) / 2)
   LINE lft + 1, middlerow,rght - 1, middlerow, c
   LINE middlecol, top + 1, middlecol, bot - 1, c
   DetermineColor lft, middlecol, top, middlerow, a
   DetermineColor middlecol, rght, top, middlerow, a
   DetermineColor lft, middlecol, middlerow, bot, a
   DetermineColor middlecol, rght, middlerow, bot, a
 else
   exit
 end if
end

func f(lft, rght, top, bot, a)
 local p, b
 p = point(lft, top) + POINT(rght, top) + POINT(lft, bot) + POINT(rght, bot)
 'Try values of b = 4 or b = 7
 b = 60
 f = int(p / b + a) mod 9 + 7
end

Brighter colors and centered in screen, tested in Android, alas some blank screens.


Attached Files Thumbnail(s)

B += x
Reply
#2
My wife spotted these and immediately goes, "Ooo cute."

This is HIGH praise indeed....

Good job.

J
May your journey be free of incident.

Live long and prosper.
Reply
#3
Wow! I love this! Another great procedurally generated artwork.

These type of procedures could be used to to create various things in video games.

Thanks for sharing another great procedurally generated demo Bplus.
Dedicated to empowering computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
profile for Walter Whitman at Stack Overflow, Q&A for professional and enthusiast programmers


Reply
#4
Radial symmetry to bilateral, less blank screens, random element introduced to make runs unique:

(press any key or click for next screen)
Code:
'Persian Carpet v2.bas for SmallBASIC 0.12.9 (B+=MGA)
'modified from copy from Retrogamecoding link 2016-02-09
' 2017-09-23 mod for brighter colors and centered
' alas, some blank screens but much brighter!

' 2017-09-24 eliminate radial symmetry and most blank screens

REM BASIC Code: Persian Carpet Designs
REM A modification of original concept from Anne Burns

colorborder = 0 : a = 1
xo = (xmax - 512) / 2 : yo = (ymax - 512) / 2
while 1
 CLS
 lft = 1 + xo : rght = 513 + xo : top = 1 + yo: bot = 513 + yo
 cb2 = rnd * 16 \ 1
 LINE lft, top, rght, top, cb2
 LINE lft, bot, rght, bot, cb2
 LINE lft, top, lft, bot, colorborder
 LINE rght, top, rght, bot, colorborder
 DetermineColor lft, rght, top, bot, a
 at 10, 10 : ? "colorboarder = ";colorborder;"  cb 2 = ";cb2;"  a = ";a
 showpage
 pause
 a = a + 1
 if a >= 16 then a = 1 : colorborder += 1
 if colorborder >= 16 then colorborder = 0
wend

rem Determine the color based on function f
sub DetermineColor(lft, rght, top, bot, a)
 local c, middlerow, middlecol
 IF (lft < rght - 2) THEN
   c = f(lft, rght, top, bot, a)
   middlecol = int((lft + rght) / 2)
   middlerow = int((top + bot) / 2)
   LINE lft + 1, middlerow,rght - 1, middlerow, c
   LINE middlecol, top + 1, middlecol, bot - 1, c
   DetermineColor lft, middlecol, top, middlerow, a
   DetermineColor middlecol, rght, top, middlerow, a
   DetermineColor lft, middlecol, middlerow, bot, a
   DetermineColor middlecol, rght, middlerow, bot, a
 else
   exit
 end if
end

func f(lft, rght, top, bot, a)
 local p, b
 p = point(lft, top) + POINT(rght, top) + POINT(lft, bot) + POINT(rght, bot)
 'Try values of b = 4 or b = 7
 b = 60
 f = int(p / b + a) mod 9 + 7
end


Attached Files Thumbnail(s)

B += x
Reply
#5
What can I say? You have excelled yourself yet again... Big Grin

J
May your journey be free of incident.

Live long and prosper.
Reply