### Author Topic: Graphic Code Challenge  (Read 1130 times)

#### B+

• Hero Member
• Posts: 532
##### Graphic Code Challenge
« on: 08. February 2016, 19:45:18 »
Make similar:

#### ZXDunny

• Full Member
• Posts: 161
##### Re: Graphic Code Challenge
« Reply #1 on: 08. February 2016, 21:16:33 »
It's a recursive subdivision, with three colours per level (outline and two fill colours). Not sure how the colours are chosen, mind. I suspect we're heading further into a small palette (with wrap around) as get deeper?

Nice image, puzzling how you got it though!

#### Tomaaz

• Guest
##### Re: Graphic Code Challenge
« Reply #2 on: 08. February 2016, 21:31:15 »
Yeah... This is not a code challenge. It's more "how did he manage to get this colors" challenge.

#### B+

• Hero Member
• Posts: 532
##### Re: Graphic Code Challenge
« Reply #3 on: 08. February 2016, 22:04:22 »
Here is code for the "bricks":
Code: [Select]
`func cr               'color reds  if i mod 2 then cr=12 else cr=rgb(125,0,0)end`light red or dark red

Here is code for the mortar:
Code: [Select]
`rgb(int(rnd*2)*255,int(rnd*2)*255,int(rnd*2)*255)  '2^3 possible colors including B&W`
Put the still drawing in a loop and it is quite colorful!

Yes, recursively divides a screen section into 4 subsections.

This was an attempt at a Persian carpet, I was trying to follow a text description of the algorithm. Doesn't quite match the B&W in book (Wonders of Numbers).
« Last Edit: 08. February 2016, 22:07:34 by B+ »

#### ZXDunny

• Full Member
• Posts: 161
##### Re: Graphic Code Challenge
« Reply #4 on: 09. February 2016, 01:46:35 »
I assume you're talking about this algorithm:

https://web.archive.org/web/20020331211006/http://www.oup-usa.org/sc/0195133420/ch50.bas.txt

Code: [Select]
`REM BASIC Code: Persian Carpet DesignsREM A modification of original concept from Anne BurnsREM Try colorborder=15, a=3DECLARE FUNCTION DetermineColor! (left!, right!, top!, bot!, a!)DECLARE FUNCTION f! (left!, right!, top!, bot!, a!)INPUT "Enter the border color, 1 - 15:", colorborderINPUT "Enter a value >", aSCREEN 12CLSleft = 1right = 513top = 1bot = 401LINE (left, top)-(right, top), colorborderLINE (left, bot)-(right, bot), colorborderLINE (left, top)-(left, bot), colorborderLINE (right, top)-(right, bot), colorborderk = DetermineColor(left, right, top, bot, a)ENDREM Determine the color based on function fFUNCTION DetermineColor (left, right, top, bot, a)IF left < right - 1 THEN c = f(left, right, top, bot, a) middlecol = (left + right) / 2 middlerow = (top + bot) / 2 LINE (left + 1, middlerow)-(right - 1, middlerow), c LINE (middlecol, top + 1)-(middlecol, bot - 1), c DetermineColor = DetermineColor(left, middlecol, top, middlerow, a) DetermineColor = DetermineColor(middlecol, right, top, middlerow, a) DetermineColor = DetermineColor(left, middlecol, middlerow, bot, a) DetermineColor = DetermineColor(middlecol, right, middlerow, bot, a)END IFEND FUNCTIONREM When b=4, this function takes an average. FUNCTION f (left, right, top, bot, a)p = POINT(left, top) + POINT(right, top) + POINT(left, bot) + POINT(right, bot)'Try values of b = 4 or b = 7b=7f = (p /b + a) MOD 16END FUNCTION`
In which case, here is the SpecBAS equivalent:

