Good Physics Library for Pinball?

External libraries (GTK, GSL, SDL, Allegro, OpenGL, etc) questions.
Post Reply
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Good Physics Library for Pinball?

Post by jepalza »

I'm working on Pinball Dreams (Amiga500) conversion using several sources like:
https://spritesmods.com/?art=pbftable&page=1
or
http://www.mycommodore64.com/2014/02/23 ... modore-64/

But I can't find a suitable (and simple) physics library for ball gravity and bounce, among all the known ones ( bullet, Chipmunk, PlutoVG, etc).
Any recommendation? or maybe an example only in FreeBasic code, without libraries.
TJF
Posts: 3809
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Good Physics Library for Pinball?

Post by TJF »

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

Re: Good Physics Library for Pinball?

Post by dodicat »

I cannot get a ball bouncing off pins very exciting at all.

Code: Select all


Screen 20,32

Dim Shared As Integer xres,yres
Screeninfo xres,yres

Type pin 
    As Single x,y,radius
    Declare Function length As Single
    Declare Function unit As pin
End Type

Type vector As pin

Function vector.length As Single
    Return Sqr(x*x+y*y)
End Function


Function vector.unit As pin
    Dim n As Single=this.length
    If n=0 Then n=1e-20
    Return Type(x/n,y/n)
End Function

Type ball
    As vector position,velocity
    As Long  radius
    As Ulong c 'colour
    As Single gravity
End Type

Type Line
    As vector v1,v2
End Type

Operator * (f As Single,v1 As vector) As vector 'scalar*
Return Type(f*v1.x,f*v1.y)
End Operator

Operator * (v1 As vector,v2 As vector) As Single 'dot product
Return v1.x*v2.x+v1.y*v2.y
End Operator

Operator -(v1 As vector,v2 As vector) As vector
Return Type(v1.x-v2.x,v1.y-v2.y)
End Operator

Operator + (v1 As vector,v2 As vector) As vector
Return Type(v1.x+v2.x,v1.y+v2.y)
End Operator

Function distance(p As vector,b As ball) As Single
    Return Sqr((p.x-b.position.x)^2 + (p.y-b.position.y)^2)
End Function

Function segment_distance(l As Line,p As vector,Byref ip As vector=Type(0,0)) As Single             
    Dim As Single M1,M2,C1,C2,B
    B=(l.v2.x-l.v1.x):If B=0 Then B=1e-20
    M2=(l.v2.y-l.v1.y)/B:If M2=0 Then M2=1e-20
    M1=-1/M2
    C1=p.y-M1*p.x
    C2=(l.v1.y*l.v2.x-l.v1.x*l.v2.y)/B
    Var L1=((p.x-l.v1.x)*(p.x-l.v1.x)+(p.y-l.v1.y)*(p.y-l.v1.y)),L2=((p.x-l.v2.x)*(p.x-l.v2.x)+(p.y-l.v2.y)*(p.y-l.v2.y))
    Var a=((l.v1.x-l.v2.x)*(l.v1.x-l.v2.x) + (l.v1.y-l.v2.y)*(l.v1.y-l.v2.y))
    Var a1=a+L1
    Var a2=a+L2
    Var f1=a1>L2,f2=a2>L1
    If f1 Xor f2 Then 
        Var d1=((p.x-l.v1.x)*(p.x-l.v1.x)+(p.y-l.v1.y)*(p.y-l.v1.y))
        Var d2=((p.x-l.v2.x)*(p.x-l.v2.x)+(p.y-l.v2.y)*(p.y-l.v2.y))
        If d1<d2 Then ip.x=l.v1.x:ip.y=l.v1.y : Return Sqr(d1) Else  ip.x=l.v2.x:ip.y=l.v2.y:Return Sqr(d2)
    End If
    Var M=M1-M2:If M=0 Then M=1e-20
    ip.x=(C2-C1)/(M1-M2)
    ip.y=(M1*C2-M2*C1)/M
    Return Sqr((p.x-ip.x)*(p.x-ip.x)+(p.y-ip.y)*(p.y-ip.y))
End Function

Sub setuppins(b() As pin,st As Long=40,k As Long=1,f As Long=0)
    Dim As Single n
    If f<>0 Then st=60
    Dim As Long flag,condition,ct=1
    For y As Long=100+100 To yres-80*2 Step st 
        k=-k
        For x As Long=40*1.45 To xres-40*2 Step st 
            ct+=1
            Redim Preserve b(1 To ct)
            If f<>0 Then n=20*(Rnd-Rnd)
            b(ct).x=x+k*st\4 + n
            b(ct).y=y+n
            b(ct).radius=3
        Next 
    Next 
    
End Sub

Sub setupballs(b() As ball)
    b(1).c=Rgb(200,0,0)
    b(1).position=Type(50+Rnd*400,15)
    b(1).radius=15+5
    b(1).velocity=Type(4*(Rnd-Rnd),-.9)
    b(1).gravity=3
