Page 1 of 2

Sprite collision demos

Posted: Tue Dec 02, 2003 11:33 pm
by Psychophanta
Note: uses last sprite lib

Code: Select all

;-INITS:
#bitplanes=32:#RX=1024:#RY=768
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
  MessageRequester("Error","Can't open DirectX",0)
  End
EndIf
If OpenScreen(#RX,#RY,#bitplanes,"Balls")=0:End:EndIf
CreateSprite(0,128,128)
StartDrawing(SpriteOutput(0))
BackColor(0,0,0)
Circle(64,64,64,$1fd0de)
StopDrawing()
CreateSprite(1,32,32)
StartDrawing(SpriteOutput(1))
BackColor(0,0,0)
Circle(16,16,16,$e0ea81)
StopDrawing()
TransparentSpriteColor(0,0,0,0)
TransparentSpriteColor(1,0,0,0)
CursorCentreX.w=SpriteWidth(0)/2:CursorCentreY.w=SpriteHeight(0)/2;<-centro de Cursor
BallCentreX.w=SpriteWidth(1)/2:BallCentreY.w=SpriteHeight(1)/2;<-centro de Ball
CursorMass.f=(SpriteWidth(0)+SpriteHeight(0))/2/16;<-Sea la masa de Cursor 1/16 la media entre sus magnitudes horizontal y vertical
BallMass.f=(SpriteWidth(1)+SpriteHeight(1))/2/16;<-Sea la masa de Ball 1/16 la media entre sus magnitudes horizontal y vertical

mouseX=400:mouseY=400
BallX.f=200:BallY.f=200;<-Posición inicial de Ball
CursorX.f=mouseX:CursorY.f=mouseY
MouseLocate(mouseX,mouseY);<-Posición inicial de Cursor

;-MAIN:
Repeat
  ExamineKeyboard()
  ExamineMouse()
  ClearScreen(0,0,0)
  ; Cursor position and vector:
  prevCursorX.f=CursorX.f:prevCursorY.f=CursorY.f
  CursorX.f=MouseX():CursorY.f=MouseY()
  dirCursorX.f=CursorX.f-prevCursorX.f:dirCursorY.f=CursorY.f-prevCursorY.f
  ; Ball-Screen limits:
  If BallX.f<=-BallCentreX:dirBallX.f=Abs(dirBallX.f):EndIf
  If BallX.f+BallCentreX>=#RX:dirBallX.f=-Abs(dirBallX.f):EndIf
  If BallY.f<=-BallCentreY:dirBallY.f=Abs(dirBallY.f):EndIf
  If BallY.f+BallCentreY>=#RY:dirBallY.f=-Abs(dirBallY.f):EndIf
  ; Ball-moving
  BallX.f+dirBallX.f:BallY.f+dirBallY.f
  DisplayTransparentSprite(1,BallX.f,BallY.f)
  DisplayTransparentSprite(0,CursorX.f,CursorY.f)
  ; Ball-Cursor collision
  If SpritePixelCollision(0,CursorX.f,CursorY.f,1,BallX.f,BallY.f);Si hay colisión:
    Gosub Shock
    MouseLocate(dirCursorX+CursorX,dirCursorY+CursorY)
  EndIf
  FlipBuffers()
Until KeyboardPushed(#PB_Key_All)
CloseScreen()
End
Shock:
  CursorKinetic.f=(Pow(dirCursorX.f,2)+Pow(dirCursorY.f,2))*CursorMass.f/2;<-(m/2)*v^2 de Cursor
  BallKinetic.f=(Pow(dirBallX.f,2)+Pow(dirBallY.f,2))*BallMass.f/2;<-(m/2)*v^2 de Ball
  DiffX.f=BallX.f+BallCentreX-CursorX.f-CursorCentreX:DiffY.f=BallY.f+BallCentreY-CursorY.f-CursorCentreY
  Modulo.f=Sqr(BallKinetic.f+CursorKinetic.f)/2
  VX.f=DiffX*Modulo/Sqr(DiffX*DiffX+DiffY*DiffY)
  VY.f=DiffY*Modulo/Sqr(DiffX*DiffX+DiffY*DiffY)
  dirBallX.f+VX.f:dirBallY.f+VY.f
  dirCursorX.f-VX.f:dirCursorY.f-VY.f
Return

Code: Select all

;-INITS:
#bitplanes=32:#RX=1024:#RY=768
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
  MessageRequester("Error","Can't open DirectX",0)
  End
EndIf
If OpenScreen(#RX,#RY,#bitplanes,"Balls")=0:End:EndIf
CreateSprite(0,32,32)
StartDrawing(SpriteOutput(0))
BackColor(0,0,0)
Circle(16,16,16,$1fd0ce)
StopDrawing()
CreateSprite(1,128,128)
StartDrawing(SpriteOutput(1))
BackColor(0,0,0)
Circle(64,64,64,$c0ea51)
StopDrawing()
TransparentSpriteColor(0,0,0,0)
TransparentSpriteColor(1,0,0,0)
CursorCentreX.w=SpriteWidth(0)/2:CursorCentreY.w=SpriteHeight(0)/2;<-centro de Cursor
BallCentreX.w=SpriteWidth(1)/2:BallCentreY.w=SpriteHeight(1)/2;<-centro de Ball
CursorMass.f=(SpriteWidth(0)+SpriteHeight(0))/2/16;<-Sea la masa de Cursor 1/16 la media entre sus magnitudes horizontal y vertical
BallMass.f=(SpriteWidth(1)+SpriteHeight(1))/2/16;<-Sea la masa de Ball 1/16 la media entre sus magnitudes horizontal y vertical

mouseX=400:mouseY=400
BallX.f=200:BallY.f=200;<-Posición inicial de Ball
CursorX.f=mouseX:CursorY.f=mouseY
MouseLocate(mouseX,mouseY);<-Posición inicial de Cursor

;-MAIN:
Repeat
  ExamineKeyboard()
  ExamineMouse()
  ClearScreen(0,0,0)
  ; Cursor position and vector:
  prevmouseX=mouseX:prevmouseY=mouseY
  mouseX=MouseX():mouseY=MouseY()
  If mouseX<>prevmouseX Or mouseY<>prevmouseY
    dirCursorX.f=mouseX-prevmouseX:dirCursorY.f=mouseY-prevmouseY;<-vector director del movimiento de Cursor
    mouseX=CursorX.f+dirCursorX.f:mouseY=CursorY.f+dirCursorY.f
    MouseLocate(mouseX,mouseY)
  EndIf
  CursorX.f+dirCursorX.f:CursorY.f+dirCursorY.f
  If CursorX.f<=-CursorCentreX:dirCursorX.f=Abs(dirCursorX.f):EndIf
  If CursorX.f+CursorCentreX>=#RX:dirCursorX.f=-Abs(dirCursorX.f):EndIf
  If CursorY.f<=-CursorCentreY:dirCursorY.f=Abs(dirCursorY.f):EndIf
  If CursorY.f+CursorCentreY>=#RY:dirCursorY.f=-Abs(dirCursorY.f):EndIf
  ; Ball-Screen limits:
  If BallX.f<=-BallCentreX:dirBallX.f=Abs(dirBallX.f):EndIf
  If BallX.f+BallCentreX>=#RX:dirBallX.f=-Abs(dirBallX.f):EndIf
  If BallY.f<=-BallCentreY:dirBallY.f=Abs(dirBallY.f):EndIf
  If BallY.f+BallCentreY>=#RY:dirBallY.f=-Abs(dirBallY.f):EndIf
  ; Ball-moving
  BallX.f+dirBallX.f:BallY.f+dirBallY.f
  DisplayTransparentSprite(1,BallX.f,BallY.f)
  DisplayTransparentSprite(0,CursorX.f,CursorY.f)
  ; Ball-Cursor collision
  If SpritePixelCollision(0,CursorX.f,CursorY.f,1,BallX.f,BallY.f);Si hay colisión:
    Gosub Shock
  EndIf
  FlipBuffers()
Until KeyboardPushed(#PB_Key_All)
CloseScreen()
End
Shock:
  CursorKinetic.f=(Pow(dirCursorX,2)+Pow(dirCursorY,2))*CursorMass/2;<-(m/2)*v^2 de Cursor
  BallKinetic.f=(Pow(dirBallX,2)+Pow(dirBallY,2))*BallMass/2;<-(m/2)*v^2 de Ball
  DiffX.f=BallX.f+BallCentreX-CursorX.f-CursorCentreX:DiffY.f=BallY.f+BallCentreY-CursorY.f-CursorCentreY;<-rectángulo que forman las posiciones de los colisionantes
  Modulo.f=CursorKinetic.f/Sqr(Pow(CursorKinetic.f,2)+Pow(BallKinetic.f,2))
  Gosub get
  dirBallX.f+VX.f:dirBallY.f+VY.f
  Modulo.f=BallKinetic.f/Sqr(Pow(CursorKinetic.f,2)+Pow(BallKinetic.f,2))
  Gosub get
  dirCursorX.f-VX.f:dirCursorY.f-VY.f
Return
get:
  VX.f=DiffX*Modulo/Sqr(DiffX*DiffX+DiffY*DiffY)
  VY.f=DiffY*Modulo/Sqr(DiffX*DiffX+DiffY*DiffY)
Return
In this last one move mouse to use the small ball to hit the big one, and if you left kept still the mouse, you will see how 2 only objects in a small space, generate a virtual chaotic world (You can left it during hours and can't watch a repeated sequence).
Should be nice as screensaver.
Note that when collide, a sprite mount over the other to virtually absorb kinetics and maintain on screen always the same movement amount (even in this demo that's not made as in natural world!)

Posted: Tue Dec 09, 2003 8:42 pm
by Psychophanta
A bit more of chaos:

Code: Select all

;-INITS:
#bitplanes=32:#RX=1024:#RY=768
#BallsType1=63;<-Objects per line
#lines=1
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
  MessageRequester("Error","Can't open DirectX",0)
  End
EndIf
Structure balls
  sprite.w;<-#Sprite
  x.f:y.f;<-coordenadas instantáneas
  dirX.f:dirY.f;<-Vector director
  CentreX.w:CentreY.w;<-centro geométrico
  Mass.f;<-masa
  Kinetic.f;<-energía cinética
EndStructure
NewList Capsule.balls():Cursor.balls
;-FUNCTIONS:
Procedure Shock(*a.balls)
  DiffX.f=Capsule()\x+Capsule()\CentreX-*a\x-*a\CentreX:DiffY.f=Capsule()\y+Capsule()\CentreY-*a\y-*a\CentreY;<-rectángulo que forman las posiciones de los colisionantes
  ;There are several possible collision-consequence vector modules:
  ;ModuloObjeto1.f=Sqr(1+Pow(*a\Mass/Capsule()\Mass,2))
  ;ModuloObjeto0.f=Sqr(1+Pow(Capsule()\Mass/*a\Mass,2))
  ModuloObjeto1.f=*a\Mass/(*a\Mass+Capsule()\Mass)
  ModuloObjeto0.f=Capsule()\Mass/(*a\Mass+Capsule()\Mass)
  ;*a\Kinetic=(Pow(*a\dirX,2)+Pow(*a\dirY,2))**a\Mass/2;<-(m/2)*v^2
  ;Capsule()\Kinetic=(Pow(Capsule()\dirX,2)+Pow(Capsule()\dirY,2))*Capsule()\Mass/2;<-(m/2)*v^2
  ;ModuloObjeto1.f=*a\Kinetic/(*a\Kinetic+Capsule()\Kinetic)
  ;ModuloObjeto0.f=Capsule()\Kinetic/(*a\Kinetic+Capsule()\Kinetic)
  ;ModuloObjeto1.f=*a\Kinetic/Sqr(Pow(*a\Kinetic,2)+Pow(Capsule()\Kinetic,2))
  ;ModuloObjeto0.f=Capsule()\Kinetic/Sqr(Pow(*a\Kinetic,2)+Pow(Capsule()\Kinetic,2))
  ;...and could be more and more...
  Capsule()\dirX+DiffX*ModuloObjeto1/Sqr(DiffX*DiffX+DiffY*DiffY)
  Capsule()\dirY+DiffY*ModuloObjeto1/Sqr(DiffX*DiffX+DiffY*DiffY)
  *a\dirX-DiffX*ModuloObjeto0/Sqr(DiffX*DiffX+DiffY*DiffY)
  *a\dirY-DiffY*ModuloObjeto0/Sqr(DiffX*DiffX+DiffY*DiffY)
EndProcedure

Procedure CreateCapsuleSprite(t,c1,c2,c3)
  CreateSprite(t,16,16)
  StartDrawing(SpriteOutput(t))
  BackColor(0,0,0)
  Circle(8,8,8,c1)
  Circle(8,9,7,c2)
  Circle(7,8,6,0)
  Box(4,8,2,3,c3):Box(5,9,2,3,c3)
  Box(10,5,1,2,c3)
  StopDrawing()
EndProcedure

;-MOREINITS
If OpenScreen(#RX,#RY,#bitplanes,"Space Caps")=0:End:EndIf
CreateCapsuleSprite(0,$00bece,$007d7b,$00e7f7)
Cursor\sprite=0
Cursor\CentreX=SpriteWidth(0)/2:Cursor\CentreY=SpriteHeight(0)/2
Cursor\Mass=(SpriteWidth(0)+SpriteHeight(0))/2/16
t.w=1:g.b=1
While g<=#lines
  While t<=g*#BallsType1
    CreateCapsuleSprite(t,$bd00ce,$84008c,$e700f7)
    AddElement(Capsule()):Capsule()\sprite=t
    Capsule()\CentreX=SpriteWidth(t)/2:Capsule()\CentreY=SpriteHeight(t)/2
    Capsule()\Mass=(SpriteWidth(t)+SpriteHeight(t))/2/16
    Capsule()\x=(t-(g-1)*#BallsType1)*#RX/(#BallsType1+1)-Capsule()\CentreX:Capsule()\y=g*50
    t.w+1
  Wend
  g+1
Wend
mouseX=400:mouseY=400
Cursor\x=mouseX:Cursor\y=mouseY
MouseLocate(mouseX,mouseY)

;-MAIN:
Repeat
  ExamineKeyboard()
  ExamineMouse()
  ClearScreen(0,0,0)
  ; Cursor position and vector:
  prevmouseX=mouseX:prevmouseY=mouseY;<-previous mouse coordinates
  mouseX=MouseX():mouseY=MouseY();<-current mouse coordinates
  If mouseX<>prevmouseX Or mouseY<>prevmouseY;If mouse is moved:
    Cursor\dirX=mouseX-prevmouseX:Cursor\dirY=mouseY-prevmouseY
    mouseX=Cursor\x+Cursor\dirX:mouseY=Cursor\y+Cursor\dirY
    MouseLocate(mouseX,mouseY)
  EndIf
  Cursor\x+Cursor\dirX:Cursor\y+Cursor\dirY
  ; Cursor-Screen limits:
  If Cursor\x<=-Cursor\CentreX:Cursor\dirX=Abs(Cursor\dirX):EndIf
  If Cursor\x+Cursor\CentreX>=#RX:Cursor\dirX=-Abs(Cursor\dirX):EndIf
  If Cursor\y<=-Cursor\CentreY:Cursor\dirY=Abs(Cursor\dirY):EndIf
  If Cursor\y+Cursor\CentreY>=#RY:Cursor\dirY=-Abs(Cursor\dirY):EndIf
  ForEach Capsule()
  ; Capsule-Screen limits:
    If Capsule()\x<=-Capsule()\CentreX:Capsule()\dirX=Abs(Capsule()\dirX):EndIf
    If Capsule()\x+Capsule()\CentreX>=#RX:Capsule()\dirX=-Abs(Capsule()\dirX):EndIf
    If Capsule()\y<=-Capsule()\CentreY:Capsule()\dirY=Abs(Capsule()\dirY):EndIf
    If Capsule()\y+Capsule()\CentreY>=#RY:Capsule()\dirY=-Abs(Capsule()\dirY):EndIf
  ; Capsule-moving:
    Capsule()\x+Capsule()\dirX:Capsule()\y+Capsule()\dirY
  ; collision:
    *i.balls=@Capsule()
    While NextElement(Capsule())
      If SpritePixelCollision(*i\sprite,*i\x,*i\y,Capsule()\sprite,Capsule()\x,Capsule()\y)
        Shock(*i)
      EndIf
    Wend
    ChangeCurrentElement(Capsule(),*i)
    If SpritePixelCollision(Cursor\sprite,Cursor\x,Cursor\y,Capsule()\sprite,Capsule()\x,Capsule()\y)
      Shock(@Cursor)
    EndIf
    DisplayTransparentSprite(Capsule()\sprite,Capsule()\x,Capsule()\y)
  Next
  DisplayTransparentSprite(Cursor\sprite,Cursor\x,Cursor\y)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_All)
CloseScreen()
End


Posted: Wed Dec 10, 2003 9:37 am
by benny
Yup,
the last one looks very funny !
Good work, 8)

Posted: Wed Dec 10, 2003 9:52 am
by WolfgangS
Psychophanta wrote:A bit more of chaos:
Nice :D

Posted: Wed Dec 10, 2003 10:43 am
by Fred
Excellent :)

Posted: Wed Dec 10, 2003 2:50 pm
by dige
wow, just 2 code lines far from a nice billiard game ;-)

dige

Posted: Fri Jan 09, 2004 4:51 pm
by Psychophanta
For real objects elastic collision emulation (billiards, pinball...) this formule is the one which must be used:
(I've had there in Amiga BlitzBasic2, and i've translated to PB)

Code: Select all

;   This example shows the way to make a "perfect elastic collision" between 2 spheric (with masses
;centre same as geometrical centre) objects in the emptyness (no rub).
;Perfect elastic collision in a closed system (closed system means no external forces but only the
;two ones of the both colliding objects forces) mean no lossing kinetic energy from the closed system.
;It is ideal, because in the reality there are always a kinetic energy lossing in rub, deformation, rotation,
;heat, etc.
;   NOTE: you can add external forces (like gravities between objects, or absolute to all system)
;playing with dirX and dirY parameters.

;         2003-12-25 (Psychophanta) (translated and updated from Amiga BlitzBasic2)

;-INITS:
#bitplanes=32:#RX=1024:#RY=768:#PI=3.14159265
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
  MessageRequester("Error","Can't open DirectX",0)
  End
EndIf
If OpenScreen(#RX,#RY,#bitplanes,"Balls")=0:End:EndIf
CreateSprite(0,100,100)
StartDrawing(SpriteOutput(0))
BackColor(0,0,0)
For t.l=50 To 1 Step -1:Circle(50,50,t,RGB(220-t*2,220-t*2,220-t*2)):Next
StopDrawing()
CreateSprite(1,128,128)
StartDrawing(SpriteOutput(1))
BackColor(0,0,0)
For t.l=64 To 1 Step -1:Circle(64,64,t,RGB(200-t*2,240-t*2,240-t*2)):Next
StopDrawing()
TransparentSpriteColor(0,0,0,0)
TransparentSpriteColor(1,0,0,0)
CursorCentreX.w=SpriteWidth(0)/2:CursorCentreY.w=SpriteHeight(0)/2;<-centro de Cursor
BallCentreX.w=SpriteWidth(1)/2:BallCentreY.w=SpriteHeight(1)/2;<-centro de Ball
CursorDimension.w=(SpriteWidth(0)+SpriteHeight(0))/2
BallDimension.w=(SpriteWidth(1)+SpriteHeight(1))/2
CursorMass.f=4*#PI*Pow(CursorDimension.w/2,3)/3;<-masa de Cursor
BallMass.f=4*#PI*Pow(BallDimension.w/2,3)/3;<-masa de Ball

mouseX=Random(#RX):mouseY=Random(#RY);<-Posición inicial de Cursor
BallX.f=Random(#RX):BallY.f=Random(#RY);<-Posición inicial de Ball
CursorX.f=mouseX:CursorY.f=mouseY
MouseLocate(mouseX,mouseY);<-Posicionamiento del Cursor
dirCursorX.f=Random(600000)/100000+1:dirCursorY.f=Random(600000)/100000+1
dirBallX.f=Random(600000)/100000+1:dirBallY.f=Random(600000)/100000+1

;-MAIN:
Repeat
  ExamineKeyboard()
  ExamineMouse()
  ClearScreen(0,0,0)
  ; Cursor position and vector:
  prevCursorX.f=CursorX.f:prevCursorY.f=CursorY.f;<-Coordenadas anteriores de Cursor
  CursorX.f=MouseX():CursorY.f=MouseY();<-Coordenadas actuales de Cursor
  dirCursorX.f=CursorX.f-prevCursorX.f:dirCursorY.f=CursorY.f-prevCursorY.f;<-vector director del movimiento de Cursor
  ; Ball-moving
  BallX.f+dirBallX.f:BallY.f+dirBallY.f;<-Coordenadas actuales de Ball (se suma a las anteriores el vector director)
  ; Ball-Screen limits:
  If BallX.f<=-BallCentreX:dirBallX.f=Abs(dirBallX.f):EndIf
  If BallX.f+BallCentreX>=#RX:dirBallX.f=-Abs(dirBallX.f):EndIf
  If BallY.f<=-BallCentreY:dirBallY.f=Abs(dirBallY.f):EndIf
  dirBallY.f+0.1;<-----------------gravity force to down
  If BallY.f+BallCentreY>=#RY:dirBallY.f=-Abs(dirBallY.f)+0.1:EndIf;<---------bounce
  ; Ball-Cursor collision
  If SpritePixelCollision(0,CursorX.f,CursorY.f,1,BallX.f,BallY.f);Si hay colisión:
    Gosub Shock
    ;Reposicionamos el cursor:
    CursorX.f+dirCursorX.f:CursorY.f+dirCursorY.f
    Gosub PreserveDistance
    MouseLocate(CursorX.f,CursorY.f)
  EndIf
  DisplayTransparentSprite(1,BallX.f,BallY.f)
  DisplayTransparentSprite(0,CursorX.f,CursorY.f)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_All)
CloseScreen()
End
;-SUBROUTINES:
Shock:
;*;al momento de chocar tenemos:
  ;ENTRADAS: Vectores directores de los movimientos ((dirCursorX,dirCursorY) y (dirBallX,dirBallY))
  ;          Masas de Ball y de Cursor (CursorMass y BallMass)
;*;Debemos calcular:
  ;SALIDAS: Nuevo vector director de los movimientos de Ball y de Cursor ((dirCursorX,dirCursorY) y (dirBallX,dirBallY)).
  
;*;COMPONENTES POR CONTACTO:
  ;Es un vector que está en la línea de choque (recta normal a la recta tangente, en el punto de contacto, sobre la superficie contra la que se choca).
  ;Obtenemos su sentido y dirección, que viene marcado por la diferencia de coordenadas de cada objeto al momento de chocar:
  DiffX.f=BallX.f+BallCentreX-CursorX.f-CursorCentreX:DiffY.f=BallY.f+BallCentreY-CursorY.f-CursorCentreY;<-Vector de contacto Cursor->Ball
  ;su módulo depende de la componente de la cantidad de movimiento con respecto a la linea de choque (DiffX,DiffY) (proyección del vector (dirX,dirY) sobre el (DiffX,DiffY)):
  K.f=(DiffX.f*dirCursorX.f+DiffY.f*dirCursorY.f)/(DiffX.f*DiffX.f+DiffY.f*DiffY.f);<-constante de proyección del actual vector del movimiento de Cursor sobre la línea de choque
  dirCursorXK.f=K.f*DiffX.f:dirCursorYK.f=K.f*DiffY.f;<-vector componente en línea de choque de la velocidad de Cursor.

  K.f=(-DiffX.f*dirBallX.f-DiffY.f*dirBallY.f)/(-DiffX.f*-DiffX.f+-DiffY.f*-DiffY.f);<-constante de proyección del actual vector del movimiento de Ball sobre la línea de choque.
  dirBallXK.f=K.f*-DiffX.f:dirBallYK.f=K.f*-DiffY.f;<-vector componente en línea de choque de la velocidad de Ball.

  CX.f=(2*BallMass.f*dirBallXK.f+CursorMass.f*dirCursorXK.f-BallMass.f*dirCursorXK.f)/(CursorMass.f+BallMass.f)
  CY.f=(2*BallMass.f*dirBallYK.f+CursorMass.f*dirCursorYK.f-BallMass.f*dirCursorYK.f)/(CursorMass.f+BallMass.f)
  BX.f=(2*CursorMass.f*dirCursorXK.f+BallMass.f*dirBallXK.f-CursorMass.f*dirBallXK.f)/(CursorMass.f+BallMass.f)
  BY.f=(2*CursorMass.f*dirCursorYK.f+BallMass.f*dirBallYK.f-CursorMass.f*dirBallYK.f)/(CursorMass.f+BallMass.f)
  
;*;Ahora obtener el vector resultante para el movimiento de Ball:
  ;Se mantiene la componente perpendicular a la linea de choque del movimiento de Ball (componente que no afecta al choque):
  dirBallX.f-dirBallXK.f+BX.f:dirBallY.f-dirBallYK.f+BY.f;<-se suman, obteniendo el vector buscado.

;*;Finalmente obtener el vector director resultante para el movimiento de Cursor:
  ;Se mantiene la componente perpendicular a la linea de choque del movimiento de Cursor (componente que no afecta al choque):
  dirCursorX.f-dirCursorXK.f+CX.f:dirCursorY.f-dirCursorYK.f+CY.f;<-se suman, obteniendo el vector buscado.
Return
PreserveDistance:
  Distance.f=Sqr(DiffX.f*DiffX.f+DiffY.f*DiffY.f)
  Clip.f=(CursorDimension/2+BallDimension/2)-Distance.f
  If Clip.f>0:Clip.f/2
    BallX.f+DiffX.f*Clip.f/Distance.f
    BallY.f+DiffY.f*Clip.f/Distance.f
    CursorX.f-DiffX.f*Clip.f/Distance.f
    CursorY.f-DiffY.f*Clip.f/Distance.f
  EndIf
Return

Code: Select all

;   This example shows the way to make a "perfect elastic collision" between 2 spheric (with masses
;centre same as geometrical centre) objects in the emptyness (no rub).
;Perfect elastic collision in a closed system (closed system means no external forces but only the
;two ones of the both colliding objects forces) mean no lossing kinetic energy from the closed system.
;It is ideal, because in the reality there are always a kinetic energy lossing in rub, deformation, rotation,
;heat, etc.
;   NOTE: decrease #lines constant and/or number of objects if your computer is too slow.
;   NOTE2: you can add external forces (like gravities between objects, or absolute to all)
;playing with dirX and dirY parameters.

;         2003-12-25 (Psychophanta) (translated and updated from Amiga BlitzBasic2)


;-INITS:
#bitplanes=32:#RX=1024:#RY=768
#BallsDiameter=76
#lines=4
#PI=3.14159265
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
  MessageRequester("Error","Can't open DirectX",0)
  End
EndIf
Structure balls
  sprite.w;<-#Sprite
  x.f:y.f;<-coordenadas instantáneas
  dirX.f:dirY.f;<-Vector del movimiento (velocidad)
  CentreX.w:CentreY.w;<-centro geométrico
  Dimension.w
  Mass.f;<-masa
  Kinetic.f;<-energía cinética
EndStructure
NewList Capsule.balls():Cursor.balls
;-FUNCTIONS:
Procedure Shock(*a.balls)
;*;al momento de chocar tenemos:
  ;ENTRADAS: Vectores directores de los movimientos ((dirX,dirY) para Objeto0 y (dirX,dirY) para Objeto1)
  ;          Masas de Objeto1 y de Objeto0 (Objeto0 Mass y Objeto1 Mass)
;*;Debemos calcular:
  ;SALIDAS: Nuevo vector director de los movimientos de Objeto1 y de Objeto0 ((dirX,dirY) de Objeto0 y (dirX,dirY) de Objeto1).

;*;COMPONENTES POR CONTACTO:
  ;Es un vector que está en la línea de choque (recta normal a la recta tangente, en el punto de contacto, sobre la superficie contra la que se choca).
  ;Obtenemos su sentido y dirección, que viene marcado por la diferencia de coordenadas de cada objeto al momento de chocar:
  DiffX.f=Capsule()\x+Capsule()\CentreX-*a\x-*a\CentreX:DiffY.f=Capsule()\y+Capsule()\CentreY-*a\y-*a\CentreY;<-Vector de distancia
  ;su módulo depende de la componente de la velocidad con respecto a la linea de choque (DiffX,DiffY) (proyección del vector (dirX,dirY) sobre el (DiffX,DiffY)):
  K.f=(DiffX.f**a\dirX+DiffY.f**a\dirY)/(DiffX.f*DiffX.f+DiffY.f*DiffY.f);<-constante de proyección del actual vector del movimiento de Cursor sobre la línea de choque.
  dirCursorXK.f=K.f*DiffX.f:dirCursorYK.f=K.f*DiffY.f;<-vector componente en línea de choque de la velocidad de Cursor.
  
  K.f=(-DiffX.f*Capsule()\dirX-DiffY.f*Capsule()\dirY)/(-DiffX.f*-DiffX.f+-DiffY.f*-DiffY.f);<-constante de proyección del actual vector del movimiento de Ball sobre la línea de choque.
  dirBallXK.f=K.f*-DiffX.f:dirBallYK.f=K.f*-DiffY.f;<-vector componente en línea de choque de la velocidad de Ball.
  
  CX.f=(2*Capsule()\Mass*dirBallXK.f+*a\Mass*dirCursorXK.f-Capsule()\Mass*dirCursorXK.f)/(*a\Mass+Capsule()\Mass)
  CY.f=(2*Capsule()\Mass*dirBallYK.f+*a\Mass*dirCursorYK.f-Capsule()\Mass*dirCursorYK.f)/(*a\Mass+Capsule()\Mass)
  BX.f=(2**a\Mass*dirCursorXK.f+Capsule()\Mass*dirBallXK.f-*a\Mass*dirBallXK.f)/(*a\Mass+Capsule()\Mass)
  BY.f=(2**a\Mass*dirCursorYK.f+Capsule()\Mass*dirBallYK.f-*a\Mass*dirBallYK.f)/(*a\Mass+Capsule()\Mass)
  
;*;Ahora obtener el vector resultante para el movimiento de Ball:
  ;Se mantiene la componente perpendicular a la linea de choque del movimiento de Ball (componente que no afecta al choque):
  Capsule()\dirX-dirBallXK.f+BX.f:Capsule()\dirY-dirBallYK.f+BY.f;<-se suman, obteniendo el vector buscado.
  
;*;Finalmente obtener el vector director resultante para el movimiento de Cursor:
  ;Se mantiene la componente perpendicular a la linea de choque del movimiento de Cursor (componente que no afecta al choque):
  *a\dirX-dirCursorXK.f+CX.f:*a\dirY-dirCursorYK.f+CY.f;<-se suman, obteniendo el vector buscado.
  
;*;Preservar distancia:
  Distance.f=Sqr(DiffX*DiffX+DiffY*DiffY)
  Clip.f=(*a\Dimension/2+Capsule()\Dimension/2)-Distance.f
  If Clip.f>0:Clip.f/2
    Capsule()\x+DiffX.f*Clip.f/Distance.f
    Capsule()\y+DiffY.f*Clip.f/Distance.f
    *a\x-DiffX.f*Clip.f/Distance.f
    *a\y-DiffY.f*Clip.f/Distance.f
  EndIf
EndProcedure

Procedure CreateBallSprite(c.l,size.l,color.l)
  CreateSprite(c,size,size)
  StartDrawing(SpriteOutput(c))
  BackColor(0,0,0):R.w=color&$FF:G.w=color>>8&$FF:B.w=color>>16&$FF
  For t.l=size/2 To 1 Step -1
    R+160/size:G+160/size:B+160/size:If R>255:R=255:EndIf:If G>255:G=255:EndIf:If B>255:B=255:EndIf
    Circle(size/2,size/2,t,RGB(R,G,B))
  Next
  StopDrawing()
EndProcedure

;-MOREINITS:
If OpenScreen(#RX,#RY,#bitplanes,"Balls")=0:End:EndIf
Cursor\sprite=0
CreateBallSprite(Cursor\sprite,64,$009eae)
Cursor\CentreX=SpriteWidth(Cursor\sprite)/2:Cursor\CentreY=SpriteHeight(Cursor\sprite)/2;<-centro de Objeto0
Cursor\Dimension=(SpriteWidth(Cursor\sprite)+SpriteHeight(Cursor\sprite))/2
Cursor\Mass=4*#PI*Pow(Cursor\Dimension/2,3)/3;<-masa de Objeto0

t.w=1:g.b=1
BallsPerLine.w=#RX/#BallsDiameter-1;<-Número de Objeto1 por lineas
While g<=#lines
  While t<=g*BallsPerLine.w
    *prev.balls=@Capsule()
    AddElement(Capsule())
    Capsule()\sprite=t
    CreateBallSprite(Capsule()\sprite,#BallsDiameter,$6dae00)
    Capsule()\CentreX=SpriteWidth(Capsule()\sprite)/2:Capsule()\CentreY=SpriteHeight(Capsule()\sprite)/2;<-centro de Objeto1
    Capsule()\Dimension=(SpriteWidth(Capsule()\sprite)+SpriteHeight(Capsule()\sprite))/2
    Capsule()\Mass=4*#PI*Pow(Capsule()\Dimension/2,3)/3;<-masa de Objeto1
    If t%BallsPerLine.w=1:Capsule()\x=Capsule()\Dimension/2:Capsule()\y=g*50;<-Posición inicial de este Objeto1
    Else:Capsule()\x=*prev\x+*prev\Dimension/2+Capsule()\Dimension/2:Capsule()\y=g*50;<-Posición inicial de este Objeto1
    EndIf
    t.w+1
  Wend
  g.b+1
Wend
mouseX=#RX/2:mouseY=#RY*4/5
Cursor\x=mouseX:Cursor\y=mouseY
MouseLocate(mouseX,mouseY);<-Posición inicial de Objeto0
Cursor\dirX=Random(1000000)/100000-5:Cursor\dirY=-Random(4000000)/1000000+1

;-MAIN:
Repeat
  ExamineKeyboard()
  ExamineMouse()
  ClearScreen(0,0,0)
  ; Cursor position and vector:
  prevmouseX=mouseX:prevmouseY=mouseY;<-previous mouse coordinates
  mouseX=MouseX():mouseY=MouseY();<-current mouse coordinates
  If mouseX<>prevmouseX Or mouseY<>prevmouseY;If mouse is moved:
    Cursor\dirX=mouseX-prevmouseX:Cursor\dirY=mouseY-prevmouseY;<-vector director del movimiento de Cursor
    mouseX=Cursor\x+Cursor\dirX:mouseY=Cursor\y+Cursor\dirY;<-actualizamos las coordenadas del mouse
    MouseLocate(mouseX,mouseY);<-y reposicionamos el mouse en las actuales coordenadas de Cursor
  EndIf
  Cursor\x+Cursor\dirX:Cursor\y+Cursor\dirY;<-que son estas (se suma el vector director a las anteriores)
  ; Cursor-Screen limits:
  If Cursor\x<=-Cursor\CentreX:Cursor\dirX=Abs(Cursor\dirX):EndIf
  If Cursor\x+Cursor\CentreX>=#RX:Cursor\dirX=-Abs(Cursor\dirX):EndIf
  If Cursor\y<=-Cursor\CentreY:Cursor\dirY=Abs(Cursor\dirY):EndIf
  ;Cursor\dirY+0.1;<-------------Gravity to down
  If Cursor\y+Cursor\CentreY>=#RY:Cursor\dirY=-Abs(Cursor\dirY);+0.1;<----bound
  EndIf
  ForEach Capsule()
  ; Ball-Screen limits:
    If Capsule()\x<=-Capsule()\CentreX:Capsule()\dirX=Abs(Capsule()\dirX):EndIf
    If Capsule()\x+Capsule()\CentreX>=#RX:Capsule()\dirX=-Abs(Capsule()\dirX):EndIf
    If Capsule()\y<=-Capsule()\CentreY:Capsule()\dirY=Abs(Capsule()\dirY):EndIf
    ;Capsule()\dirY+0.1;<-------------Gravity to down
    If Capsule()\y+Capsule()\CentreY>=#RY:Capsule()\dirY=-Abs(Capsule()\dirY);+0.1;<----bound
    EndIf
  ; Ball-moving:
    Capsule()\x+Capsule()\dirX:Capsule()\y+Capsule()\dirY;<-Coordenadas actuales de Ball (se suma a las anteriores el vector director)

  ; collision:
    *i.balls=@Capsule()
    While NextElement(Capsule())
      If SpritePixelCollision(*i\sprite,*i\x,*i\y,Capsule()\sprite,Capsule()\x,Capsule()\y);Si hay colisión:
        Shock(*i)
      EndIf
    Wend
    ChangeCurrentElement(Capsule(),*i)
    If SpritePixelCollision(Cursor\sprite,Cursor\x,Cursor\y,Capsule()\sprite,Capsule()\x,Capsule()\y);Si hay colisión:
      Shock(@Cursor)
    EndIf
    DisplayTransparentSprite(Capsule()\sprite,Capsule()\x,Capsule()\y)
  Next
  DisplayTransparentSprite(Cursor\sprite,Cursor\x,Cursor\y)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_All)
CloseScreen()
End

Posted: Fri Jan 09, 2004 7:09 pm
by benny
@Psychophanta:

Again ... excellent work ... :D

Do you already have an working example where you tried to add some external forces (like mass -> gravity, so the balls slowly slow down and stop somewhere after a while) --> changing dirX, dirY ???

Anyway ... very impressive - thanks for sharing!

Posted: Fri Jan 09, 2004 9:18 pm
by einander
@Psychophanta:
Wow!
Buenisimos! :D

Posted: Fri Jan 09, 2004 9:37 pm
by einander
@Psychophanta:
On your last example, in structure Balls you have Kinetic defined but not used.
Is possible to implement it to add gravity?

Thanks in advance!

Posted: Fri Jan 09, 2004 11:40 pm
by Psychophanta
On your last example, in structure Balls you have Kinetic defined but not used.
Kinetics aren't needed to be known, because the lines in the Shock process are the solution equations result of resolving this equations system:
1/2(m*u^2)+1/2(M*U^2)=1/2(m*v^2)+1/2(M*V^2) <- kinetic energy conservation
m*u+M*U=m*v+M*V <- movement amount conservation
Being:
m the mass of one object
M the mass of the other object
u the initial speed of the m mass
U the initial speed of the M mass
v the final speed of the m mass (first mystery to find)
V the final speed of the M mass (the other mystery)
Is possible to implement it to add gravity?
Gravity means a force of attraction between objects, and it is so easy to add it, but you must know the distance between objects at any moment in order to calculate the instant force of attraction due to gravity, or simply add a small vector (pointing to the other object which have gravity properties) for each frame to (dirX,dirY) vector (note that the size of that small vector added must be in relation with the gravity amount of the other objects and of the own object treated).
If you mean an absolute gravity for all the system of objects (like in first example), then just try to uncomment lines 144 and 145 in 2nd example, and you can see it (don't touch the green balls with the yellow one -use mouse-) :wink: If you leaves it for a time, the system gets more and more speed, because there is added a quantity to (dirX,dirY) vector of all green objects, i.e. is added speed to the objects. Of course it is easy to maintain speed, or to slowly decrease it... :arrow:
Do you already have an working example where you tried to add some external forces (like mass -> gravity, so the balls slowly slow down and stop somewhere after a while) --> changing dirX, dirY ???
It is so easy. There are lots of ways to do that.
For example, at line 144 of 2nd example (Ball-Screen limits section), replace

Code: Select all

    ;Capsule()\dirY+0.1;<-------------Gravity to down 
    If Capsule()\y+Capsule()\CentreY>=#RY:Capsule()\dirY=-Abs(Capsule()\dirY);+0.2;<----bound 
by

Code: Select all

    Capsule()\dirY+0.1;<-------------Gravity to down 
    If Capsule()\y+Capsule()\CentreY>=#RY:Capsule()\y=#RY-Capsule()\CentreY:Capsule()\dirY=-Abs(Capsule()\dirY)+0.5;<----bound 

Posted: Sat Jan 10, 2004 9:30 pm
by benny
Psychophanta wrote: It is so easy. There are lots of ways to do that.
For example, at line 144 of 2nd example (Ball-Screen limits section), replace

Code: Select all

    ;Capsule()\dirY+0.1;<-------------Gravity to down 
    If Capsule()\y+Capsule()\CentreY>=#RY:Capsule()\dirY=-Abs(Capsule()\dirY);+0.2;<----bound 
by

Code: Select all

    Capsule()\dirY+0.1;<-------------Gravity to down 
    If Capsule()\y+Capsule()\CentreY>=#RY:Capsule()\y=#RY-Capsule()\CentreY:Capsule()\dirY=-Abs(Capsule()\dirY)+0.5;<----bound 
Thanx ...

Posted: Tue May 25, 2004 1:06 pm
by waffle
Thanks, I was working on a pool game (bumper pool) and was having troubles with collisions. Thanks psyco :)

here is a link to my bumper pool game. I plan to make it into an internet game at some point...


http://home.comcast.net/~norman.perry/Pool.zip

supports 4 players in hot seat (share same computer).
Warning: very hard to play. Please read the help text.
Source code included with zip so everyone can see psyco's code
use by me ..... with original comments too.

Posted: Sat May 29, 2004 9:56 am
by Psychophanta
Hi waffle and the others.

That's good. :wink:
Here are final updated and bug-free codes: http://perso.wanadoo.es/akloiv/ElasticCollision.zip

Rigorous mechanics simulation for the PB community

Posted: Sat Aug 12, 2006 7:35 pm
by Psychophanta
Big tip, may be i should give a link :?

This is a rigorous mechanics collision simulation.
No rub, no gravity and totally elastic collisions.

Code: Select all

Define.d
Procedure.d WrapAngle(angle.d); <- wraps a value into [-Pi,Pi] fringe
  !fldpi
  !fadd st0,st0; <- now i have 2*pi into st0
  !fld qword[p.v_angle]
  !fprem1
  !fstp st1
  ProcedureReturn
EndProcedure
Procedure.d ATan2(y.d,x.d)
  !fld qword[p.v_y]
  !fld qword[p.v_x]
  !fpatan
  ProcedureReturn
EndProcedure
Procedure CreateBallSprite(c.l,size.l,color.l)
  CreateSprite(c,size,size)
  StartDrawing(SpriteOutput(c))
  BackColor(0):R.w=color&$FF:G.w=color>>8&$FF:B.w=color>>16&$FF
  For t.l=size/2 To 1 Step -1
    R+160/size:G+160/size:B+160/size:If R>255:R=255:EndIf:If G>255:G=255:EndIf:If B>255:B=255:EndIf
    Circle(size/2,size/2,t,RGB(R,G,B))
  Next
  StopDrawing()
EndProcedure
Procedure ParticleAndBarbellShock(*results.double,l=0.1,R=0.65,W=0.91,m1=0.3411,m2=0.1411,V1=0.0,V2=0.0,K=1.0/3.0,e=1.0)
  ;l es la distancia a la que colisionan particula y barra, a medir desde el centro de esta.
  ;R es el radio de la barra (o disco, o esfera...).
  ;m1 es la masa de la particula.
  ;m2 es la masa de la barra.
  ;(V1x,V1y) es el vector velocidad de la particula antes del choque.
  ;(V2x,V2y) es el vector velocidad del centro de masas de la barra antes del choque.
  ;(V1xp,V1yp) es el vector velocidad de la partícula tras el choque.
  ;(V2xp,V2yp) es el vector velocidad del centro de masas de la barra tras el choque.
  ;W es la velocidad angular inicial de la barra
  ;Wp es la velocidad angular final de la barra
  ;e es un valor llamado "coeficiente de restitución" y es: e = -(V1p-(V2p+Wp*l))/(V1-(V2+W*l))
  ;K es un valor especifico de la geometría de la masa rotante (1/2 si es un disco rotando alrededor de su eje central y transversal; 1/3 si es una barra; etc).
  I=m2*K*R*R; <- momento de inercia
  ;Ecuaciones:
  ;m1·V1+m2·V2=m1·V1'+m2·V2'  ; <- conservación del momento lineal del sistema
  ;m1·V1·l+I·W=m1·V1'·l+I·W'  ; <- conservación del momento angular del sistema
  ;m1·V1^2+m2·V2^2+I·W^2+Q=m1·V1'^2+m2·V2'^2+I·W'^2  ; <- conservación de la energía del sistema. Q=0 para un choque completamente elástico
  ;V1'=V2'+W'·l-e·(V1-V2-W·l)
  CRV=e*(V1-V2-W*l)
  ;Incógnitas despejadas:
  Wp=(I*W*(m1+m2)+m1*m2*l*(V1-V2+CRV))/(I*(m1+m2)+m1*m2*l*l)
  V2p=(m1*V1+m2*V2-m1*Wp*l+m1*CRV)/(m1+m2)
  V1p=V2p+Wp*l-CRV
  ;
  *results\d=Wp:*results+SizeOf(double)
  *results\d=V2p:*results+SizeOf(double)
  *results\d=V1p
EndProcedure
Structure values
  omega.d
  VelocidadEfectiva0.d
  StructureUnion
    VelocidadEfectiva1.d
    VelocidadEfectiva2.d
  EndStructureUnion
EndStructure
gotvalues.values
Macro Collide(MassID)
  ;Unclip
  mass=M(0)\mass/(M(0)\mass+M(MassID#)\mass)
  Ball#MassID#x+Unclip#MassID#x.d*mass:Ball#MassID#y+Unclip#MassID#y.d*mass
  M(MassID#)\x+Unclip#MassID#x.d*mass:M(MassID#)\y+Unclip#MassID#y.d*mass
  mass=1-mass
  M(0)\x-Unclip#MassID#x.d*mass:M(0)\y-Unclip#MassID#y.d*mass
  ;
  Point#MassID#x.d=Ball#MassID#x.d+M(MassID#)\radius*DiffuX.d:Point#MassID#y.d=Ball#MassID#y.d+M(MassID#)\radius*DiffuY.d; <- vector (Eje de giro->punto de colisión)
  l=Abs(Point#MassID#x.d*-DiffuY.d+Point#MassID#y.d*DiffuX.d):l*l/(la+l)
  ;
  \VelocidadEfectiva0=(M(0)\mx*Rightvx.d+M(0)\my*Rightvy.d):\VelocidadEfectiva0=(M(0)\mx*Rightvx.d+M(0)\my*Rightvy.d); <- módulo de la componente en línea de choque de la velocidad lineal de la barra.
  \VelocidadEfectiva#MassID#=(M(MassID#)\mx*Rightvx.d+M(MassID#)\my*Rightvy.d):\VelocidadEfectiva#MassID#=(M(MassID#)\mx*Rightvx.d+M(MassID#)\my*Rightvy.d); <- componente en linea de choque de la velocidad lineal de la particula.
  M(0)\mx-\VelocidadEfectiva0*Rightvx.d:M(0)\my-\VelocidadEfectiva0*Rightvy.d; <- se deja a la barra solo con la componente de la velocidad normal a la linea de choque.
  M(MassID#)\mx-\VelocidadEfectiva#MassID#*Rightvx.d:M(MassID#)\my-\VelocidadEfectiva#MassID#*Rightvy.d; <- se deja a la partícula solo con la componente de la velocidad normal a la linea de choque.
  ;
  ;The calculation function:
  ParticleAndBarbellShock(@gotvalues.values,l,M(0)\HalfWidth,omega,M(MassID#)\mass,M(0)\mass,\VelocidadEfectiva#MassID#,\VelocidadEfectiva0)
  ;
  omega=\omega
  M(0)\mx+\VelocidadEfectiva0*Rightvx.d:M(0)\my+\VelocidadEfectiva0*Rightvy.d; <- se suma la velocidad en la linea de choque obtenida.
  M(MassID#)\mx+\VelocidadEfectiva#MassID#*Rightvx.d:M(MassID#)\my+\VelocidadEfectiva#MassID#*Rightvy.d; <- se suma la velocidad en la linea de choque obtenida.
EndMacro
Macro CollideR(MassID)
  la=M(0)\HalfWidth
  Collide(MassID#)
EndMacro
Macro CollideL(MassID)
  la=M(0)\HalfWidth
  Collide(MassID#)
EndMacro
Macro CollideU(MassID)
  la=M(0)\HalfHeight
  Collide(MassID#)
EndMacro
Macro CollideD(MassID)
  la=M(0)\HalfHeight
  Collide(MassID#)
EndMacro
Macro BallInner(MassID)
  Ball#MassID#x.d=M(MassID#)\x-M(0)\x:Ball#MassID#y.d=M(MassID#)\y-M(0)\y; <- vector centro de cápsula->bola
  Capsule#MassID#x.d=Cos(angle):Capsule#MassID#y.d=Sin(angle); <- vector Derecha de la cápsula
  Ball#MassID#rdist.d=(Ball#MassID#x*Capsule#MassID#x+Ball#MassID#y*Capsule#MassID#y); <- Proyección del vector bola sobre el vector Derecha de la cápsula
  Ball#MassID#udist.d=(Ball#MassID#x*Capsule#MassID#y+Ball#MassID#y*-Capsule#MassID#x); <- Proyección del vector bola sobre el vector Arriba de la cápsula
  If Ball#MassID#rdist>0; <- Si la bola#MassID# está a la derecha:
    If Ball#MassID#udist>0; <- Si la bola#MassID# está a la derecha y arriba:
      rdifmr=Ball#MassID#rdist-M(0)\HalfWidth+M(MassID#)\radius
      udifmr=Ball#MassID#udist-M(0)\HalfHeight+M(MassID#)\radius
      If udifmr>0; <- Si hay colisión contra la arista de arriba:
        Rightvx.d=-Capsule#MassID#y:Rightvy.d=Capsule#MassID#x; <- este vector señala siempre el sentido de giro positivo (agujas del reloj)
        angle-Abs(omega); <- to unclip
        DiffuX.d=Capsule#MassID#y:DiffuY.d=-Capsule#MassID#x; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=-udifmr*DiffuX.d:Unclip#MassID#y.d=-udifmr*DiffuY.d
        CollideU(MassID#)
      EndIf
      If rdifmr>0; <- Si hay colisión contra la arista derecha:
        Rightvx.d=Capsule#MassID#x:Rightvy.d=Capsule#MassID#y
        angle+Abs(omega); <- to unclip
        DiffuX.d=Capsule#MassID#x:DiffuY.d=Capsule#MassID#y; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=-rdifmr*DiffuX.d:Unclip#MassID#y.d=-rdifmr*DiffuY.d
        CollideR(MassID#)
      EndIf
    Else; <- Si la bola#MassID# está a la derecha y abajo:
      rdifmr=Ball#MassID#rdist-M(0)\HalfWidth+M(MassID#)\radius
      udifmr=-Ball#MassID#udist-M(0)\HalfHeight+M(MassID#)\radius
      If udifmr>0; <- Si hay colisión contra la arista de abajo:
        Rightvx.d=-Capsule#MassID#y:Rightvy.d=Capsule#MassID#x
        angle+Abs(omega); <- to unclip
        DiffuX.d=-Capsule#MassID#y:DiffuY.d=Capsule#MassID#x; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=-udifmr*DiffuX.d:Unclip#MassID#y.d=-udifmr*DiffuY.d
        CollideD(MassID#)
      EndIf
      If rdifmr>0; <- Si hay colisión contra la arista derecha:
        Rightvx.d=-Capsule#MassID#x:Rightvy.d=-Capsule#MassID#y
        angle-Abs(omega); <- to unclip
        DiffuX.d=Capsule#MassID#x:DiffuY.d=Capsule#MassID#y; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=-rdifmr*DiffuX.d:Unclip#MassID#y.d=-rdifmr*DiffuY.d
        CollideR(MassID#)
      EndIf
    EndIf
  Else; <- Si la bola está a la izquierda:
    If Ball#MassID#udist>0; <- Si la bola está a la izquierda y arriba:
      rdifmr=-Ball#MassID#rdist-M(0)\HalfWidth+M(MassID#)\radius
      udifmr=Ball#MassID#udist-M(0)\HalfHeight+M(MassID#)\radius
      If udifmr>0; <- Si hay colisión contra la arista de arriba:
        Rightvx.d=Capsule#MassID#y:Rightvy.d=-Capsule#MassID#x
        angle+Abs(omega); <- to unclip
        DiffuX.d=Capsule#MassID#y:DiffuY.d=-Capsule#MassID#x; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=-udifmr*DiffuX.d:Unclip#MassID#y.d=-udifmr*DiffuY.d
        CollideU(MassID#)
      EndIf
      If rdifmr>0; <- Si hay colisión contra la arista izquierda:
        Rightvx.d=Capsule#MassID#x:Rightvy.d=Capsule#MassID#y
        angle-Abs(omega); <- to unclip
        DiffuX.d=-Capsule#MassID#x:DiffuY.d=-Capsule#MassID#y; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=-rdifmr*DiffuX.d:Unclip#MassID#y.d=-rdifmr*DiffuY.d
        CollideL(MassID#)
      EndIf
    Else; <- Si la bola está a la izquierda y abajo:
      rdifmr=-Ball#MassID#rdist-M(0)\HalfWidth+M(MassID#)\radius
      udifmr=-Ball#MassID#udist-M(0)\HalfHeight+M(MassID#)\radius
      If udifmr>0; <- Si hay colisión contra la arista de abajo:
        Rightvx.d=Capsule#MassID#y:Rightvy.d=-Capsule#MassID#x
        angle-Abs(omega); <- to unclip
        DiffuX.d=-Capsule#MassID#y:DiffuY.d=Capsule#MassID#x; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=-udifmr*DiffuX.d:Unclip#MassID#y.d=-udifmr*DiffuY.d
        CollideD(MassID#)
      EndIf
      If rdifmr>0; <- Si hay colisión contra la arista izquierda:
        Rightvx.d=-Capsule#MassID#x:Rightvy.d=-Capsule#MassID#y
        angle+Abs(omega); <- to unclip
        DiffuX.d=-Capsule#MassID#x:DiffuY.d=-Capsule#MassID#y; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=-rdifmr*DiffuX.d:Unclip#MassID#y.d=-rdifmr*DiffuY.d
        CollideL(MassID#)
      EndIf
    EndIf
  EndIf
EndMacro
Macro BallOuter(MassID)
  Ball#MassID#x.d=M(MassID#)\x-M(0)\x:Ball#MassID#y.d=M(MassID#)\y-M(0)\y; <- vector centro de cápsula->bola
  Capsule#MassID#x.d=Cos(angle):Capsule#MassID#y.d=Sin(angle); <- vector-unidad Derecha de la cápsula
  Ball#MassID#rdist.d=(Ball#MassID#x*Capsule#MassID#x+Ball#MassID#y*Capsule#MassID#y); <- Proyección del vector bola sobre el vector Derecha de la cápsula
  Ball#MassID#udist.d=(Ball#MassID#x*Capsule#MassID#y+Ball#MassID#y*-Capsule#MassID#x); <- Proyección del vector bola sobre el vector Arriba de la cápsula
  ;
  If Ball#MassID#rdist>=0; <- Si la bola#MassID# está a la derecha:
    If Ball#MassID#udist>=0; <- Si la bola#MassID# está a la derecha y arriba:
      rdif=Ball#MassID#rdist-M(0)\HalfWidth:rdifmr=rdif-M(MassID#)\radius
      udif=Ball#MassID#udist-M(0)\HalfHeight:udifmr=udif-M(MassID#)\radius
      If udifmr<=0 And rdif<=0; <- Si hay colisión contra alguna arista o esquina superior derecha:
        Rightvx.d=-Capsule#MassID#y:Rightvy.d=Capsule#MassID#x
        angle+Abs(omega); <- to unclip
        DiffuX.d=-Capsule#MassID#y:DiffuY.d=Capsule#MassID#x; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=udifmr*DiffuX.d:Unclip#MassID#y.d=udifmr*DiffuY.d
        CollideU(MassID#)
      ElseIf rdifmr<=0 And udif<=0; <- Si hay colisión contra la arista derecha:
        Rightvx.d=Capsule#MassID#x:Rightvy.d=Capsule#MassID#y
        angle-Abs(omega); <- to unclip
        DiffuX.d=-Capsule#MassID#x:DiffuY.d=-Capsule#MassID#y; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=rdifmr*DiffuX.d:Unclip#MassID#y.d=rdifmr*DiffuY.d
        CollideR(MassID#)
      Else:ddif=Sqr(rdif*rdif+udif*udif)-M(MassID#)\radius
        If ddif<0
          incl=ATan2(-udif,-rdif)
          DiffuX.d=Cos(incl):DiffuY.d=Sin(incl); <- Vector unidad del sentido del choque.
          Unclip#MassID#x.d=ddif*DiffuX.d:Unclip#MassID#y.d=ddif*DiffuY.d
          Rightvx.d=Capsule#MassID#x:Rightvy.d=Capsule#MassID#y
          CollideR(MassID#)
          Rightvx.d=-Capsule#MassID#y:Rightvy.d=Capsule#MassID#x
          CollideU(MassID#)
        EndIf
      EndIf
    Else; <- Si la bola#MassID# está a la derecha y abajo:
      rdif=Ball#MassID#rdist-M(0)\HalfWidth:rdifmr=rdif-M(MassID#)\radius
      udif=-Ball#MassID#udist-M(0)\HalfHeight:udifmr=udif-M(MassID#)\radius
      If udifmr<=0 And rdif<=0; <- Si hay colisión contra la arista de abajo:
        Rightvx.d=-Capsule#MassID#y:Rightvy.d=Capsule#MassID#x
        angle-Abs(omega); <- to unclip
        DiffuX.d=Capsule#MassID#y:DiffuY.d=-Capsule#MassID#x; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=udifmr*DiffuX.d:Unclip#MassID#y.d=udifmr*DiffuY.d
        CollideD(MassID#)
      ElseIf rdifmr<=0 And udif<=0; <- Si hay colisión contra la arista derecha:
        Rightvx.d=-Capsule#MassID#x:Rightvy.d=-Capsule#MassID#y
        angle+Abs(omega); <- to unclip
        DiffuX.d=-Capsule#MassID#x:DiffuY.d=-Capsule#MassID#y; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=rdifmr*DiffuX.d:Unclip#MassID#y.d=rdifmr*DiffuY.d
        CollideR(MassID#)
      Else:ddif=Sqr(rdif*rdif+udif*udif)-M(MassID#)\radius
        If ddif<0
          incl=ATan2(udif,-rdif)
          DiffuX.d=Cos(incl):DiffuY.d=Sin(incl); <- Vector unidad del sentido del choque.
          Unclip#MassID#x.d=ddif*DiffuX.d:Unclip#MassID#y.d=ddif*DiffuY.d
          Rightvx.d=-Capsule#MassID#x:Rightvy.d=-Capsule#MassID#y
          CollideR(MassID#)
          Rightvx.d=-Capsule#MassID#y:Rightvy.d=Capsule#MassID#x
          CollideD(MassID#)
        EndIf
      EndIf
    EndIf
  Else; <- Si la bola está a la izquierda:
    If Ball#MassID#udist>=0; <- Si la bola está a la izquierda y arriba:
      rdif=-Ball#MassID#rdist-M(0)\HalfWidth:rdifmr=rdif-M(MassID#)\radius
      udif=Ball#MassID#udist-M(0)\HalfHeight:udifmr=udif-M(MassID#)\radius
      If udifmr<=0 And rdif<=0; <- Si hay colisión contra la arista de arriba:
        Rightvx.d=Capsule#MassID#y:Rightvy.d=-Capsule#MassID#x
        angle-Abs(omega); <- to unclip
        DiffuX.d=-Capsule#MassID#y:DiffuY.d=Capsule#MassID#x; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=udifmr*DiffuX.d:Unclip#MassID#y.d=udifmr*DiffuY.d
        CollideU(MassID#)
      ElseIf rdifmr<=0 And udif<=0; <- Si hay colisión contra la arista izquierda:
        Rightvx.d=Capsule#MassID#x:Rightvy.d=Capsule#MassID#y
        angle+Abs(omega); <- to unclip
        DiffuX.d=Capsule#MassID#x:DiffuY.d=Capsule#MassID#y; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=rdifmr*DiffuX.d:Unclip#MassID#y.d=rdifmr*DiffuY.d
        CollideL(MassID#)
      Else:ddif=Sqr(rdif*rdif+udif*udif)-M(MassID#)\radius
        If ddif<0
          incl=ATan2(-udif,rdif)
          DiffuX.d=Cos(incl):DiffuY.d=Sin(incl); <- Vector unidad del sentido del choque.
          Unclip#MassID#x.d=ddif*DiffuX.d:Unclip#MassID#y.d=ddif*DiffuY.d
          Rightvx.d=Capsule#MassID#x:Rightvy.d=Capsule#MassID#y
          CollideL(MassID#)
          Rightvx.d=Capsule#MassID#y:Rightvy.d=-Capsule#MassID#x
          CollideU(MassID#)
        EndIf
      EndIf
    Else; <- Si la bola está a la izquierda y abajo:
      rdif=-Ball#MassID#rdist-M(0)\HalfWidth:rdifmr=rdif-M(MassID#)\radius
      udif=-Ball#MassID#udist-M(0)\HalfHeight:udifmr=udif-M(MassID#)\radius
      If udifmr<=0 And rdif<=0; <- Si hay colisión contra la arista de abajo:
        Rightvx.d=Capsule#MassID#y:Rightvy.d=-Capsule#MassID#x
        angle+Abs(omega); <- to unclip
        DiffuX.d=Capsule#MassID#y:DiffuY.d=-Capsule#MassID#x; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=udifmr*DiffuX.d:Unclip#MassID#y.d=udifmr*DiffuY.d
        CollideD(MassID#)
      ElseIf rdifmr<=0 And udif<=0; <- Si hay colisión contra la arista izquierda:
        Rightvx.d=-Capsule#MassID#x:Rightvy.d=-Capsule#MassID#y
        angle-Abs(omega); <- to unclip
        DiffuX.d=Capsule#MassID#x:DiffuY.d=Capsule#MassID#y; <- Vector unidad del sentido del choque.
        Unclip#MassID#x.d=rdifmr*DiffuX.d:Unclip#MassID#y.d=rdifmr*DiffuY.d
        CollideL(MassID#)
      Else:ddif=Sqr(rdif*rdif+udif*udif)-M(MassID#)\radius
        If ddif<0
          incl=ATan2(udif,rdif)
          DiffuX.d=Cos(incl):DiffuY.d=Sin(incl); <- Vector unidad del sentido del choque.
          Unclip#MassID#x.d=ddif*DiffuX.d:Unclip#MassID#y.d=ddif*DiffuY.d
          Rightvx.d=-Capsule#MassID#x:Rightvy.d=-Capsule#MassID#y
          CollideL(MassID#)
          Rightvx.d=Capsule#MassID#y:Rightvy.d=-Capsule#MassID#x
          CollideD(MassID#)
        EndIf
      EndIf
    EndIf
  EndIf
EndMacro
;-INITS:
#DEGTORAD=#PI/180.0:#RADTODEG=180.0/#PI
bitplanes.b=32
SCREENWIDTH.l=GetSystemMetrics_(#SM_CXSCREEN):SCREENHEIGHT.l=GetSystemMetrics_(#SM_CYSCREEN)
If InitMouse()=0 Or InitSprite()=0 Or InitSprite3D()=0 Or InitKeyboard()=0
  MessageRequester("Error","Can't access DirectX",0):End
EndIf
While OpenScreen(SCREENWIDTH,SCREENHEIGHT,bitplanes.b,"")=0
  If bitplanes.b>16:bitplanes.b-8
  ElseIf SCREENHEIGHT>600:SCREENWIDTH=800:SCREENHEIGHT=600
  ElseIf SCREENHEIGHT>480:SCREENWIDTH=640:SCREENHEIGHT=480
  ElseIf SCREENHEIGHT>400:SCREENWIDTH=640:SCREENHEIGHT=400
  ElseIf SCREENHEIGHT>240:SCREENWIDTH=320:SCREENHEIGHT=240
  ElseIf SCREENHEIGHT>200:SCREENWIDTH=320:SCREENHEIGHT=200
  Else:MessageRequester("Listen:","Can't open Screen!",0):End
  EndIf
Wend
Structure Masa
  mass.d
  x.d:y.d
  mx.d:my.d
  radius.d
  HalfWidth.d
  HalfHeight.d
EndStructure
#nummasses=3
Global Dim M.Masa(#nummasses-1)
M(0)\radius=256
M(0)\HalfWidth=M(0)\radius:M(0)\HalfHeight=M(0)\HalfWidth/3
M(1)\radius=M(0)\radius/16
M(2)\radius=M(0)\radius/8
#BallmovRadiusprop=0.9
CreateSprite(0,M(0)\radius*2,M(0)\radius*2,#PB_Sprite_Texture); <- Disco cápsula frontal
StartDrawing(SpriteOutput(0))
BackColor(0)
Box(0,M(0)\radius-M(0)\HalfHeight,M(0)\HalfWidth*2,M(0)\HalfHeight*2,$aaEE77)
For t.l=1 To M(0)\HalfHeight
  Box(t,M(0)\radius-M(0)\HalfHeight+t,M(0)\HalfWidth*2-2*t,M(0)\HalfHeight*2-2*t,$6699DD-t)
Next
StopDrawing()
CreateSprite3D(0,0):ZoomSprite3D(0,M(0)\radius*2,M(0)\radius*2)
CreateBallSprite(1,M(1)\radius*2,$BBAA44); <- particula 1
CreateBallSprite(2,M(2)\radius*2,$AA8833); <- particula 2
;
angle.d=0:angledeg.d=angle.d*#RADTODEG; <- Initial inclination
angularforce.d=0.01333; <- Initial Force Momentum
omega.d=0.0;01; <- Initial Angular speed
alpha.d=0; <- Initial Angular acceleration
;
M(0)\x=SCREENWIDTH/2:M(0)\y=SCREENHEIGHT/2;<-Posición inicial de la cápsula
M(1)\x=SCREENWIDTH/2:M(1)\y=SCREENHEIGHT/2; <- Posición inicial de la masa intracápsula1 (Ball1)
M(2)\x=SCREENWIDTH/2:M(2)\y=SCREENHEIGHT*8/9; <- Posición inicial de la masa intracápsula2 (Ball2)
M(0)\mass=40; <- Masa de la cápsula
M(1)\mass=40; <- Masa de la Ball1
M(2)\mass=40; <- Masa de la Ball2
;-MAIN:
Repeat
  ExamineKeyboard():ExamineMouse():ClearScreen($250938)
  Start3D()
  RotateSprite3D(0,angledeg.d,0);<- cápsula
  DisplaySprite3D(0,M(0)\x-M(0)\radius,M(0)\y-M(0)\radius,200); <- cápsula
  Stop3D()
  DisplayTransparentSprite(1,M(1)\x-M(1)\radius,M(1)\y-M(1)\radius); <- disco contra
  DisplayTransparentSprite(2,M(2)\x-M(2)\radius,M(2)\y-M(2)\radius); <- Ball intracápsula frontal
  ;
;   Gosub DisplayAndKeys
  ;;;;;;;;;;;;;;;;;;;;;;;Mouse buttons. If no mousebuttons are pressed, means that it leaves at dead-point
  If MouseButton(1); <- Acceleration happens to all:
    angularforce.d-1
    alpha.d=angularforce.d/(M(1)\mass*M(0)\radius*M(0)\radius+M(2)\mass*M(0)\radius*M(0)\radius)
    omega.d+alpha.d
  ElseIf MouseButton(2); <- Acceleration happens to all:
    angularforce.d+1
    alpha.d=angularforce.d/(M(1)\mass*M(0)\radius*M(0)\radius+M(2)\mass*M(0)\radius*M(0)\radius)
    omega.d+alpha.d
  EndIf
  ;Mouse move:
  mousedeltax.l=MouseDeltaX():mousedeltay.l=MouseDeltaY()
  M(2)\mx+mousedeltax.l/40:M(2)\my+mousedeltay.l/40
  ;;;;;;;;;;;;;;;;;;;;;;;Update angles:
  angle.d=WrapAngle(angle.d+omega.d):angledeg.d=angle.d*#RADTODEG
  With gotvalues
  BallOuter(2); <- particula externa
  BallInner(1); <- particula interna
  EndWith
  ;;;;;;;;;;;;;;;;;;;;;;;Actualización de las posiciones:
  M(0)\x+M(0)\mx
  M(0)\y+M(0)\my
  M(1)\x+M(1)\mx
  M(1)\y+M(1)\my
  M(2)\x+M(2)\mx
  M(2)\y+M(2)\my
  ;Screen limits:
  For t.l=0 To #nummasses-1 Step 2
    If M(t)\x<0:M(t)\mx=Abs(M(t)\mx):ElseIf M(t)\x>SCREENWIDTH:M(t)\mx=-Abs(M(t)\mx):EndIf
    If M(t)\y<0:M(t)\my=Abs(M(t)\my):ElseIf M(t)\y>SCREENHEIGHT:M(t)\my=-Abs(M(t)\my):EndIf
  Next
  ;
  If KeyboardReleased(#PB_Key_Space):While KeyboardReleased(#PB_Key_Space)=0:Delay(20):ExamineKeyboard():Wend:EndIf
  FlipBuffers():Delay(16)
Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
End
DisplayAndKeys:
  StartDrawing(ScreenOutput())
  If pos.l=0:BackColor($11cc11):FrontColor(0):Else:BackColor(0):FrontColor($11cc11):EndIf
  DrawText(0,0,"Capsule: "+Str(M(0)\mass))
  If pos.l=1:BackColor($eeddaa):FrontColor(0):Else:BackColor(0):FrontColor($eeddaa):EndIf
  DrawText(0,20,"Particle1: "+Str(M(1)\mass))
  If pos.l=2:BackColor($ddcc88):FrontColor(0):Else:BackColor(0):FrontColor($ddcc88):EndIf
  DrawText(0,40,"Particle2: "+Str(M(2)\mass))
  StopDrawing()
  ;Keys:
  If KeyboardReleased(#PB_Key_Up):pos.l-1:If pos.l<0:pos.l=0:EndIf
  ElseIf KeyboardReleased(#PB_Key_Down):pos.l+1:If pos.l>2:pos.l=2:EndIf
  ElseIf KeyboardPushed(#PB_Key_Right):M(pos.l)\mass+1
  ElseIf KeyboardPushed(#PB_Key_Left):M(pos.l)\mass-1:If M(pos.l)\mass<1:M(pos.l)\mass=1:EndIf
  EndIf
Return
here is the tech info for those curious about this: