Superellipses/Supershapes on the fly

[docgen]

Hi everybody!

This is my first Freebasic program!

Just a simple drawing demo!

The code isn't perfect and isn't optimized.

It's all realtime calculated and realtime drawn.

You will see some rotating and shapechanging "superellipses". (100 at same time)

hit spacekey for new ellipses/shapes


Greetings
stef

EDIT: added "supershape.exe" (in "supershape.rar")

Code: [Select]

' Superellipses/Supershapes on the fly
' by stef
   
    OPTION STATIC
    OPTION EXPLICIT

   
    CONST SCREENW=800 '640
    CONST SCREENH=600 '480
    CONST MAXSHAPES=100
 
    declare sub initshapes()
    declare sub calcshapes()
    declare sub drawshapes()

    dim shared rad as single
    dim shared rot as single
    dim shared dist as single
    dim status as integer
    dim time2 as single

type tshapes
    originx as single 
    originy as single
    xradius as single
    yradius as single
    p as single
    dp as single
    rotangle as single
    drotangle as single
    col as integer
   
    posx1(36) as single
    posy1(36) as single
    rotposx as single
    rotposy as single
   
end type

    dim shared shape(MAXSHAPES) as tshapes


 
    SCREEN 19, 16, 2, 1
   
    SCREENSET 1, 0

    time2=timer

    RANDOMIZE TIMER

   

DO
   
    CLS
   
    if status = 0 then
        initshapes()
        status=1
    endif
   

    IF MULTIKEY(&h39) then
        status=0
    endif
   
    calcshapes()
 
    drawshapes()
   
    locate 1,1,0
    print "hit space"
   
    if timer-time2>0.033 then
        time2=timer
        SCREENCOPY
    endif

   
LOOP UNTIL INKEY$=CHR$(27)

sub initshapes()
    dim x as integer
   
    for x= 0 to MAXSHAPES
        shape(x).originx=Rnd*SCREENW 
        shape(x).originy=Rnd*SCREENH
        shape(x).xradius=Rnd*80+20
        shape(x).yradius=Rnd*80+20
        shape(x).p=rnd*4
        shape(x).dp=rnd*0.1
        shape(x).rotangle=Rnd*360
        shape(x).drotangle=(Rnd*2)-1
     
        shape(x).col=rgb(rnd*255,rnd*255,rnd*255)
    next
end sub

sub calcshapes()
    dim a as integer
    dim ang as integer
    dim x as single
    dim y as single
   
    for a= 0 to MAXSHAPES
     
        For ang= 0 To 36
     
            rad=ang*0.17453293 '10 * PI / 180
 
            x=Cos(rad)
            y=sin(rad)
 
            shape(a).posx1(ang)=sgn(x)*shape(a).xradius*(Abs(x)^shape(a).p)
            shape(a).posy1(ang)=sgn(y)*shape(a).yradius*(Abs(y)^shape(a).p)
 
   
            rot=atan2((shape(a).originx-(shape(a).originx+shape(a).posx1(ang))),(shape(a).originy-(shape(a).originy+shape(a).posy1(ang))))
            dist= Sqr ( (shape(a).originx-(shape(a).originx+shape(a).posx1(ang)))^2 + (shape(a).originy-(shape(a).originy+shape(a).posy1(ang)))^2 )
 
            shape(a).posx1(ang)=dist*Cos((shape(a).rotangle) * 0.17453293-rot)
            shape(a).posy1(ang)=dist*Sin((shape(a).rotangle) * 0.17453293-rot)
 
        next
 
        shape(a).rotangle=shape(a).rotangle+shape(a).drotangle
 
        shape(a).p=shape(a).p+shape(a).dp
       
        if shape(a).p> 5 then
            shape(a).dp=-shape(a).dp
        endif
   
        if shape(a).p< 0 then
            shape(a).p=0
            shape(a).dp=-shape(a).dp 
        endif
 
    next

end sub

sub drawshapes()
    dim a as integer
    dim ang as integer
 
    for a= 0 to MAXSHAPES
        For ang= 0 To 36
         
        If ang<36 then
            Line (shape(a).originx+shape(a).posx1(ang),shape(a).originy+shape(a).posy1(ang))-(shape(a).originx+shape(a).posx1(ang+1),shape(a).originy+shape(a).posy1(ang+1) ),shape(a).col
 
        endif   
         
 
        next
        paint  (shape(a).originx,shape(a).originy) ,shape(a).col,shape(a).col
     
    next
end sub
   
   



[ferris]

Great firsty!!

 

