## Moving on random spline loops with near const speed !

Game development specific discussions.
D.J.Peters
Posts: 8169
Joined: May 28, 2005 3:28
Contact:

### Moving on random spline loops with near const speed !

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,yend typetype tSegment  as single x,y,l ' lengthend typetype 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 typesub tSpline.DeletePoints  if points then deallocate points:points=0  nPoints=0end subfunction 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 indexend 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 indexend function ' generate splinesegments from pointssub 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 subfunction 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].lend function  CONST PI=ATN(1)*4randomize timerdim as tSpline splinedim as integer iWidth,iHeight,nPointsdim as single t,length,w,w2,h2,x,y,speeddim as boolean bNewSpline=truescreeninfo iWidth,iHeightiWidth-=128:iHeight-=128screenres iWidth,iHeight,8,2screenset 1,0screeninfo iWidth,iHeightvar background = ImageCreate(iWidth,iHeight)w2=iWidth/2 : h2=iHeight/2while 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 10wend`
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: Moving on random spline loops with near const speed !

Compiler output:
Aborting due to runtime error 12 ("segmentation violation" signal)

Results:
Compilation failed
D.J.Peters
Posts: 8169
Joined: May 28, 2005 3:28
Contact:

### Re: Moving on random spline loops with near const speed !

It's simple BASIC no problems here I tested 32 and 64-bit !

What are wrong with your FreeBASIC setup ?

Joshy
jdebord
Posts: 529
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:

### Re: Moving on random spline loops with near const speed !

Works well with Windows 10 + FB 32 bits

Thanks for this nice demo !
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: Moving on random spline loops with near const speed !

D.J.Peters wrote:What are wrong with your FreeBASIC setup ?
Joshy

No idea what was wrong. Anyway I downloaded and reinstalled FreeBASIC and your program now compiles and runs.
D.J.Peters
Posts: 8169
Joined: May 28, 2005 3:28
Contact:

### Re: Moving on random spline loops with near const speed !

Code: Select all

`#if 1 ' <-- change it to 0 to see really extreme random splines  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`
dafhi
Posts: 1357
Joined: Jun 04, 2005 9:51

### Re: Moving on random spline loops with near const speed !

nice work. the movement looks organic
D.J.Peters
Posts: 8169
Joined: May 28, 2005 3:28
Contact:

### Re: Moving on random spline loops with near const speed !

Of course the speed can be made random as well.

speed = 5 + rnd*5

Joshy
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Moving on random spline loops with near const speed !

Nice.
The two Catmull Rom end points are a nuisance when closing a loop.(I find anyway)
Here is my effort, West to East but draggable, not Catmull Rom, but a particle trajectory.

Code: Select all

