swirl effect

[tsh73]

kind of.
Based on description from
scikit-image.org/docs/dev/auto_examples/transform/plot_swirl.html

Really nice quote

The reverse mapping for the swirl transformation

'swirl effect 01
nomainwin
open "test" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
#gr "fill white; flush"
#gr "home; posxy cx cy"

sz=20
radius=200
r=log(2)*radius/5 '???
s=2
rot=1
#gr "size 3"
for x=-5 to 4 step 0.1
   for y= -5 to 4 step 0.1
       scan
       if 1 then
           xx=cx+x*sz+sz/2
           yy=cy+y*sz+sz/2
           dx=xx-cx: dy=yy-cy
           phi=atan2(dy, dx)
           rho=sqr(dx*dx+dy*dy)
           phi2=phi+s*exp(0-rho/r+rot)
           c$=rainbow$(phi2/2/acs(-1))
           #gr "color ";c$
           #gr "set ";xx;" ";yy
       end if
   next
next


#gr "flush"
wait

[quit]
timer 0
close #gr
end

'---------------------------
function atan2(y,x)
   pi = acs(-1)    'could be made global to save some ticks
   if x <> 0 then arctan = atn(y/x)

   select case
       case x > 0
       atan2 = arctan

       case y>=0 and x<0
       atan2 = pi + arctan

       case y<0 and x<0
       atan2 = arctan - pi

       case y>0 and x=0
       atan2 = pi / 2

       case y<0 and x=0
       atan2 = pi / -2
   end select
end function
'---------------------------------------------
' 0..1 into red-green-blue-red continuous colors
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]

Closer,

