Since there has been a great deal of interest in Ball to ball colliions, I made this after seeing Hugo Elias' mini tute.
Thanks to Antoni for the link:
Tute here:
http://freespace.virgin.net/hugo.elias/models/m_snokr.htm
QBcode I made....
'Snooker balls bouncing like they should be. ;*)
'Relsoft 2003
'thanks to: Hugo Elias for writting that lil tute. Very *vague* I mght add. ;*)
' Plasma257 for SetVideoSeg
'
'Notes: No friction is implemented as my daughter is... well, I have to cook
' her breakfast. ;*)
DECLARE SUB Normalize (nx!, ny!, X1!, Y1!, X2!, Y2!)
DECLARE FUNCTION Collide% (Ball() AS ANY)
DECLARE SUB setVideoSeg (Segment%)
DECLARE FUNCTION Dot! (ax!, ay!, bx!, by!)
DECLARE FUNCTION Rel.Angle% (X1%, Y1%, X2%, Y2%)
DEFINT A-Z
TYPE ballType
x AS SINGLE 'the x coord
y AS SINGLE
xv AS SINGLE
yv AS SINGLE
speed AS SINGLE '???
mass AS SINGLE 'the mass
angle AS INTEGER 'angle of direction
END TYPE
CONST FALSE = 0, TRUE = NOT FALSE
CONST PI = 3.141593 'wanna eat pie?
CONST FRICTION = .001
DIM SHARED Vpage(32009) AS INTEGER 'SetVideoSeg Buffer
DIM SHARED LAYER AS INTEGER
'Init
Vpage(6) = 2560 'Width 320*8
Vpage(7) = 200 'Height
LAYER = VARSEG(Vpage(0)) + 1 'Buffer Seg(Ask Plasma)
DIM balls(1) AS ballType
'Initialise balls
balls(0).x = 200
balls(0).y = 170
balls(0).xv = 0
balls(0).yv = 0
balls(0).speed = 2.6
balls(0).mass = 1.5
balls(0).angle = 218
balls(1).x = 100
balls(1).y = 80
balls(1).xv = 0
balls(1).yv = 0
balls(1).speed = 0
balls(1).mass = 2.5
balls(1).angle = 30
CLS
SCREEN 13
'Target the ball
DO
setVideoSeg LAYER 'set draw to buffer
LINE (0, 0)-(319, 199), 0, BF 'cls
FOR i% = 0 TO 1 'draw em ballz
x = balls(i%).x
y = balls(i%).y
CIRCLE (x, y), 10, i% + 5
PAINT (x, y), i% + 5
NEXT i%
tx% = COS(balls(0).angle * PI / 180) * 50 'Line of target
ty% = SIN(balls(0).angle * PI / 180) * 50
LINE (balls(0).x, balls(0).y)-(balls(0).x + tx%, balls(0).y + ty%), 15, , &HFAFA
setVideoSeg &HA000 'set draw to screen
PUT (0, 0), Vpage(6), PSET 'bit to screen
DO
K$ = INKEY$ 'get keys
LOOP UNTIL K$ <> ""
SELECT CASE K$
CASE CHR$(0) + "K" 'set angle
balls(0).angle = (balls(0).angle - 1) MOD 360
CASE CHR$(0) + "M" 'ditto
balls(0).angle = balls(0).angle + 1 MOD 360
CASE CHR$(13)
CASE ELSE
END SELECT
LOOP UNTIL K$ = CHR$(13) OR K$ = CHR$(27)
'Set initial ball vectors
balls(0).xv = COS(balls(0).angle * PI / 180) * balls(0).speed
balls(0).yv = SIN(balls(0).angle * PI / 180) * balls(0).speed
'Bouncy!!!!
DO
setVideoSeg LAYER 'set draw to buffer
LINE (0, 0)-(319, 199), 0, BF 'cls
FOR i% = 0 TO 1 'move the balls
balls(i%).x = balls(i%).x + balls(i%).xv 'x move
balls(i%).y = balls(i%).y + balls(i%).yv 'y move
'the next if then else clause checks to see if the balls are
'inside the screen of out of bounds, they bounce
IF balls(i%).x < 10 THEN
balls(i%).xv = -balls(i%).xv
ELSEIF balls(i%).x > 310 THEN
balls(i%).xv = -balls(i%).xv
ELSE
END IF
IF balls(i%).y < 10 THEN
balls(i%).yv = -balls(i%).yv
ELSEIF balls(i%).y > 190 THEN
balls(i%).yv = -balls(i%).yv
ELSE
END IF
balls(i%).xv = balls(i%).xv - balls(i%).xv * FRICTION
balls(i%).yv = balls(i%).yv - balls(i%).yv * FRICTION
x = balls(i%).x
y = balls(i%).y
CIRCLE (x, y), 10, i% + 5 'Draw the balls
PAINT (x, y), i% + 5
NEXT i%
IF Collide(balls()) = -1 THEN
GOSUB calcVectors 'The ball to ball algo
balls(0).xv = xva! 'set new velocities/vectors
balls(0).yv = yva!
balls(1).xv = xvb!
balls(1).yv = yvb!
END IF
setVideoSeg &HA000 'set draw to screen
WAIT &H3DA, 8
PUT (0, 0), Vpage(6), PSET 'pcopy
LOOP UNTIL INKEY$ <> ""
END
calcVectors:
'Notes:
'vectors: Impact,Impulse,
' balla,ballb,newa,newb
'Points: p1,p2
'Real Floats: Mass1,Mass2,Impactspeed
'Formula:
'1. Impact= balla-ballb 'vector subtaction
'2. impulse = Normalize(p1,p2) 'see normalize sub
'3. impactspeed = Dot!(impact,impulse)
'4. newimpulse=impulse*impactspeed*mass1*mass2
'5. newa=balla+newimpulse/mass1
'6. newb=ballb-newimpulse/mass2
'PS the divide by 2 is for the frictionless model. ;*)
impactx! = balls(1).xv - balls(0).xv
impacty! = balls(1).yv - balls(0).yv
Normalize impulsex!, impulsey!, balls(0).x, balls(0).y, balls(1).x, balls(1).y
impactSpeed! = Dot!(impactx!, impacty!, impulsex!, impulsey!)
impulsex! = impulsex! * impactSpeed! * balls(0).mass * balls(1).mass / 2
impulsey! = impulsey! * impactSpeed! * balls(0).mass * balls(1).mass / 2
xva! = balls(0).xv + impulsex! / balls(0).mass
yva! = balls(0).yv + impulsey! / balls(0).mass
xvb! = balls(1).xv - impulsex! / balls(1).mass
yvb! = balls(1).yv - impulsey! / balls(1).mass
RETURN
FUNCTION Collide (Ball() AS ballType)
'returns id the ball collided using the distance formula.
'can be optimized a lot!!!
Collide = 0
dx! = Ball(1).x - Ball(0).x
dy! = Ball(1).y - Ball(0).y
dist! = SQR(dx! ^ 2 + dy! ^ 2)
IF dist! <= 20 THEN
Collide = -1
END IF
END FUNCTION
FUNCTION Dot! (ax!, ay!, bx!, by!)
'returns the dot product between 2 vectors a and b.
Dot! = (ax! * bx!) + (ay! * by!)
END FUNCTION
SUB Normalize (nx!, ny!, X1!, Y1!, X2!, Y2!)
'normalizes the components of a vector derived from 2 points (x1,y1) and
'(x2,y2)
dx! = X2! - X1!
dy! = Y2! - Y1!
dist! = SQR(dx! ^ 2 + dy! ^ 2)
nx! = dx! / dist!
ny! = dy! / dist!
END SUB
FUNCTION Rel.Angle% (X1, Y1, X2, Y2)
'By RelSoft of Auraflow
'Parameters:
'x1,y1= the starting coord
'x2,y2=the target coord
'Returns=the Angle in degrees between the two coords
'useable with SIN and COS so this is useful for calculating the
'vectors between 2 points.
'This is the Fast BASIC version
'Rad=Deg*PI/180
'Rad*180=Deg*PI
'Rad*180/PI=Deg
'Deg=Rad*180/PI
IF X1 = X2 THEN
IF Y1 < Y2 THEN
Rel.Angle% = 90
EXIT FUNCTION
ELSEIF Y1 > Y2 THEN
Rel.Angle% = 270
EXIT FUNCTION
ELSE
Rel.Angle% = 0
EXIT FUNCTION
END IF
ELSE
deltaX = X2 - X1
deltaY = Y2 - Y1
angleTemp% = ATN(deltaY / deltaX) * 180 / 3.141593
angleTemp% = Angletemp% + 90
IF X1 > X2 THEN
Angletemp% = Angletemp% + 180
END IF
END IF
Angletemp% = Angletemp% - 90
IF Angletemp% < 0 THEN Angletemp% = Angletemp% + 360
Rel.Angle% = Angletemp%
END FUNCTION
SUB setVideoSeg (Segment) STATIC
'Amazing sub by Plasma357
DEF SEG
IF videoAddrOff& = 0 THEN ' First time the sub is called
' We need to find the location of b$AddrC, which holds the graphics
' offset (b$OffC) and segment (b$SegC). Since b$AddrC is in the default
' segment, we can find it by setting it to a certain value, and then
' searching for that value.
SCREEN 13 ' Set b$SegC to A000 (00A0 in memory)
PSET (160, 100), 0 ' Set b$OffC to 7DA0 (not needed in the IDE)
FOR Offset& = 0 TO 32764 ' Search for b$AddrC, which is
IF PEEK(Offset&) = &HA0 THEN ' in the default segment and
IF PEEK(Offset& + 1) = &H7D THEN ' should have a value of
IF PEEK(Offset& + 2) = &H0 THEN ' A0 7D 00 A0.
IF PEEK(Offset& + 3) = &HA0 THEN
videoAddrOff& = Offset& + 2 ' If we found it, record the
EXIT FOR ' offset of b$SegC and quit
END IF ' looking. (Oddly, changing
END IF ' the b$OffC doesn't seem to
END IF ' do anything, so this is why
END IF ' this sub only changes b$SegC)
NEXT
END IF
' Change b$SegC to the specified Segment
POKE videoAddrOff&, Segment AND &HFF
POKE videoAddrOff& + 1, (Segment AND &HFF00&) \ &H100
END SUB