Spiral Pearl Swirl

[B+]

Code: [Select]

'Spiral Pearl Swirl.bas for FreeBASIC [B+=MGA] 2017-02-28
'from SdlBasic 3d version 2017-02-28
' inspired by spiral Bang

Const As Double PI = ACos(-1)

'Set screen size here
dim as integer sw = 600, sh = 600, depth = 32
screenres sw, sh, depth, 2
WindowTitle "Spiral Pearl Swirl  -  Press esc to exit"

Dim As Integer page, notpage, r
Dim As Double size, radius, angle, x, y, r2
Dim As UInteger cc
Dim ky as String
Dim As Double sangle = 0.0
notpage = 1

While ky <> Chr(27)
If page = 0 THEN page = 1 ELSE page = 0   'These two lines flip the page and the
  If notpage = 1 THEN notpage = 0 ELSE notpage = 1 'backpage
  SCREENSET page, notpage 'This flips the page
  size = 1
radius = .06
angle = sangle
Cls(rgb(10,20,40))
While radius < 400
x = cos(angle) * radius
y = sin(angle) * radius
r2 = (x ^ 2 + y ^ 2) ^ .5
size = 4 * r2 ^ .25
For r = size to 1 step - 2
cc = 160 + 95 * radius/400 - r/size*120
Color (rgb(cc, cc, cc))
Circle(sw / 2 + x, sh / 2 + y), r, , , , , F
Next
angle = angle - .4
radius = radius + 1
Wend
Sleep(30)
   sangle = sangle + pi/18
  ky = InKey
Wend


[Peter]

Ported it with as few modifications as possible:

Code: [Select]

'Spiral Pearl Swirl.bas for FreeBASIC [B+=MGA] 2017-02-28
'from SdlBasic 3d version 2017-02-28
' inspired by spiral Bang
'Ported to BaCon by PvE - March 1, 2017

'Set screen size here
INCLUDE canvas.bac
DECLARE sw = 600, sh = 600, depth = 32

WINDOW("Spiral Pearl Swirl  -  Press esc to exit", sw, sh)

DECLARE page, notpage, r TYPE int
DECLARE size, radius, angle, x, y, r2 TYPE double
DECLARE cc TYPE unsigned int
DECLARE sangle = 0.0 TYPE double

notpage = 1

size = 1
radius = .06
angle = sangle
INK(10, 20, 40, 255)
CLS
WHILE radius < 400
    x = COS(angle) * radius
    y = SIN(angle) * radius
    r2 = POW((POW(x, 2) + POW(y, 2)), .5)
    size = 4 * POW(r2, .25)
    FOR r = size TO 1 STEP -2
        cc = 160 + 95 * radius/400 - r/size*120
        INK(cc, cc, cc, 255)
        CIRCLE(sw / 2 + x, sh / 2 + y, r, r, TRUE)
    NEXT
    angle = angle - .4
    radius = radius + 1
WEND
sangle = sangle + PI/18

WAITKEY


[B+]

Hi Peter,

Are you missing the outer loop, that waits for esc, that clears the screen then draws the spiral pearls at a different start angle = sangle, thus causing the swirl? Yours looks like it would be a static picture. Am I missing something?

The FB page business is so you setup the next screen while displaying the last, so no flickering when cls.

Here is SmallBASIC version, maybe the two loops are easier to see:

Code: [Select]

' Spiral Pearl Swirl 4 SB.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-03-01
'from Spiral Pearl Swirl.bas for FreeBASIC [B+=MGA] 2017-02-28
'from SdlBasic 3d version 2017-02-28
' inspired by spiral Bang

'whatever screen size your device here is middle
cx = xmax/2 : cy = ymax/2 
While 1 'checking for key press slows down interpeter too much
  size = 1
  radius = .06
  angle = sangle
  cls
  While radius < 400
    x = cos(angle) * radius
    y = sin(angle) * radius
    r2 = (x ^ 2 + y ^ 2) ^ .5
    size = 4 * r2 ^ .25
    For r = size to 1 step - 2
      cc = 160 + 95 * radius/400 - r/size*120
      Color (rgb(cc, cc, cc))
      Circle cx + x, cy + y, r filled
    Next
    angle -= .4
    radius += 1
  Wend
  showpage ' update screen with new image
  'no delay needed as SB isn't as fast as an FB .exe
  sangle = sangle + pi/18
Wend