unpolished (weird steps, size2, GetPixelValue$, lot's of commented lines)

'swirl effect 02
nomainwin
WindowWidth=650
open "test" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
'#gr "fill white; flush"
#gr "home; posxy cx cy"
'#gr "home; circle 50"
cx1=cy  'from

cx2=2*cx-cy  'to

cxx=cx1
#gr "backcolor black"
sz=20
for x=-5 to 4
   for y= -5 to 4
       if (x+y) mod 2 = 0 then
           xx=cxx+x*sz'-sz/2
           yy=cy+y*sz'-sz/2
           #gr "place ";xx;" ";yy
           #gr "boxfilled ";xx+sz;" ";yy+sz
       end if
   next
next

radius=100
r=log(2)*radius/5 '???
s=2
rot=1
#gr "size 2"
for x=-5 to 4 step 0.1
   for y= -5 to 4 step 0.1
       scan
       if 1 or (x+y) mod 2 = 0 then
           xx=cx2+x*sz+sz/2
           yy=cy+y*sz+sz/2
           '#gr "color black"
           '#gr "set ";xx;" ";yy
           dx=xx-cx2: dy=yy-cy
           phi=atan2(dy, dx)
           'c$=rainbow$(phi/2/acs(-1))
           '#gr "color ";c$
           '#gr "set ";xx;" ";yy
           rho=sqr(dx*dx+dy*dy)
           phi2=phi+s*exp(0-rho/r+rot)
           'print xx, yy, rho, phi, phi2
           xxSrc=cx1+rho*cos(phi2)
           yySrc=cy+rho*sin(phi2)
           c$= GetPixelValue$(xxSrc, yySrc,"#gr")
           '#gr "color red"
           '#gr "set ";xxSrc;" ";yySrc
           'print xxSrc,  yySrc, c$
           'c$=rainbow$(phi2/2/acs(-1))
           #gr "color ";c$
           #gr "set ";xx;" ";yy
       end if
   next
next


#gr "flush"
wait

[quit]
timer 0
close #gr
end

'---------------------------
function atan2(y,x)
   pi = acs(-1)    'could be made global to save some ticks
   if x <> 0 then arctan = atn(y/x)

   select case
       case x > 0
       atan2 = arctan

       case y>=0 and x<0
       atan2 = pi + arctan

       case y<0 and x<0
       atan2 = arctan - pi

       case y>0 and x=0
       atan2 = pi / 2

       case y<0 and x=0
       atan2 = pi / -2
   end select
end function
'---------------------------------------------
' 0..1 into red-green-blue-red continuous colors
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

'*****************************************************
'GetPixelValue$ returns a string with the RGB values of the pixel
'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph")
function GetPixelValue$(x, y, handle$)

'Grab a 1*1 bitmap
   #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1

'Save in a bmp file
   bmpsave "gpv", "getpvaluetemp.bmp"

'Open the file for string input and get it's full contents
   open "getpvaluetemp.bmp" for input as #gpv
   s$ = input$(#gpv, lof(#gpv))
   close #gpv

'Check if user's display is 32-bit, and read the red-green-blue values
'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0
'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment
'otherwise function returns nothing (support for other display types could be added (?))
   bpp =  asc(mid$(s$, 29, 1))
   select case bpp
   case 32
       red = asc(mid$(s$, 69, 1))
       green = asc(mid$(s$, 68, 1))
       blue = asc(mid$(s$, 67, 1))
   case 24        '(censored): 24 bit, no palette
       red = asc(mid$(s$, 57, 1))
       green = asc(mid$(s$, 56, 1))
       blue = asc(mid$(s$, 55, 1))
       'print red,green, blue
   case 16
       bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
       red =  (bytes AND 63488) /256       '0xF800
       green =  (bytes AND 2016) / 32 * 4  '0x7E0
       blue =  (bytes AND 31) * 8          '0x1F
   end select

'concatenate the return value, delete temporary file and free memory
   GetPixelValue$ = using("###",red)+using("####",green)+using("####",blue)
   kill "getpvaluetemp.bmp"
   unloadbmp "gpv"
end function


[tsh73]

(1) and (2) combined, look how it painted - from where pixels go

'swirl effect 03
nomainwin
WindowWidth=650
open "test" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
'#gr "fill white; flush"
#gr "home; posxy cx cy"
'#gr "home; circle 50"
cx1=cy  'from

cx2=2*cx-cy  'to

cxx=cx1
#gr "backcolor black"
sz=20
for x=-5 to 4
   for y= -5 to 4
       if (x+y) mod 2 = 0 then
           xx=cxx+x*sz'-sz/2
           yy=cy+y*sz'-sz/2
           #gr "place ";xx;" ";yy
           #gr "boxfilled ";xx+sz;" ";yy+sz
       end if
   next
next

radius=100
r=log(2)*radius/5 '???
s=2
rot=1
#gr "size 2"
for x=-5 to 4 step 0.1
   for y= -5 to 4 step 0.1
       scan
       if 1 or (x+y) mod 2 = 0 then
           xx=cx2+x*sz+sz/2
           yy=cy+y*sz+sz/2
           '#gr "color black"
           '#gr "set ";xx;" ";yy
           dx=xx-cx2: dy=yy-cy
           phi=atan2(dy, dx)
           'c$=rainbow$(phi/2/acs(-1))
           '#gr "color ";c$
           '#gr "set ";xx;" ";yy
           rho=sqr(dx*dx+dy*dy)
           phi2=phi+s*exp(0-rho/r+rot)
           'print xx, yy, rho, phi, phi2
           xxSrc=cx1+rho*cos(phi2)
           yySrc=cy+rho*sin(phi2)
           c$= GetPixelValue$(xxSrc, yySrc,"#gr")
           if c$<>"255 255 255" then
               '#gr "color red"
               '#gr "set ";xxSrc;" ";yySrc
               'print xxSrc,  yySrc, c$
               c$=rainbow$(phi2/2/acs(-1))
               #gr "color ";c$
               #gr "set ";xxSrc;" ";yySrc
               #gr "set ";xx;" ";yy
           end if
       end if
   next
next


#gr "flush"
wait

[quit]
timer 0
close #gr
end

'---------------------------
function atan2(y,x)
   pi = acs(-1)    'could be made global to save some ticks
   if x <> 0 then arctan = atn(y/x)

   select case
       case x > 0
       atan2 = arctan

       case y>=0 and x<0
       atan2 = pi + arctan

       case y<0 and x<0
       atan2 = arctan - pi

       case y>0 and x=0
       atan2 = pi / 2

       case y<0 and x=0
       atan2 = pi / -2
   end select
end function
'---------------------------------------------
' 0..1 into red-green-blue-red continuous colors
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

'*****************************************************
'GetPixelValue$ returns a string with the RGB values of the pixel
'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph")
function GetPixelValue$(x, y, handle$)

'Grab a 1*1 bitmap
   #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1

'Save in a bmp file
   bmpsave "gpv", "getpvaluetemp.bmp"

'Open the file for string input and get it's full contents
   open "getpvaluetemp.bmp" for input as #gpv
   s$ = input$(#gpv, lof(#gpv))
   close #gpv

'Check if user's display is 32-bit, and read the red-green-blue values
'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0
'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment
'otherwise function returns nothing (support for other display types could be added (?))
   bpp =  asc(mid$(s$, 29, 1))
   select case bpp
   case 32
       red = asc(mid$(s$, 69, 1))
       green = asc(mid$(s$, 68, 1))
       blue = asc(mid$(s$, 67, 1))
   case 24        'LBB: 24 bit, no palette
       red = asc(mid$(s$, 57, 1))
       green = asc(mid$(s$, 56, 1))
       blue = asc(mid$(s$, 55, 1))
       'print red,green, blue
   case 16
       bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
       red =  (bytes AND 63488) /256       '0xF800
       green =  (bytes AND 2016) / 32 * 4  '0x7E0
       blue =  (bytes AND 31) * 8          '0x1F
   end select

'concatenate the return value, delete temporary file and free memory
   GetPixelValue$ = using("###",red)+using("####",green)+using("####",blue)
   kill "getpvaluetemp.bmp"
   unloadbmp "gpv"
end function


[B+]

Nice, that swirl code reminds me of BSpinoza Fibonacci Spiral

'  Golden Ratio:
phi = (1 + 5 ^ 0.5) / 2
'a:  arbitrary scaling factor
a = 0.004
'b:  growth factor of the spiral
b = Log(phi) / 90
PSet (0, 0), 12 'Starting point
For theta = 0 To 2260
   x = a * Cos(_D2R(theta)) * Exp(b * theta)
   y = a * Sin(_D2R(theta)) * Exp(b * theta)
   Line -(x, y), 12
Next theta

[tenochtitlanuk]

I've had a lot of fun with transforms of images. Anamorphic projections are particular fun.

Examples on my site, eg

www.diga.me.uk/affineTransformBMP.html

www.diga.me.uk/lena.html

You'll also find Fibonacci spiral there.

[B+]

tsh73 as usual inspiring, here is my swizzle variation:

'swizzle b+ 2021-05-29

global H$, XMAX, YMAX, PI
H$ = "gr"
XMAX = 400 '<======================================== actual drawing space needed
YMAX = 400 '<======================================== actual drawing space needed
PI = acs(-1)
nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above
open "Swizzle" for graphics_nsb_nf as #gr  '<======================= title
#gr "trapclose quit"
#gr "down"
cxy = 200
dim vScreenR(XMAX, YMAX), vScreenG(XMAX, YMAX), vScreenB(XMAX, YMAX)
[restart]
r = rnd(0)*rnd(0) : g = rnd(0)*rnd(0) : b = rnd(0)*rnd(0)
for x = 0 to XMAX
   #gr "color ";128+128*sin(r*x);" ";128+128*sin(g*x);" ";128+128*sin(b*x)
   #gr "line ";x;" ";0;" ";x;" ";YMAX
   for y = 0 to YMAX
       vScreenR(x,y) = 128+128*sin(r*x)
       vScreenG(x,y) = 128+128*sin(g*x)
       vScreenB(x,y) = 128+128*sin(b*x)
   next
next
for radius = 1 to 120
   scan
   for a = 0 to 2*PI step 1/(2*PI*radius)
       scan
       x = int(cxy + radius * cos(a))
       y = int(cxy + radius * sin(a))
       r = vScreenR(x, y)
       g = vScreenG(x, y)
       b = vScreenB(x, y)
       #gr "color ";r;" ";g;" ";b
       #gr "set ";cxy + radius * cos(a + radius^1.25*PI/180);" ";cxy + radius * sin(a + radius^1.25*PI/180)
   next
next
#gr "flush"
goto [restart]
wait

'Need line: #gr "trapclose quit"
sub quit H$
   close #H$ '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub





[B+]

Here's a variation that might look familiar:
'swizzle yy b+ 2021-05-29

global H$, XMAX, YMAX, PI
H$ = "gr"
XMAX = 400 '<======================================== actual drawing space needed
YMAX = 400 '<======================================== actual drawing space needed
PI = acs(-1)
nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above
open "Swizzle YY" for graphics_nsb_nf as #gr  '<======================= title
#gr "trapclose quit"
#gr "down"
cxy = 200
dim vScreenR(XMAX, YMAX), vScreenG(XMAX, YMAX), vScreenB(XMAX, YMAX)
for x = 0 to XMAX
   if x < .5*XMAX then
       r=0:g=0:b=0
   else
       r=255:g=255:b=255
   end if
   #gr "color ";r;" ";g;" ";b
   #gr "line ";x;" ";0;" ";x;" ";YMAX
   for y = 0 to YMAX
       vScreenR(x,y) = r
       vScreenG(x,y) = g
       vScreenB(x,y) = b
   next
next
for radius = 1 to 180
   scan
   for a = 0 to 2*PI step 1/(2*PI*radius)
       scan
       x = int(cxy + radius * cos(a))
       y = int(cxy + radius * sin(a))
       r = vScreenR(x, y)
       g = vScreenG(x, y)
       b = vScreenB(x, y)
       #gr "color ";r;" ";g;" ";b
       #gr "set ";cxy + radius * cos(a + radius^1*PI/180);" ";cxy + radius * sin(a + radius*1*PI/180)
   next
next
#gr "flush"
wait

'Need line: #gr "trapclose quit"
sub quit H$
   close #H$ '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub



[tsh73]

John,
transformations code from your pages misses some matrix subs so it didn't start
(also code appears aligned centrally, which is really strange look for code)

B+,
trying to add missing parts around your "BSpinoza Fibonacci Spiral", I got this

nomainwin
open "test" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
#gr "fill white; flush"
#gr "home; posxy cx cy"

'  Golden Ratio:
phi = (1 + 5 ^ 0.5) / 2
'a:  arbitrary scaling factor
a = 0.004
'b:  growth factor of the spiral
b = Log(phi) / 90
'PSet (0, 0), 12 'Starting point
#gr "home"'Starting point
For theta = 0 To 2260
   x = a * Cos(_D2R(theta)) * Exp(b * theta)_
       +cx
   y = a * Sin(_D2R(theta)) * Exp(b * theta)_
       +cy
'    Line -(x, y), 12
   #gr "goto ";x;" ";y
Next theta

#gr "flush"
wait

[quit]
timer 0
close #gr
end


Does it supposed to look like this?

Color swirl looks really nice, your posted picture look pleasantly liquid

As for b/w version, I did speed it up quite a bit.
'swizzle yy b+ 2021-05-29

global H$, XMAX, YMAX, PI
H$ = "gr"
XMAX = 400 '<======================================== actual drawing space needed
YMAX = 400 '<======================================== actual drawing space needed
PI = acs(-1)
nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above
open "Swizzle YY" for graphics_nsb_nf as #gr  '<======================= title
#gr "trapclose quit"
#gr "down"
cxy = 200
dim vScreenR(XMAX, YMAX), vScreenG(XMAX, YMAX), vScreenB(XMAX, YMAX)
t0=time$("ms")
for x = 0 to XMAX
   if x < .5*XMAX then
       r=0:g=0:b=0
   else
       r=255:g=255:b=255
   end if
   #gr "color ";r;" ";g;" ";b
   #gr "line ";x;" ";0;" ";x;" ";YMAX
   for y = 0 to YMAX
       vScreenR(x,y) = r
       vScreenG(x,y) = g
       vScreenB(x,y) = b
   next
next
lastCol$="green"
for radius = 1 to 180
   scan
   da = radius^1.25*PI/180 'lollypop
   'da = radius^1*PI/180    'in yan
   for a = 0 to 2*PI step 1/(2*PI*radius)
       scan
       x = int(cxy + radius * cos(a))
       'y = int(cxy + radius * sin(a))
       'r = vScreenR(x, y)
       'g = vScreenG(x, y)
       'b = vScreenB(x, y)
       if x < .5*XMAX then c$="black" else  c$="white"
       if lastCol$<>c$ then
           lastCol$=c$
           #gr "color ";c$
       end if
       #gr "set ";cxy + int(radius * cos(a + da));" ";cxy + int(radius * sin(a + da))
   next
   #gr "discard"
next
#gr "getbmp bmp 0 0 400 400"
#gr "drawbmp bmp 0 0"
#gr "flush"
t1=time$("ms")
'notice "Time taken, ms ";t1-t0
wait

'Need line: #gr "trapclose quit"
sub quit H$
   close #H$ '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub


[B+]

BSpinoza's spiral looks like this (see attached) you have to remember I haven't seen a spiral for awhile
_D2R() is QB64's conversion of Degrees to Radians function, sorry I forgot that was in there.
nomainwin
open "test" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
#gr "fill white; flush"
#gr "home; posxy cx cy"

'  Golden Ratio:
phi = (1 + 5 ^ 0.5) / 2
'a:  arbitrary scaling factor
a = 0.004
'b:  growth factor of the spiral
b = Log(phi) / 90
'PSet (0, 0), 12 'Starting point
#gr "home"'Starting point
For theta = 0 To 2260
   x = a * Cos(D2R(theta)) * Exp(b * theta)_
       +cx
   y = a * Sin(D2R(theta)) * Exp(b * theta)_
       +cy
'    Line -(x, y), 12
   #gr "goto ";x;" ";y
Next theta

#gr "flush"
wait

[quit]
timer 0
close #gr
end

function D2R(degrees)
D2R = degrees * 3.141592654/180
end function

Not bad considering BSpinoza was also working a WINDOW command which flipped and rescaled coordinate system!

And the familiar object I had in mind was Ying Yang symbol but I see your lollypop, now! ;-))
(and it isn't a logarithmic spiral is it.)

Attachments:

[B+]

Sharing this code at another forum, it was pointed out to me that I really didn't need to use 2D arrays. It's true, once you have the x, you have the color. So I modified code to require the 2D arrays:

'swizzle 2 b+ 2021-05-30 make use of 2D Arrays

global H$, XMAX, YMAX, PI
H$ = "gr"
XMAX = 400 '<======================================== actual drawing space needed
YMAX = 400 '<======================================== actual drawing space needed
PI = acs(-1)
nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above
open "Swizzle" for graphics_nsb_nf as #gr  '<======================= title
#gr "trapclose quit"
#gr "down"
cxy = 200
dim vScreenR(XMAX, YMAX), vScreenG(XMAX, YMAX), vScreenB(XMAX, YMAX)
[restart]
r = rnd(0)*rnd(0)*.25 : g = rnd(0)*rnd(0)*.25 : b = rnd(0)*rnd(0)*.25
for x = 0 to .5*XMAX
   #gr "color ";128+128*sin(r*x);" ";128+128*sin(g*x);" ";128+128*sin(b*x)
   call box x,x,XMAX-x,YMAX-x
   For y = x To YMAX - x
       vScreenR(x, y) = 128 + 128 * Sin(r * x)
       vScreenG(x, y) = 128 + 128 * Sin(g * x)
       vScreenB(x, y) = 128 + 128 * Sin(b * x)
       vScreenR(XMAX - x, y) = 128 + 128 * Sin(r * x)
       vScreenG(XMAX - x, y) = 128 + 128 * Sin(g * x)
       vScreenB(XMAX - x, y) = 128 + 128 * Sin(b * x)
   Next
   For y = x To XMAX - x
       vScreenR(y, x) = 128 + 128 * Sin(r * x)
       vScreenG(y, x) = 128 + 128 * Sin(g * x)
       vScreenB(y, x) = 128 + 128 * Sin(b * x)
       vScreenR(XMAX - y, YMAX - x) = 128 + 128 * Sin(r * x)
       vScreenG(XMAX - y, YMAX - x) = 128 + 128 * Sin(g * x)
       vScreenB(XMAX - y, YMAX - x) = 128 + 128 * Sin(b * x)
   Next
next
for radius = 1 to 200
   scan
   for a = 0 to 2*PI step 1/(2*PI*radius)
       scan
       x = int(cxy + radius * cos(a))
       y = int(cxy + radius * sin(a))
       r = vScreenR(x, y)
       g = vScreenG(x, y)
       b = vScreenB(x, y)
       #gr "color ";r;" ";g;" ";b
       #gr "set ";cxy + radius * cos(a + radius^1*PI/180);" ";cxy + radius * sin(a + radius^1*PI/180)
   next
next
#gr "flush"
goto [restart]
wait

'Need line: #gr "trapclose quit"
sub quit H$
   close #H$ '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub

sub box x0, y0, x1, y1
   #gr "place ";x0;" ";y0
   #gr "box ";x1;" ";y1
end sub



Attachments:

[tsh73]

it was pointed out to me that I really didn't need to use 2D arrays.

It was just that your initial picture depended only from X coord
But math in your program was ready to any initial picture - say random photo.

[B+]

May 30, 2021 16:10:20 GMT tsh73 said:

it was pointed out to me that I really didn't need to use 2D arrays.

It was just that your initial picture depended only from X coord
But math in your program was ready to any initial picture - say random photo.

Yes, I've been thinking of trying it on a Picasso portrait. I am in my Swizzle period code development should last the day.

Attachments:

[tsh73]

damn, it was a tower behind that swirl.
Not so nice looking I expected.

[B+]

Looking through Internet for better picture to Swizzle:

At first I thought that was some famous building in Russia, then something whispered Sophia Hagia in my mind. Close but the towers are wrong but Internet search was also showing 6 towers with the extra rings up the side like tsh73 picture.

Oh ha! The Blue Mosque is right next door there in Istanbul!

I settled for a snapshot of tsh73's smaller and square if ruined a bit on right.



And then tried my Swizzle



www.youtube.com/watch?v=eQPMQorRRyI

[marshawn]


'kuda by vswirlet
H$ = "gr"
global pi
pi = 4*atn(1)
c = 800
sw = 800
sh = 600

nomainwin
WindowWidth = sw
WindowHeight = sh
UpperLeftX = 0
UpperLeftY = 0

open "Constanta" for graphics_nsb_nf as #gr
#gr "trapclose quit"
#gr "down"
#gr "fill white"

for i=0 to 3
for yy=0 to sh/2
for xx=0 to sw/2
   u = (xx - sw/4)*0.01
   v = (sh/4 - yy)*0.01

   select case i
   case 0
       x = u
       y = v
   case 1
       d = sqr(u*u + v*v)
       a = atan2(v, u) - 6/exp(d/0.3)
       x = d*cos(a)
       y = d*sin(a)
   case 2
       d = u*u + v*v
       if d<>0 then
           x = ((u + 1)*u + v*v)/d
           y = (v*u - (u + 1)*v)/d
       end if
   case 3
       u = u*1.8
       v = v*1.8
       x = sin(u)*0.5*(exp(v) + 1/exp(v))
       y = cos(u)*0.5*(exp(v) - 1/exp(v))
   end select

   z = (abs(c*x) mod c) < (c/2) xor (abs(c*y) mod c) < (c/2)

   if (x>0 and y>0) or (x<0 and y<0) then
       if z<>0 then #gr "color black" else #gr "color white"
   else
       if z<>0 then #gr "color white" else #gr "color black"
   end if

   select case i
   case 0
       #gr "set ";xx;" ";yy
   case 1
       #gr "set ";xx + sw/2;" ";yy
   case 2
       #gr "set ";xx;" ";yy + sh/2
   case 3
       #gr "set ";xx + sw/2;" ";yy + sh/2
   end select
next
next
next
#gr "flush"
wait

sub quit Hdl$
   close #Hdl$
   end
end sub

function atan2(y,x)  'tsh version has scan built-in
   'pi = acs(-1)    'could be made global to save some ticks
   if x <> 0 then arctan = atn(y/x)

   select case
       case x > 0
       atan2 = arctan

       case y>=0 and x<0
       atan2 = pi + arctan

       case y<0 and x<0
       atan2 = arctan - pi

       case y>0 and x=0
       atan2 = pi / 2

       case y<0 and x=0
       atan2 = pi / -2
   end select
end function