swirl effect

[marshawn]


'magnetic dipol
H$ = "gr"
global pi
pi = 4*atn(1)
c = 800
sw = 640
sh = 480

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

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

for yy=0 to sh
for xx=0 to sw
   u = (xx - sw/2)*0.008
   v = (sh/2 - yy)*0.008

   x = u
   y = v

   d = (u-1)*(u-1) + v*v
   if d<>0 then
       x = ((u+1)*(u-1) + v*v)/d
       y = (v*(u-1) - (u+1)*v)/d

       lnz = x*x + y*y
       if lnz<>0 then
           lnz = log(lnz)/2
           arg = atan2(y, x)
           x = lnz
           y = arg
       end if
   end if

   z = (abs(c*x*2) mod c) < (c/2) xor (abs(c*y*2) 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

   #gr "set ";xx;" ";yy
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



[plus]

Yeah a couple nice ones Marshawn!

[tsh73]

Great stuff.

I wonder what 'c' was supposed to be used for. It looks like in JB it works with any c (even 1).

I put in code to ajust window by client window size, SCAN to allow closing window mid-loop and changed non-working (0,0) as (UpperLeftX ,UpperLeftY) to (1,1).


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

nomainwin
'JB window size includes borders and title, this make client size big enougth
desiredWidth = sw
desiredHeight = sh
gosub [ajustWindow]

UpperLeftX = 1  '0,0 just doesn't work
UpperLeftY = 1

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
SCAN    'scan in inner loop so Ctrl Break could break it
   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
'   #gr "discard"   'speed things up at expence of non-persistent graphics
next
next
#gr "flush"
wait

sub quit Hdl$
   close #Hdl$
   end
end sub

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

'-------------------------------------------------
[ajustWindow]
   UpperLeftX = 20
   UpperLeftY = 20
   WindowWidth = 200   '100 seems to be too much - works different
   WindowHeight = 100
   'if you have menu you should uncomment next line to account for it
'    MENU #gr, "dummy"
   open "Ajusting..." for graphics_nsb_nf as #gr
   'you should have same type of window ajusting as your main one
'   graphics
'   graphics_nsb
'   graphics_nsb_nf

   #gr, "home ; down ; posxy x y"
   'x, y give us width, height
   width = 2*x : height = 2*y
   close #gr

   slackX = 200-width
   slackY = 100-height

   WindowWidth = desiredWidth + slackX
   WindowHeight = desiredHeight + slackY

return


[marshawn]

nice, good JB lesson!

As a curiosity, here are the exact same formulas but done with a logarithmic polar checkerboard -- you can remove the line "yp = log(1 + c*yp)" to make it non-logarithmic

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

nomainwin
'JB window size includes borders and title, this make client size big enougth
desiredWidth = sw
desiredHeight = sh
gosub [ajustWindow]

UpperLeftX = 1  '0,0 just doesn't work
UpperLeftY = 1

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
SCAN    'scan in inner loop so Ctrl Break could break it
   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


   xp = atan2(y, x)/(pi/3)
   yp = sqr(x*x + y*y)
   yp = log(1 + c*yp)

   x = xp
   y = yp

   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
'   #gr "discard"   'speed things up at expence of non-persistent graphics
next
next
#gr "flush"
wait

sub quit Hdl$
   close #Hdl$
   end
end sub

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

'-------------------------------------------------
[ajustWindow]
   UpperLeftX = 20
   UpperLeftY = 20
   WindowWidth = 200   '100 seems to be too much - works different
   WindowHeight = 100
   'if you have menu you should uncomment next line to account for it
'    MENU #gr, "dummy"
   open "Ajusting..." for graphics_nsb_nf as #gr
   'you should have same type of window ajusting as your main one
'   graphics
'   graphics_nsb
'   graphics_nsb_nf

   #gr, "home ; down ; posxy x y"
   'x, y give us width, height
   width = 2*x : height = 2*y
   close #gr

   slackX = 200-width
   slackY = 100-height

   WindowWidth = desiredWidth + slackX
   WindowHeight = desiredHeight + slackY

return


[tsh73]

Really cool. Somehow logarithmic spiral feels very nice to me ;)

You can speed that program quite a bit if you just NOT paint white pixels.
With that you can skip changing colors, at all (it takes time too).

(in my case it got 2.6x faster)