Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: docgen on March 22, 2007
-
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")
' 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
-
Great firsty!!
:goodpost:
-
@stef:
Would it be possible to support an exe of your code. There are some ppl here
around who do not have freebasic installed.
-
Nice going :)
keep the good stuff coming
-
Hi!
Thx for replies! :)
Added .exe in first post!
Greetings
stef
-
@stef:
Thanks. Nice morphing kind of fx there. Runs very smooth. Good work
for your firsty. Keep it up!
-
Nicely done. This is a good candidate for the extended type syntax.
-
That's some fine looking elipses there Stef :) I really like them, thanks for posting and +K for sharing the source too, really appreciated.
-
Good stuff, keep it coming :)
-
Nice one Stef. Even my boss was impressed when he walked around the corner and saw me "not working". :)
-
Great stuff Stef :)
Cheers,
Clyde.
-
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! :D)
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
' 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)
-
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 (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 :)
-
@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 !!!