I've got rid of the operators, included the velocities in V2 (dx,dy), used the 2d segment distance (as posted above), in fact the whole thing is now 2D only, which suffices I think.
Same shape as in the other thread.
Code: Select all
Screen 19,32
Type V2
As Single x,y,dx,dy
As Integer radius
As ulong c 'colour
End Type
Type line3d
As Single v1x,v1y,v2x,v2y
End Type
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Function segment_distance(lx1 As Single, _
ly1 As Single, _
lx2 As Single, _
ly2 As Single, _
px As Single,_
py As Single, _
Byref ox As Single=0,_
Byref oy As Single=0) As Single
Dim As Single M1,M2,C1,C2,B
B=(Lx2-Lx1):If B=0 Then B=1e-20
M2=(Ly2-Ly1)/B:If M2=0 Then M2=1e-20
M1=-1/M2
C1=py-M1*px
C2=(Ly1*Lx2-Lx1*Ly2)/B
var L1=((px-lx1)*(px-lx1)+(py-ly1)*(py-ly1)),L2=((px-lx2)*(px-lx2)+(py-ly2)*(py-ly2))
var a=((lx1-lx2)*(lx1-lx2) + (ly1-ly2)*(ly1-ly2))
var a1=a+L1
var a2=a+L2
var f1=a1>L2,f2=a2>L1
If f1 Xor f2 Then
var d1=((px-Lx1)*(px-Lx1)+(py-Ly1)*(py-Ly1))
var d2=((px-Lx2)*(px-Lx2)+(py-Ly2)*(py-Ly2))
If d1<d2 Then Ox=Lx1:Oy=Ly1 : Return Sqr(d1) Else Ox=Lx2:Oy=Ly2:Return Sqr(d2)
End If
Ox=(C2-C1)/(M1-M2)
Oy=(M1*C2-M2*C1)/(M1-M2)
Return Sqr((px-Ox)*(px-Ox)+(py-Oy)*(py-Oy))
End Function
'optimize detection to save cpu.
Function DetectBallCollisions(Byref _that As V2,_this As V2) As Single
Dim As Single xdiff = _this.x-_that.x
Dim As Single ydiff = _this.y-_that.y
If Abs(xdiff) > _this.radius*2 Then Return 0
If Abs(ydiff) > _this.radius*2 Then Return 0
var L=Sqr(xdiff*xdiff+ydiff*ydiff)
If L<=_this.radius*2 Then Function=L
End Function
Sub Check_BallCollisions(points() As V2)
For n1 As Integer =Lbound(points) To Ubound(points)-1
For n2 As Integer =n1+1 To Ubound(points)
var L=DetectBallCollisions(points(n1),points(n2))
If L Then
Var impulsex=(points(n1).x-points(n2).x)/L
Var impulsey=(points(n1).y-points(n2).y)/L
'In case of overlap circles, reset to non overlap positions
points(n1).x=points(n2).x+(points(n1).radius*2)*impulsex
points(n1).y=points(n2).y+(points(n1).radius*2)*impulsey
Var impactx=points(n1).dx-points(n2).dx
Var impacty=points(n1).dy-points(n2).dy
Var dot=impactx*impulsex+impacty*impulsey
points(n1).dx-=dot*impulsex
points(n1).dy-=dot*impulsey
points(n2).dx+=dot*impulsex
points(n2).dy+=dot*impulsey
End If
Next n2
Next n1
End Sub
Sub check_ball_to_line_collisions(LN() As Line3d, ball() As V2)
For z As Integer=Lbound(ball) To Ubound(ball)
For z2 As Integer=Lbound(Ln) To Ubound(Ln)
Dim As V2 closepoint
Var seperation=segment_distance(Ln(z2).v1x,Ln(z2).v1y,Ln(z2).v2x,Ln(z2).v2y,ball(z).x,ball(z).y,closepoint.x,closepoint.y)
If seperation<=ball(z).radius Then
Var impactx=-ball(z).dx
Var impacty=-ball(z).dy
Var impulsex=(closepoint.x-ball(z).x)/seperation
Var impulsey=(closepoint.y-ball(z).y)/seperation
ball(z).x=closepoint.x-ball(z).radius*impulsex
ball(z).y=closepoint.y-ball(z).radius*impulsey
Var dv=impactx*impulsex+impacty*impulsey
ball(z).dx+= 2*dv*impulsex
ball(z).dy+= 2*dv*impulsey
End If
Next z2
Next z
End Sub
'unused here
Sub drawline(L As line3d)
Line(L.v1x,L.v1y)-(L.v2x,L.v2y),Rgb(0,0,0)
End Sub
Dim As V2 B(1 To 4) 'four balls
b(1)=Type<V2>(100,200,3,-3,20,Rgb(200,0,0))
b(2)=Type<V2>(100,250,-3,3,20,Rgb(0,100,200))
b(3)=Type<V2>(200,250,-3,-3,20,Rgb(0,100,0))
b(4)=Type<V2>(400,300,1,-1,5,Rgb(0,0,0))
Dim As V2 Tmp(1 To 15)
Redim As line3d linesegments(1 To 14)
For n As Integer=1 To 15
Read Tmp(n).x
Next n
For n As Integer=1 To 15
Read Tmp(n).y
Next n
For n As Integer=1 To 13
linesegments(n)=Type<line3d>(Tmp(n).x,Tmp(n).y,Tmp(n+1).x,Tmp(n+1).y)
Next n
'joins to enclose the shape
linesegments(14).v1x=linesegments(13).v2x
linesegments(14).v1y=linesegments(13).v2y
linesegments(14).v2x=linesegments(1).v1x
linesegments(14).v2y=linesegments(1).v1y
'screen edge
Redim Preserve linesegments(Lbound(linesegments) To Ubound(linesegments)+4)
linesegments(15)=Type<line3d>(0,0,799-20,20)
linesegments(16)=Type<line3d>(799-20,20,799,599-20)
linesegments(17)=Type<line3d>(799,599,20,599-20)
linesegments(18)=Type<line3d>(20,599-20,0,0)
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
'background image
Dim As Any Ptr im=imagecreate(800,600)
Dim As Integer max,min
For y As Integer=0 To 599
For x As Integer=0 To 799
min=10000:max=0
For n As Integer=1 To 18
var d=segment_distance(Linesegments(n).v1x,Linesegments(n).v1y,Linesegments(n).v2x,Linesegments(n).v2y,x,y)
If max<d Then max=d
If min>d Then min=d
Next n
max=max/3
var r=map(0,max,min,0,255),g=map(0,max,r,255,0),b=map(0,max,g,00,255)
If r=0 Then g=100:b=0:r=255
Pset (x,y),Rgb(r,g,b)
Next x
Next y
Get(0,0)-(799,599),im
Dim As Integer fps
Do
check_ball_to_line_collisions(Linesegments(),b())
Check_BallCollisions(b())
'move balls
For z As Integer=1 To 4
b(z).x+=b(z).dx
b(z).y+=b(z).dy
Next z
Screenlock
Cls
Put(0,0),im,Pset
Draw String(20,20),"FPS = " &fps
'draw balls
For z As Integer=1 To 4
Circle(b(z).x,b(z).y),b(z).radius,b(z).c,,,,f
Next z
Screenunlock
Sleep regulate(70,fps),1
Loop Until Len(Inkey)
imagedestroy(im)
'the line segments
X_values:
Data _
247, 409, 420, 458, 654, 569, 599, 468, 470, 408, 323, 352, 210, 398, 247
Y_values:
Data _
132, 189, 78, 215, 78, 263, 417, 295, 443, 314, 451, 297, 342, 234, 132
