Author Topic: Swirl  (Read 356 times)

Rick3137

  • Sr. Member
  • ****
  • Posts: 341
  • May the Force be with You
    • View Profile
    • Rick's Programs
Swirl
« on: March 01, 2017 »
    Just a little computer art experiment.

    I was going to try an animation, but my circle command is too slow. Some day I hope to figure out another way to draw circles.

Code: [Select]
     visible:
  sw = 1200 ;
  sh = 700 ;
  sw2# = float(sw)
  sh2# = float(sh)
  x# = 1.0 ;   
  y# = 1.0 ;
  PI# = 3.14159265 ;
  pi2# = PI * 2.0 ;
  r2# = 0.0 ;
  r3# = 0.0 ;
hidden:
set redraw off
set window 0, 0, sw, sh
   proc Bang ;
   wait keydown
end
 
   procedure Bang()
radius# ;  cnt = 0
     angle# = 0.0
     StartAngle# = 0.0 
     size# = 0.1
    radius# = 0.1
    ds# = 0.1
    clr = 2
 
       while radius < 700.0 
                         x = cos( angle ) * radius
                       y = sin( angle ) * radius
                       
                       proc Circle sw2/2.0 + x, sh2/2.0 + y, size  , clr
                         proc Circle  sw2/2.0 + x, sh2/2.0 + y, size / 1.5, clr + 1
                         proc Circle  sw2/2.0 + x, sh2/2.0 + y, size / 2.0, clr + 2
                         proc Circle  sw2/2.0 + x, sh2/2.0 + y, size / 2.5, clr + 3
                     
                             angle = angle + 42.0
                             radius = radius + 1.0
                             clr = clr + 1
                             size = size + ds
                             ds = ds + 0.0001
                             if clr > 9 then clr = 2
                             redraw
          wend
          redraw
    endproc

procedure Circle(x1#,y1#,radius#,clr)
  dx# ; dy# ; angle# = 0.0
     proc MakeColor clr
     while angle < 360.1
        dy = sin(angle) * radius
        dx = cos(angle) * radius
       
        draw pixel int(x1) + int(dx),int(y1) + int(dy)
        angle = angle + 2.0
     wend
   set color 255,255,255 ;
endproc

procedure MakeColor(clr)
   
    if clr = 0 then set color 0,0,0 ;
    if clr = 1 then set color 200,100,100 ;
    if clr = 2 then set color 255,0,0 ;
    if clr = 3 then set color 150,255,0 ;
    if clr = 4 then set color 255,255,0 ;
    if clr = 5 then set color 0,255,0 ;
    if clr = 6 then set color 0,0,255 ;
    if clr = 7 then set color 255,0,255 ;
    if clr = 8 then set color 200,200,200 ;
    if clr = 9 then set color 255,255,255 ;


endproc
 

   
       
 


Mr Nutz

  • Newbie
  • *
  • Posts: 10
    • View Profile
Re: Swirl
« Reply #1 on: March 02, 2017 »
Nice !

B+

  • Full Member
  • ***
  • Posts: 215
    • View Profile
Re: Swirl
« Reply #2 on: March 02, 2017 »
Here is animation with squares:

Psychedelic Swirl:
Code: [Select]
'Psychodelic 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
« Last Edit: March 02, 2017 by B+ »
B+

B+

  • Full Member
  • ***
  • Posts: 215
    • View Profile
Re: Swirl
« Reply #3 on: March 02, 2017 »
Rick
Quote
Some day I hope to figure out another way to draw circles.

Hi Rick, we did this some time ago at this forum.

This is fastest I've seen here, but not best quality for some things. Same was posted today by Admin at SdlBasic forum with xst3 stuff, including strange var name err  :o

ref:(https://en.wikipedia.org/wiki/Midpoint_circle_algorithm)

Code: [Select]
procedure DrawCircle(x0, y0, radius) 'by mopz, oh by pixels
x = radius
y = 0
err = 0
while x >= y
draw pixel x0 + x, y0 + y
draw pixel x0 - x, y0 + y
draw pixel x0 + y, y0 + x
draw pixel x0 - y, y0 + x
draw pixel x0 - x, y0 - y
draw pixel x0 + x, y0 - y
draw pixel x0 - y, y0 - x
draw pixel x0 + y, y0 - x
y = y + 1
err = err + 1 + 2*y
if 2*(err - x) + 1 > 0
x = x - 1
err = err + 1 - 2*x
endif
wend
endproc
« Last Edit: March 02, 2017 by B+ »
B+

Rick3137

  • Sr. Member
  • ****
  • Posts: 341
  • May the Force be with You
    • View Profile
    • Rick's Programs
Re: Swirl2
« Reply #4 on: March 03, 2017 »
   Nice work, Mark.

   Replacing my circle command and making everything turn, is what I was thinking about.

   A polygon or a bit map also might work good here.  :)

Marcus

  • Administrator
  • Hero Member
  • *****
  • Posts: 542
    • View Profile
Re: Swirl
« Reply #5 on: May 05, 2017 »
Flower power  O0
.\\\opz