[Peter]

Thanks B+,

Yes, you're right - I assumed that the calculation took too long on your machine, so that the <ESC> key was used to interrupt it. This was a wrong assumption 

The adapted program:

Code: [Select]

'Spiral Pearl Swirl.bas for FreeBASIC [B+=MGA] 2017-02-28
'from SdlBasic 3d version 2017-02-28
' inspired by spiral Bang
'Ported to BaCon by PvE - March 2, 2017

'Set screen size here
INCLUDE canvas.bac
DECLARE sw = 600, sh = 600, depth = 32

WINDOW("Spiral Pearl Swirl  -  Press esc to exit", sw, sh)

DECLARE page, notpage, r TYPE int
DECLARE size, radius, angle, x, y, r2 TYPE double
DECLARE cc TYPE unsigned int
DECLARE sangle = 0.0 TYPE double

notpage = 1

SUB Redraw
    size = 1
    radius = .06
    angle = sangle
    INK(10, 20, 40, 255)
    CLS
    WHILE radius < 400
        x = COS(angle) * radius
        y = SIN(angle) * radius
        r2 = POW((POW(x, 2) + POW(y, 2)), .5)
        size = 4 * POW(r2, .25)
        FOR r = size TO 1 STEP -2
            cc = 160 + 95 * radius/400 - r/size*120
            INK(cc, cc, cc, 255)
            CIRCLE(sw / 2 + x, sh / 2 + y, r, r, TRUE)
        NEXT
        angle = angle - .4
        radius = radius + 1
    WEND
    sangle = sangle + PI/18
END SUB

CALLBACK(130, Redraw)
WAITKEY


[B+]

:-)) Ah! There it is!

A little slow     but I am looking at the GIF.

Is 130 in CALLBACK(130, redraw) a timer setting for recalling the sub?
 
 (The FB .exe runs so fast, I had to put in a sleeper clause, I was impressed by speed which is why I posted sample. Different systems will likely have different results though. I get a slight pause now and then and total pause when I click title bar.)

[Peter]

It is slow indeed, but this is intentionally. Not all browsers support animated GIFs at all speeds. There seem to be quite a lot of differences, as mentioned here and here. Results seem to be worst with Internet Explorer. Best results (e.g. fastest GIF animation) in my experience is with Firefox, though I never tried Opera or Safari.

And indeed, the 130 is the calling frequency. The program shown above actually runs in an OpenGL canvas. Also the OpenGL version is extremely fast. 

BR
Peter

[B+]

Rick posted a different inspiring Swirl at Naalaa. My mods of that one lead to this

Psychedelic Swirl:

Code: [Select]

'Psychedelic Swirl for Naalaa [B+=MGA] 2017-03-02
'extreme modification of Rick's Swirl

visible:
sw = 600
sh = 600
sw2# = float(sw)/2.0
sh2# = float(sh)/2.0 - 10.0
x# = 1.0
y# = 1.0
PI# = 3.14159265
pi2# = PI * 2.0
clr# = 1.0
r# = RandomFloat#(1.0)
g# = RandomFloat#(1.0)
b# = RandomFloat#(1.0)

StartAngle# = 0.0
hidden:
set redraw off
set window 0, 0, sw, sh

while 1
set color 0, 0, 0
cls
        proc Bang
redraw
wait 20
       StartAngle# = StartAngle# - 1.0
wend
end
 
procedure Bang()
  angle# = StartAngle#
  size# = 0.1
  radius# = 0.1
  ds# = 0.1
while radius < 400.0
x = cos( angle ) * radius
y = sin( angle ) * radius
for q = int(size) downto 0
proc MakeColor
draw rect int(sw2 + x), int(sh2 + y), q, q, 1
next
angle = angle + 41.0
radius = radius + 1.0
size = size + ds
ds = ds + 0.0001
wend
endproc