[benny!]

@stef:
Would it be possible to support an exe of your code. There are some ppl here
around who do not have freebasic installed.

[Paul]

Nice going

keep the good stuff coming

[docgen]

Hi!

Thx for replies!

Added .exe in first post!

Greetings
stef

[benny!]

@stef:
Thanks. Nice morphing kind of fx there. Runs very smooth. Good work
for your firsty. Keep it up!

[rdc]

Nicely done. This is a good candidate for the extended type syntax.

[Shockwave]

That's some fine looking elipses there Stef  I really like them, thanks for posting and +K for sharing the source too, really appreciated.

[Tetra]

Good stuff, keep it coming

[Voltage]

Nice one Stef.  Even my boss was impressed when he walked around the corner and saw me "not working".

[Clyde]

Great stuff Stef

Cheers,
Clyde.

[docgen]

Hi!

Thx to all for nice and friendly response.

Below is an experimental variation. I called it "superbird" (at least two wings on the fly! )

I'm not really familiar wit FB.
Particularly with fps setting I have problems.

The code is fast and I slowed it down with an angle-loop  from 0 to 36000  and syncing/flipping every 16ms (about fps 60)

you'll find an exe below

Greetings
stef

Code: [Select]


' Superbird on the fly
' 23.01.07
' by stef
   
    OPTION STATIC
    OPTION EXPLICIT

 

    dim ang as integer
    dim ang2 as single
    dim radang2 as single
    dim sinang2 as single
    dim cosang2 as single
    dim rad as single
    dim x as single
    dim y as single
    dim posx as single
    dim posy as single
    dim p as single
    dim q as single
   
   
    dim col_red as integer =255
    dim col_green as integer
    dim col_blue as integer
    dim colfactor as integer =1
   
   
    dim time2 as single


 
    SCREEN 19, 16, 2, 1
   
    SCREENSET 1, 0

    time2=timer

    RANDOMIZE TIMER

 
DO
   
    CLS
   
    For ang= 0 To 36000
     
            rad=ang*0.017453293
   
        x=Cos(rad)
        y=sin(rad)
 
        posx=sgn(x)*400*(Abs(x)^p)
        posy=sgn(y)*300*(Abs(y)^p)
       
       
        If (ang>45) And (ang<91) then
           
            If col_red<255 And col_blue =255 And col_green =0 Then col_red=col_red+colfactor
            If col_red=255 And col_blue >0 And col_green=0 Then col_blue=col_blue-colfactor
            If col_red=255 And col_blue =0 And col_green < 255 Then col_green=col_green+colfactor
            If col_red>0 And col_blue =0 And col_green = 255 Then col_red=col_red-colfactor
            If col_red=0 And col_blue <255 And col_green = 255 Then col_blue=col_blue+colfactor
            If col_red=0 And col_blue =255 And col_green >0 Then col_green=col_green-colfactor
           
 
              Line (360-20*cosang2,320-10*sinang2)-((400+5*cosang2)+posx,(20+5*sinang2)+posy),rgb(col_red,col_green,col_blue)
              Line (360-20*cosang2,320-10*sinang2)-((400+5*cosang2)-posx,(20+5*sinang2)+posy),rgb(col_red,col_green,col_blue)
         Endif
   
    next
   

       
   p=p+0.1*q
   If p<0.8  then
    q=1.0
p=0.8
  EndIf

    If p>=4 Then
        q=-1.0
   
    endif
   
    ang2=ang2+2
    If ang2>360 Then ang2=0
    sinang2=sin(ang2*0.017453293)
   cosang2=cos(ang2*0.017453293)
   
   
   
    if timer-time2>0.016 then  'fps 60 ??
        time2=timer
        SCREENCOPY
    endif

   
LOOP UNTIL INKEY$=CHR$(27)



[Shockwave]

That makes a really nice animation, it really does look like a bird flapping it's wings

You are going to have problems with fps setting, if you want a smooth refresh the best thing I can suggest is that you look here; http://dbfinteractive.com/index.php?cat=127

And follow the first three tutorials, it will take you through installing a new tinyptc lib by Rbraz and beginning to use some graphics commands I wrote for it.

This lib guarantees a steady refresh rate, also most of the commands I wrote for it are optimised with assembly language so you can draw things faster

[benny!]

@Steff:

Awesome. Just awesome. Especially for first steps in programming your
effects look very unique and fresh. Thats outstanding IMHO because
when most of the time ppl release their first codes it is a variation of well
known fx.

Keep up your cool ideas and work !!!