RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: B+ on March 01, 2017, 04:30:22 AM
-
'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
-
Ported it with as few modifications as possible:
'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
-
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:
' 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
-
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:
'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
(http://www.basic-converter.org/canvas/swirl.gif)
-
:-)) 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.)
-
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 (http://aty.sdsu.edu/bibliog/latex/debian/animation/browser_test.html) and here (https://en.wikipedia.org/wiki/GIF#Animated_GIF). 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
-
Rick posted a different inspiring Swirl at Naalaa. My mods of that one lead to this
Psychedelic Swirl:
'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
-
Here is a SmallBASIC version for comparison:
' 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.
-
And it all started at SdlBasic forum to which we contributed this version:
' 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
-
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.
'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
(http://basic-converter.org/canvas/swirl2.gif)
-
:-\ 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. ;)
-
Here is FB version:
'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