` Screen 20,32Dim Shared As Integer xres,yresScreeninfo xres,yresType Point    As Single x,y,zEnd TypeType particle    As Point position,velocityEnd Type#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius#define vct Type<Point>#define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))#define map(a,b,x,c,d)  ((d)-(c))*((x)-(a))/((b)-(a))+(c)Operator + (v1 As Point,v2 As Point) As PointReturn vct(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)End OperatorOperator -(v1 As Point,v2 As Point) As PointReturn vct(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)End OperatorOperator * (f As Single,v1 As Point) As Point 'scalar*pointReturn vct(f*v1.x,f*v1.y,f*v1.z)End OperatorFunction length(v As Point) As Single    Return Sqr(v.x*v.x+v.y*v.y+v.z*v.z)End FunctionFunction normalize(v As Point) As Point    Dim n As Single=length(v)    If n=0 Then n=1e-20    Return vct(v.x/n,v.y/n,v.z/n)End FunctionSub trace(In() As Point,Outarray() As Point,roundedness As Single=60)    Redim Outarray(0)    Dim As particle p:roundedness=roundedness/10    If roundedness<1 Then roundedness=1    If roundedness>100 Then roundedness=10    p.position=In(Lbound(In))    p.velocity=normalize(Type<Point>(In(Lbound(In)+1)-In(Lbound(In))))    Redim Preserve Outarray(1 To Ubound(Outarray)+1)    Outarray(Ubound(Outarray))=Type<Point>(In(Lbound(In)).x,In(Lbound(In)).y)    Dim As Point f    For n As long=Lbound(In) To Ubound(In)-1        Do            Var dist=length(p.position-In(n+1))            f=(1/(Ubound(In)))*f+normalize(In(n+1)-p.position)            p.velocity= roundedness*normalize(p.velocity+f)            p.position=p.position+p.velocity            Redim Preserve Outarray(1 To Ubound(Outarray)+1)            Outarray(Ubound(Outarray))=Type<Point>(p.position.x,p.position.y,p.position.z)            If dist<5*roundedness Then Exit Do        Loop    Next n    Redim Preserve Outarray(1 To Ubound(Outarray)+1)    Outarray(Ubound(Outarray))=Type<Point>(In(Ubound(In)).x,In(Ubound(In)).y,In(Ubound(In)).z)End SubSub drawpoints(p() As Point,col As Ulong)    For n As Long=Lbound(p) To Ubound(p)        Circle (p(n).x,p(n).y),5,col        Draw String(p(n).x-4,p(n).y),Str(n),Rgb(0,200,0)    Next nEnd SubSub DrawCurve(a() As Point,col As Ulong)    Pset(a(Lbound(a)).x,a(Lbound(a)).y)    For z As long=Lbound(a)+1 To Ubound(a)        Line -(a(z).x,a(z).y),col    Next zEnd SubSub SetUpPoints(p1() As Point,ypos As Long,range As Long)    Dim As Integer xres,yres    Screeninfo xres,yres    For n As Long=1 To Ubound(p1)         Var xpos=map(Lbound(p1),Ubound(p1),n,(-.2*xres*0),(xres+.2*xres*0))        p1(n)=Type<Point>(xpos,Intrange((ypos-range),(ypos+range)),xpos)    Next nEnd SubFunction Regulate(Byval MyFps As long,Byref fps As long=0) As long    Static As Double timervalue,lastsleeptime,t3,frames    Var t=Timer    frames+=1    If (t-t3)>=1 Then t3=t:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=T    Return sleeptimeEnd FunctionSub show(p() As Point,t() As Point,c As Point,r As Long=60)    trace(p(),t(),r)    static as single n=1    static as long fps    var k=(.01*ubound(t))/5    n+=k    if n>=ubound(t) then n=lbound(t)    Screenlock    Cls    draw string(20,30),"Options:",rgb(200,200,200)    draw string(20,50),"Drag points, slide the red ball, right click the screen",rgb(200,200,200)    draw string(20,80),"F.P.S. "&fps'str(ubound(t))+"  "+str(k)    drawcurve(t(),Rgb(0,0,255))    drawpoints(p(),Rgb(200,0,0))    Line(.25*xres,.95*yres)-(.75*xres,.95*yres+20),,b    Circle(c.x,c.y),8,Rgb(200,0,0),,,,f    circle(t(n).x,t(n).y),5,rgb(0,200,0),,,,f    Screenunlock    var q=map(5,75,r,60,30)    Sleep regulate(q,fps)End SubSub handleradius(c As Point,mx As long,my As long,b As long,Byref r As long)    Dim As long lowerx=.25*xres+10,upperx=.75*xres-10    Dim As long lowery=.95*yres,uppery=.95*yres+20    #define inbox mx>lowerx And my<upperx And my>lowery And my<uppery    If b=1 Then        If inbox Then            c.x=mx            If c.x<=lowerx Then c.x=lowerx            If c.x>=upperx Then c.x=upperx            r=map(lowerx,upperx,c.x,15,65) '75        End If    End IfEnd Sub#macro mouse(m)#define onscreen (mx>10) and (mx<xres-10) and (my>10) and (my<yres-10)Dim As Long x=mx,y=my,dx,dyWhile mb = 1    show(p(),tracer(),c,r):Sleep 1,1    Getmouse mx,my,,mb    If onscreen Then        If mx<>x Or my<>y  Then            dx = mx - x            dy = my - y            x = mx            y = my            p(m).x=x+dx            p(m).y=y+dy        End If    End IfWend#endmacro#macro refreshRedim As Point p(1 To intrange(10,20))dim as single x=map(15,65,r,(.25*xres),(.75*xres))Dim As Point c=Type(x,.95*yres+10)Redim As Point tracer()setuppoints(p(),300,intrange(50,300))trace(p(),tracer())#endmacroDim As long mx,my,mb,r=40,flagrefreshDo    Getmouse mx,my,,mb    show(p(),tracer(),c,r)    For n As Long=Lbound(p) To Ubound(p)        If incircle(p(n).x,p(n).y,10,mx,my) And mb=1 Then            mouse(n)        End If    Next    handleradius(c,mx,my,mb,r)    if mb=2 and flag=0 then        flag=1        refresh    end if    flag=mbLoop Until Len(Inkey)Sleep  `