Code: [Select]
`ZXBASIC10 REM Persian Carpet20 DEF FN f(l,r,t,b,a)=((POINT(l,t)+POINT(r,t)+POINT(l,b)+POINT(r,b))/4+a) MOD 1630 DEF PROC dc(l,r,t,b,a)40 IF l<r-1 THEN LOCAL c=FN f(l,r,t,b,a),mc=(l+r)/2,mr=(t+b)/2: DRAW INK c;l+1,mr TO r-1,mr: DRAW INK c;mc,t+1 TO mc,b-1: PROC dc(l,mc,t,mr,a): PROC dc(mc,r,t,mr,a): PROC dc(l,mc,mr,b,a): PROC dc(mc,r,mr,b,a)50 END PROC60 bc=INT(RND*15)+1,a=3,l=1,r=513,t=1,b=401: RECTANGLE INK bc;l,t TO r,b70 PROC dc(l,r,t,b,a)80 PAUSE 0: GO TO 60`
Which produces some quite nice images (though I can't help but think that a better palette would be in order!), even if the variations appear to be limited.

You can add more variety by retaining the MOD 16 (as that constrains to the lower palette) and setting BC to RND*somelargenumber.

D.

#### B+

• Hero Member
• Posts: 532
##### Re: Graphic Code Challenge
« Reply #5 on: 09. February 2016, 02:20:57 »
Hi D,

Yes very nice! That is much better pattern/algorithm.

I was adding a Sierpinski tile to my graphic and noticed an inconsistency in my brick coloring. Here is corrected version without cr function using:

rgb((i mod 4)*80,0,0) for 4 color bricks

Sierpinski Tile worked out OK too.
« Last Edit: 09. February 2016, 02:54:07 by B+ »

#### B+

• Hero Member
• Posts: 532
##### Re: Graphic Code Challenge
« Reply #6 on: 09. February 2016, 04:27:12 »
These things are gorgeous! But the size is very sensitive to multiples of 2, else you get junk.

Code: [Select]
`'Persian Carpet.bas for SmallBASIC 0.12.2 [B+=MGA] 2016-02-08'modified from copy from Retrogamecoding link 2016-02-08REM BASIC Code: Persian Carpet Designs REM A modification of original concept from Anne BurnsREM Try colorborder=15, a=3while 1  cls  INPUT "Enter the border color, 1 - 15 (try 15): ", colorborder  INPUT "Enter a value (try 3) > ", a  CLS  lft = 1  'rght = 513  rght=1025  top = 1  'bot = 401  bot=801  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  showpage  pausewENDREM Determine the color based on function fsub DetermineColor(lft, rght, top, bot, a)  local c,middlerow,middlecol  IF (lft < rght - 1) THEN    c = f(lft, rght, top, bot, a)    middlecol = (lft + rght) / 2    middlerow = (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 IFENDREM When b=4, this function takes an average.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=7  f = (p /b + a) MOD 16END`

#### B+

• Hero Member
• Posts: 532
##### Re: Graphic Code Challenge
« Reply #7 on: 09. February 2016, 18:24:51 »
Oh the variety! But unless I use 513x401 I loose the perfect symmetry. Look carefully
« Last Edit: 09. February 2016, 18:27:50 by B+ »

#### ZXDunny

• Full Member
• Posts: 161
##### Re: Graphic Code Challenge
« Reply #8 on: 09. February 2016, 20:41:48 »
Yeah - it's a very sensitive algorithm but the carpets are nice! Just need to figure out a way to generate random but pleasing palettes that simulate the weave...

I googled the book you were talking about - "wonder of numbers" and got a google books result. Found a persian carpet-alike black and white image, then went through archive.org looking for the BASIC code he referred to. That's the code that produced the black and white image, as far as I can tell.

D.

#### B+

• Hero Member
• Posts: 532
##### Re: Graphic Code Challenge
« Reply #9 on: 24. September 2017, 21:08:54 »
Some updates to this code: from radial symmetry to bilateral, brighter colors, centered on screen, random element for unique runs...
Code: [Select]
`'Persian Carpet v2.bas for SmallBASIC 0.12.9 (B+=MGA)'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!' 2017-09-24 eliminate radial symmerty and most blank screensREM BASIC Code: Persian Carpet Designs REM A modification of original concept from Anne Burnscolorborder = 0 : a = 1xo = (xmax - 512) / 2 : yo = (ymax - 512) / 2while 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 = 0wendrem Determine the color based on function fsub 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 ifendfunc 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 + 7end`
and yet not all that different