Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Deleter on August 12, 2007
-
I felt bad posting requests here and not giving anything back really, so here is a small graphical effect just using fbgfx. It uses the latest version of fb, so I've included an exe. I'm not really that great at graphics stuff so go easy ;).
http://deleter.phatcode.net/smpfx.rar (http://deleter.phatcode.net/smpfx.rar)
Here's the code:
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'* Constants and basic stuff *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
const sX=640,sY=480
const pi=3.1415926
const numpoints=5
enum see
cX
cY
end enum
type coord
as integer x,y
end type
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'* Interpolation subs *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
function LinearInterpolate(pts() as coord,it as double,bla as see) as integer
if bla=cX then
return int(pts(0).x*(1-it) + pts(ubound(pts)).x*it)
else
return int(pts(0).y*(1-it) + pts(ubound(pts)).y*it)
end if
end function
function recurvBX(pts() as coord,it as double,s as integer,f as integer) as double
if f-s=1 then return (1-it)*pts(s).x+it*pts(f).x
return (1-it)*recurvBX(pts(),it,s,f-1)+it*recurvBX(pts(),it,s+1,f)
end function
function recurvBY(pts() as coord,it as double,s as integer,f as integer) as double
if f-s=1 then return (1-it)*pts(s).y+it*pts(f).y
return (1-it)*recurvBY(pts(),it,s,f-1)+it*recurvBY(pts(),it,s+1,f)
end function
function BezierInterpolate(pts() as coord,it as double,bla as see) as integer
if bla=cX then
return (1-it)*recurvBX(pts(),it,0,ubound(pts)-1)+_
it*recurvBX(pts(),it,1,ubound(pts))
else
return (1-it)*recurvBY(pts(),it,0,ubound(pts)-1)+_
it*recurvBY(pts(),it,1,ubound(pts))
end if
end function
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'* Sprite Chain code *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
type SpriteChain
private:
as integer numlinks
as double across,myval
as double rawval,rv2
public:
declare constructor(numlinks as integer)
declare destructor()
declare sub Display()
declare sub Update(tm as double)
dim iop as function(c() as coord,ival as double,c as see) as integer
as coord pts(numpoints)
end type
constructor SpriteChain(numlinks as integer)
this.numlinks=numlinks
across=0
rawval=-pi/2
end constructor
destructor SpriteChain()
end destructor
sub SpriteChain.Display()
dim as integer x,y',lx=pts(0).x,ly=pts(0).y
dim as double across=this.across,add
if across>1 then across=1-(this.across-1)
if this.across>1 then add=this.across-1
for tmp as double = 1/numlinks to .99 step 1/numlinks
x=iop(pts(),tmp*across+add,cX)
y=iop(pts(),tmp*across+add,cY)
x=sX/2+abs(sX/2-x)*(myval)*sgn(x)
y=sY/2+abs(sY/2-y)*(myval)*sgn(x)
circle(x,y),13,&h00006f,,,,f
circle(x,y),10,&h00008f,,,,f
circle(x,y),7,&h0000af,,,,f
circle(x,y),4,&h0000cf,,,,f
circle(y*4/3,x*3/4),13,&h00006f,,,,f
circle(y*4/3,x*3/4),10,&h00008f,,,,f
circle(y*4/3,x*3/4),7,&h0000af,,,,f
circle(y*4/3,x*3/4),4,&h0000cf,,,,f
circle(sX-x,y),13,&h00006f,,,,f
circle(sX-x,y),10,&h00008f,,,,f
circle(sX-x,y),7,&h0000af,,,,f
circle(sX-x,y),4,&h0000cf,,,,f
circle(sX-y*4/3,x*3/4),13,&h00006f,,,,f
circle(sX-y*4/3,x*3/4),10,&h00008f,,,,f
circle(sX-y*4/3,x*3/4),7,&h0000af,,,,f
circle(sX-y*4/3,x*3/4),4,&h0000cf,,,,f
circle(x,sY-y),13,&h00006f,,,,f
circle(x,sY-y),10,&h00008f,,,,f
circle(x,sY-y),7,&h0000af,,,,f
circle(x,sY-y),4,&h0000cf,,,,f
circle(y*4/3,sY-x*3/4),13,&h00006f,,,,f
circle(y*4/3,sY-x*3/4),10,&h00008f,,,,f
circle(y*4/3,sY-x*3/4),7,&h0000af,,,,f
circle(y*4/3,sY-x*3/4),4,&h0000cf,,,,f
circle(sX-x,sY-y),13,&h00006f,,,,f
circle(sX-x,sY-y),10,&h00008f,,,,f
circle(sX-x,sY-y),7,&h0000af,,,,f
circle(sX-x,sY-y),4,&h0000cf,,,,f
circle(sX-y*4/3,sY-x*3/4),13,&h00006f,,,,f
circle(sX-y*4/3,sY-x*3/4),10,&h00008f,,,,f
circle(sX-y*4/3,sY-x*3/4),7,&h0000af,,,,f
circle(sX-y*4/3,sY-x*3/4),4,&h0000cf,,,,f
next
for tmp as integer = 0 to ubound(pts)
circle (pts(tmp).x,pts(tmp).y),3,&h00ff00
next
end sub
sub SpriteChain.Update(tm as double)
rawval+=tm*pi
rv2+=tm*pi/2'/4
across=sin(rawval)+1
myval=1-((sin(rv2)+1)/2)^3
end sub
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'* Main Code *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
dim as SpriteChain sc=SpriteChain(30)
'set up a test path
sc.pts(0).x=20
sc.pts(0).y=20
sc.pts(1).x=125
sc.pts(1).y=350
sc.pts(2).x=250
sc.pts(2).y=80
sc.pts(3).x=375
sc.pts(3).y=450
sc.pts(4).x=500
sc.pts(4).y=120
sc.pts(5).x=600
sc.pts(5).y=480
sc.iop=@LinearInterpolate
'sc.iop=@BezierInterpolate
screenres 640,480,8
dim as double myrawval,myval
dim as double tm=timer
dim as double stm=timer
do
tm=timer-tm
myrawval+=tm*17
myval=((cos(myrawval)+1)/2)
for tmp as integer = 0 to 255
palette tmp,0,tmp*(1-myval),tmp*myval
next
sc.Update(tm)
tm=timer
if timer-stm> 1*4.5*2 then sc.iop=@BezierInterpolate'-pi/2+pi*2*2
screenlock
cls
sc.Display()
screenunlock
sleep 5,1
loop until multikey(1)
sleep
-
Hmm, and another one as well
const screenx=320
const screeny=240
screenres screenx,screeny,8
randomize 42
dim as ubyte col
screenlock
for tmp as integer = 0 to 127
palette tmp,tmp*2
palette 255-tmp,tmp*2
next
for tmpx as integer=0 to screenx-1 step 2
for tmpy as integer = 0 to screeny-1 step 2
pset(tmpx,tmpy),int(rnd*255)
next
next
color 250
for tmp as integer = screenx/16 to screenx/16+screenx/32 step 2
circle (screenx/2,screeny/2),tmp,255
circle (screenx/2,screeny/2),tmp*2,255
circle (screenx/2,screeny/2),tmp*3,255
circle (screenx/2,screeny/2),tmp*4,255
next
draw string (screenx/2-len("deleter")*4,screeny/2-4),"DELETER",255
screenunlock
'dim as single primary=.3,secondary=.6/4,tertiary=.1/4
dim as single primary=.2,secondary=.3/4,tertiary=.5/4
for loops as integer = 1 to 10
screenlock
draw string (screenx/2-len("deleter")*4,screeny/2-4),"DELETER",255
for tmpx as integer = 1 to screenx-2
for tmpy as integer = 1 to screeny-2
col=point(tmpx,tmpy)*primary+point(tmpx-1,tmpy)*secondary+point(tmpx+1,tmpy)*secondary+_
point(tmpx,tmpy-1)*secondary+point(tmpx,tmpy+1)*secondary+point(tmpx-1,tmpy-1)*tertiary+_
point(tmpx+1,tmpy-1)*tertiary+point(tmpx-1,tmpy+1)*tertiary+point(tmpx+1,tmpy+1)*tertiary
pset(tmpx,tmpy),col
next
next
draw string (screenx/2-len("deleter")*4,screeny/2-4),"DELETER",255
screenunlock
next
sleep
'end
dim as integer tm
do
tm=int(timer*100)
for tmp as integer = 0 to 127
palette tmp, ((tm+tmp) mod 127)*2,0,0
palette 255-tmp, ((tm+tmp) mod 127)*2,0,0
next
sleep 5,1
loop until multikey(1)
-
I wonder if effect 1 could be turned into an infinite-bob demo? Thanks for the code!
Jim
-
That's interesting code actually, it's got some nice bezier stuff in there. Thank you for posting it :) If I had a suggestion I'd only say to slow it down a little bit.
-
Deleter,
Fast code - nice effect! Im only running .15 so could only run your .exe!
Thanks for sharing the code though - I need to upgrade to .17 soon!
Drew