## Superellipses / Supershapes on the fly

stef
Posts: 2
Joined: Mar 31, 2007 20:01

### Superellipses / Supershapes on the fly

Hi all!

I'm new here and found a lot of interesting stuff and postings!
Thx for sharing!

Maybe these 2 (beginner) codes are interesting for somebody

Code: Select all

`' 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 singletype 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)    nextend subsub 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      nextend subsub 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         nextend sub      `

Code: Select all

`' Superbird on the fly' 23.01.07' by stef        OPTION STATIC    OPTION EXPLICIT        CONST SCREENW=800 '640                      CONST SCREENH=600 '480                          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)`
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:
Nice!!!
E.K.Virtanen
Posts: 785
Joined: May 28, 2005 9:19
Location: Finland
Both are nice ones. Loved specially second code.