End Sub

Sub setuplines(l() As Line)
    l(1)=Type( (0,yres-130),(xres/2-100,yres-20))
    l(2)=Type( (xres,yres-150),(xres/2+100,yres-20))
End Sub

Sub pinstoimage(p() As pin,i As Any Ptr)
    For z As Integer=Lbound(p) To Ubound(p)
        Circle i,(p(z).x,p(z).y),p(z).radius,Rgb(0,0,0),,,,f
    Next
End Sub

Sub moveballs(b() As ball)
    For z As Long=1 To Ubound(b)
        b(z).position+=Type(b(z).velocity.x,b(z).velocity.y+ b(z).gravity)
        Circle(b(z).position.x,b(z).position.y),.8*b(z).radius,b(z).c,,,,f
        b(z).velocity=.99*b(z).velocity
    Next z
End Sub

Sub drawlines(z() As Line,c As Ulong=Rgb(0,0,0))
    For n As Long=Lbound(z) To Ubound(z)
        Line(z(n).v1.x,z(n).v1.y)-(z(n).v2.x,z(n).v2.y),c
    Next n
End Sub


Sub collisions Overload(Ball() As ball,pn() As pin)
    For z As Long=Lbound(ball) To Ubound(ball)
        For z2 As Long=Lbound(pn) To Ubound(pn)
            Dim As vector closepoint
            Var seperation=distance(pn(z2),ball(z))
            closepoint=Type(pn(z2).x,pn(z2).y)
            If seperation<=ball(z).radius Then
                Var impact=-1*ball(z).velocity
                Var impulse=(closepoint-ball(z).position).unit
                'put ball into real physical location
                ball(z).position=closepoint-(ball(z).radius+pn(z2).radius)*impulse
                Var dv=(impact * impulse) 
                ball(z).velocity=ball(z).velocity+2*dv*impulse 
            End If
        Next z2
    Next z
End Sub

Sub collisions(Ball() As ball,Ln() As Line)
    For z As Long=Lbound(ball) To Ubound(ball)
        For z2 As Long=Lbound(Ln) To Ubound(Ln)
            Dim As vector closepoint,test
            Var seperation=segment_distance(Ln(z2),ball(z).position,closepoint)
            If seperation<=ball(z).radius Then
                Var impact=-1*ball(z).velocity
                Var impulse=(closepoint-ball(z).position).unit
                'put ball into real physical location
                ball(z).position=closepoint-(ball(z).radius)*impulse
                Var dv=(impact * impulse) 
                ball(z).velocity=ball(z).velocity+2*dv*impulse
            End If
        Next z2
    Next z
End Sub

Sub ScreenBoundaries(b() As ball)
    For n As Long=Lbound(b) To Ubound(b)
        If b(n).position.x<b(n).radius Then b(n).position.x=b(n).radius:b(n).velocity.x=-b(n).velocity.x
        If b(n).position.x>xres-b(n).radius Then b(n).position.x=xres-b(n).radius:b(n).velocity.x=-b(n).velocity.x
        If b(n).position.y<b(n).radius Then b(n).position.y=b(n).radius:b(n).velocity.y=-b(n).velocity.y
        If b(n).position.y>yres-b(n).radius Then b(n).position.y=yres-b(n).radius:b(n).velocity.y=-b(n).velocity.y
    Next n
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) 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 sleeptime
End Function


Redim As pin  p()
Dim As ball b(1 To 1)
Dim As Line l(1 To 2)
setuppins(p())
setupballs(b())
setuplines(l())
Dim As Any Ptr i=Imagecreate(xres,yres,Rgb(0,150,250))
pinstoimage(p(),i)
Dim As Long fps
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#define Redo incircle((xres\2),(yres),100,b(1).position.x,b(1).position.y) 
Dim As Long num=1
Do
    
    Screenlock
    Put(0,0),i,Pset
    drawlines(l())
    moveballs(b())
    ScreenBoundaries(b())

    draw string (10,50),"fps "& fps
    collisions(b(),p())
    collisions(b(),l())
    If Redo Then
        num+=1
        If num=4 Then num=1 
        Select Case num
        Case 1
            Line i,(0,0)-(xres,yres),Rgb(num*50,150,250),bf
            setuppins(p(),40)
            pinstoimage(p(),i)
        Case 2
            Line i,(0,0)-(xres,yres),Rgb(num*50,150,250),bf
            setuppins(p(),,0,1)
            pinstoimage(p(),i)
        Case 3
            Line i,(0,0)-(xres,yres),Rgb(num*50,150,250),bf
            setuppins(p(),40,0)
            pinstoimage(p(),i) 
        End Select
        
        b(1).position.x=50+Rnd*(xres-200)
        b(1).position.y=15
        b(1).velocity.x=10*(Rnd-Rnd)
    End If
    
    Screenunlock

    Sleep regulate(60,fps)
Loop Until Inkey=Chr(27)
imagedestroy i
Sleep

 
Post Reply