procedure MakeColor()
clr# = clr# + 0.8
set color int(127.0 + 128.0 * sin(r# * clr#)), int(127.0 + 128.0 * sin(g# * clr#)), int(127.0 + 128.0 * sin(b# * clr#))
if clr# > 1000000.0
r# = RandomFloat#(1.0)
g# = RandomFloat#(1.0)
b# = RandomFloat#(1.0)
clr# = 0.0
endif
endproc

function RandomFloat#(maxFloat#)
return maxFloat# * float(rnd(16000)) / 16000.0
endfunc

[B+]

Here is a SmallBASIC version for comparison:

Code: [Select]

' Psychedelic Swirl.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-03-02
' from Psychodelic Swirl for Naalaa [B+=MGA] 2017-03-02
' extreme modification of Rick's Swirl there

cx = xmax / 2 : cy = ymax / 2 : StartAngle = 0
clr = 1 : r = rnd : g = rnd : b = rnd

while 1
  cls
  Bang
  showpage
  delay 45
  StartAngle = StartAngle - pi/18
wend
 
sub Bang()
  angle = StartAngle
  size = .1 : radius = .1 : ds = .1
  while radius < 400
    x = cos(angle) * radius
    y = sin(angle) * radius
    chColor
    rect int(cx + x), int(cy + y), step size/1.3+2, size/1.3+2 filled
    angle = angle + 41.0
    radius = radius + 1.0
    size = size + ds
    ds = ds + 0.0001
  wend
end

sub chColor()
  clr = clr + 0.1
  color rgb(127+127*sin(r*clr), 127+127*sin(g*clr), 127+127*sin(b*clr))
  if clr > 10000 then r = rnd : g = rnd : b = rnd : clr = 0
end


In both these, the changing color patterns change every few seconds for variety.

[B+]

And it all started at SdlBasic forum to which we contributed this version:

Code: [Select]

' Psychedelic Star Swirl.sdlbas [B+=MGA] 2017-03-03
option qbasic
const sw = 600
const sh = 600
setdisplay(sw, sh, 32, 1)
setcaption("Pschedelic Swirl for SdlBasic")
autoback(-2)
const pi = acos(-1)
const rad = pi / 180
const deg = 180 / pi
common clr, r, g, b
clr = 0 : sangle = 0 : cx = sw/2 : cy = sh/2
r = rnd(10001)/10000 : g = rnd(10001)/10000 : b = rnd(10001)/10000
While 1
size = 1
radius = .06
angle = sangle
cls
While radius < 400
x = cos(angle) * radius
y = sin(angle) * radius
r2 = (x ^ 2 + y ^ 2) ^ .5
size = 4 * r2 ^ .25
For r = size to 1 step - 4
chColor()
star(cx + x, cy + y, r/2, r*1.25, 7 , angle)
Next
angle -= .4
radius += 1
Wend
screenswap ' update screen with new image
sangle = sangle + pi/18
Wend

sub star( x, y, rInner, rOuter, nPoints, angleOffset)
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, converted to radians in sub
' this is to allow us to spin the polygon of n sides
pAngle = RAD*(360 / nPoints)  :  radAngleOffset = RAD*(angleOffset)
x1 = x + rInner * cos(radAngleOffset)
y1 = y + rInner * sin(radAngleOffset)
for i = 0 to nPoints - 1
x2 = x + rOuter * cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * sin((i + 1) * pAngle + radAngleOffset)
line( x1, y1, x2, y2)
line( x2, y2, x3, y3)
x1 = x3 : y1 = y3
next
end sub

sub chColor()
clr = clr + 1
ink(rgb(127+127*sin(r*clr), 127+127*sin(g*clr), 127+127*sin(b*clr)))
if clr > 50000 then
r = rnd(10001)/10000 : g = rnd(10001)/10000
b = rnd(10001)/10000 : clr = 0
end if
end sub


[Peter]

BaCon code, now the version which actually draws the program to the GifDraw backend (using libGD). Again I have tried to minimize the modifications.

Also I set the animation to a speed of 80 msecs.

It will create 41 frames, because the angle increases with 41.

Code: [Select]

'Psychedelic Swirl for Naalaa [B+=MGA] 2017-03-02
'extreme modification of Rick's Swirl
'Port to BaCon by PvE at March 3, 2017

INCLUDE canvas-gd.bac       :' Use canvas with GifDraw backend (libGD)
OPTION VARTYPE float        :' Default variable type is float

sw = 600
sh = 600
sw2# = sw/2.0
sh2# = sh/2.0 - 10.0
x# = 1.0
y# = 1.0
clr# = 1.0
r# = RandomFloat#(1.0)
g# = RandomFloat#(1.0)
b# = RandomFloat#(1.0)

StartAngle# = 0.0

WINDOW("Swirl2", sw, sh)    :' Create a GIF file "Swirl2.gif" size sw x sh

SUB Redraw
    INK(0, 0, 0, 255)
    CLS
    CALL Bang
    StartAngle# = StartAngle# - 1.0
ENDSUB

FRAMES(41)                  :' Create 41 frames in the animation
CALLBACK(80, Redraw)        :' Callback function with 80 msecs delay
WAITKEY                     :' Start the generation
END

SUB Bang
    angle# = StartAngle#
    size# = 0.1
    radius# = 0.1
    ds# = 0.1
    WHILE radius# < 400.0
        x = COS( RAD(angle#) ) * radius#
        y = SIN( RAD(angle#) ) * radius#
        FOR q = size# DOWNTO 0
            CALL MakeColor
            SQUARE(sw2# + x, sh2# + y, size#/2, size#/2, TRUE)
        NEXT
        angle# = angle# + 41.0
        radius# = radius# + 1.0
        size# = size# + ds#
        ds# = ds# + 0.0001
    WEND
ENDSUB

SUB MakeColor
    clr# = clr# + 0.8
    INK(127.0 + 128.0 * SIN(r# * clr#), 127.0 + 128.0 * SIN(g# * clr#), 127.0 + 128.0 * SIN(b# * clr#), 255)
    IF clr# > 1000000.0 THEN
        r# = RandomFloat#(1.0)
        g# = RandomFloat#(1.0)
        b# = RandomFloat#(1.0)
        clr# = 0.0
    ENDIF
ENDSUB

FUNCTION RandomFloat#(maxFloat#)
    RETURN maxFloat# * RANDOM(16000) / 16000.0
ENDFUNCTION


[B+]

    Last GIF is missing the best part,

Pearl Swirl was close but these blinking squares is missing the different color patterns that form while swirling.

I hope no one gets the impression they represent the whole show. 

[B+]

Here is FB version:

Code: [Select]

'Psychedelic Star Swirl.bas for FreeBASIC [B+=MGA] 2017-03-15
'from SmallBASIC version 2017-03-01

Randomize Timer

Const As Double PI = ACos(-1)
Const As Double RAD = PI / 180
Common Shared As Double r, g, b, clr

'Set screen size here
dim as integer sw = 600, sh = 600, depth = 32
screenres sw, sh, depth, 2
WindowTitle "Psychedelic Star Swirl  -  Press esc to exit"

sub star( x As Integer, y As Integer, rInner As Double, rOuter As Double, nPoints As Integer, angleOffset As Double)
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
' this is to allow us to spin the polygon of n sides
Dim As Double pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3
Dim As Integer i
pAngle = RAD * (360 / nPoints)  :  radAngleOffset = RAD * (angleOffset)
x1 = x + rInner * cos(radAngleOffset)
y1 = y + rInner * sin(radAngleOffset)
For i = 0 to nPoints - 1
x2 = x + rOuter * cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * sin((i + 1) * pAngle + radAngleOffset)
Line (x1, y1) - (x2, y2)
Line (x2, y2) - (x3, y3)
x1 = x3 : y1 = y3
Next
end sub

sub chColor()
clr = clr + 1
Color rgb(127 + 127 * sin(r * clr), 127 + 127 * sin(g * clr), 127 + 127 * sin(b * clr))
If clr > 50000 then r = Rnd(1) : g = Rnd(1): b = Rnd(1) : clr = 0
End Sub

Dim As Integer page, notpage, rd, cx, cy
Dim As Double size, radius, angle, sangle, x, y, r2
Dim ky as String

notpage = 1 : cx = sw/2 : cy = sh/2
sangle = 0.0 : r = Rnd(1) : g = Rnd(1) : b = Rnd(1)
While ky <> Chr(27)
If page = 0 Then page = 1 ELSE page = 0   'These two lines flip the page and the
  If notpage = 1 THEN notpage = 0 ELSE notpage = 1 'backpage
  SCREENSET page, notpage 'This flips the page
 
  size = 1
  radius = .06
  angle = sangle
  cls
  While radius < 400
    x = cos(angle) * radius
    y = sin(angle) * radius
    r2 = (x ^ 2 + y ^ 2) ^ .5
    size = 4 * r2 ^ .25
    For rd = size to 1 step -10
      chColor
      star cx + x, cy + y, rd/3, rd*1.3, 7, 90
    Next
    angle -= .4
    radius += 1
  Wend

Sleep(60)
   sangle = sangle + pi/18
  ky = InKey
Wend