Code: Select all
#define CatmullRom(a,b,c,d,t) (b) + (t)*(-0.5*(a) + 0.5*(c) + (t)*((a) + -2.5*(b) + 2.0*(c) + -0.5*(d) + (t)*(-0.5*(a) + 1.5*(b) + -1.5*(c) + 0.5*(d))))
type tPoint
as single x,y
end type
type tSegment
as single x,y,l ' length
end type
type tSpline
declare sub DeletePoints()
declare function addPoint(byval x as single, byval y as single) as integer
declare sub update(img as any ptr)
declare sub show(img as any ptr)
declare function animate(t as single) as single
as integer nSegments
as tSegment ptr Segments
as integer nPoints
as tPoint ptr Points
private:
declare function addSegment(byval x as single, byval y as single) as integer
end type
sub tSpline.DeletePoints
if points then deallocate points:points=0
nPoints=0
end sub
function tSpline.addPoint(byval x as single, byval y as single) as integer
var index = nPoints : nPoints+=1
Points=reallocate(Points,nPoints*sizeof(tPoint))
Points[index].x=x
Points[index].y=y
return index
end function
function tSpline.addSegment(byval x as single, byval y as single) as integer
var index = nSegments : nSegments+=1
Segments=reallocate(Segments,nSegments*sizeof(tSegment))
Segments[index].x=x
Segments[index].y=y
Segments[index].l=0
return index
end function
' generate splinesegments from points
sub tSpline.update(img as any ptr)
const SEG_LENGHT = 10
dim as integer a,b,c,d,w,h
dim as single t,tStep,l2,distance,length,x,y,dx,dy,ox,oy,nLength
if nPoints<3 then exit sub
if segments then deallocate segments:segments=0
nSegments=0
screeninfo w,h
line img,(0,0)-(w-1,h-1),0,BF
for i as integer=0 to 1
ox=Points[1].x
oy=Points[1].y
if i=1 then addSegment(ox,oy): segments[nSegments-1].l=SEG_LENGHT
for j as integer = 0 to nPoints-1
a=j mod nPoints
b=(a+1) mod nPoints
c=(b+1) mod nPoints
d=(c+1) mod nPoints
tStep=0.0001
t=0
while t<1+tStep
x = CatmullRom(Points[a].x,Points[b].x,Points[c].x,Points[d].x,t)
y = CatmullRom(Points[a].y,Points[b].y,Points[c].y,Points[d].y,t)
if i=0 then pset img,(x,y),32+b
dx=x-ox : dy=y-oy : l2=dx*dx + dy*dy : if l2 then length+=sqr(l2)
ox=x : oy=y
if i=1 and length>=nLength then
addSegment(x,y)
segments[nSegments-1].l=nLength+(length-nLength)
length-=nLength
end if
t+=tStep
wend
next
if i=0 then nLength=length/(SEG_LENGHT*(nPoints+1)) : length=0
next
show(img)
end sub
sub tSpline.show(img as any ptr)
dim as integer a,b,c,d
dim as single x,y,f
if nSegments<1 then exit sub
for t as single=0 to nSegments-1 step 0.01
f=frac(t)
a = t-f
b = (a+1) mod nSegments
c = (b+1) mod nSegments
d = (c+1) mod nSegments
x = CatmullRom(Segments[a].x,Segments[b].x,Segments[c].x,Segments[d].x,f)
y = CatmullRom(Segments[a].y,Segments[b].y,Segments[c].y,Segments[d].y,f)
pset (x,y),32+a mod 32
next
for i as integer=0 to nSegments-1
circle img,(Segments[i].x,Segments[i].y),2,,,,,F
next
end sub
function tSpline.animate(byval AnimTime as single) as single
dim as integer a,b,c,d
dim as single x,y,t
if nSegments<3 then return 0
t=frac(AnimTime)
a = AnimTime-t
b = (a+1) mod nSegments
c = (b+1) mod nSegments
d = (c+1) mod nSegments
x = CatmullRom(Segments[a].x,Segments[b].x,Segments[c].x,Segments[d].x,t)
y = CatmullRom(Segments[a].y,Segments[b].y,Segments[c].y,Segments[d].y,t)
circle (x,y),7,15,,,,F
return Segments[b].l
end function
CONST PI=ATN(1)*4
randomize timer
dim as tSpline spline
dim as integer iWidth,iHeight,nPoints
dim as single t,length,w,w2,h2,x,y,speed
dim as boolean bNewSpline=true
screeninfo iWidth,iHeight
iWidth-=128:iHeight-=128
screenres iWidth,iHeight,8,2
screenset 1,0
screeninfo iWidth,iHeight
var background = ImageCreate(iWidth,iHeight)
w2=iWidth/2 : h2=iHeight/2
while inkey()=""
if bNewSpline then
cls : flip
spline.DeletePoints
nPoints=3+rnd*20
for i as integer = 0 to nPoints-1
w=i/nPoints*PI*2
#if 1
x=w2+cos(w)*(100+rnd*(w2-120))
y=h2+sin(w)*(100+rnd*(h2-120))
#else
x=50+rnd*(iWidth -100)
y=50+rnd*(iHeight-100)
#endif
spline.addPoint(x,y)
next
spline.update(background)
speed=10'+rnd*9
bNewSpline=false
end if
put (0,0),background,PSET
length = spline.animate(t)
t+=1/length*speed
if t>=spline.nSegments then t-=spline.nSegments : bNewSpline=true
flip
sleep 10
wend