11-01-2025, 12:35 AM
(This post was last modified: 11-01-2025, 12:44 AM by Unseen Machine.)
An interesting approach, though most things that will ever use collision detection will be done in Bounding Boxes/Circles. So whilst as I said, its interesting...I fail to see a practical application for it...just like this one i made while back. It does polygons, triangles, squares etc....but apart from the integrated SAT function, it's only good for a demo...
What WE (the community) is lacking currently is, FAST pixel perfect sprites collisions and ANY 3d bounding box/sphere collisions...give me one of them and i'll give you +2!
Unseen
(Dont take this as a cuss please, I love things like this!)
Code: (Select All)
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'// Unseen Machine's Collisions Demo\\
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
RANDOMIZE TIMER
CONST SHAPE_CIRCLE = 1
CONST SHAPE_BOX = 2
CONST SHAPE_TRIANGLE = 3
CONST SHAPE_POLYGON = 4
CONST Vector_Size = 8
CONST TRUE = -1, FALSE = 0
CONST MAX_BOXES = 20
CONST MAX_CIRCLES = 40
CONST MAX_SHAPES = 40
CONST FLASH_TIME = 0.25
'///////////////////////////////////// System Initialisation ////////////////////////////////////////////////
SCREEN _NEWIMAGE(800, 600, 32)
_SCREENMOVE 0, 0
_DELAY 1
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
DIM SHARED Boxes(MAX_BOXES) AS Box
DIM SHARED Circles(MAX_CIRCLES) AS Circle
DIM SHARED Bxs, Crc, Ply
DIM SHARED Shapes(MAX_SHAPES) AS Shape
DIM SHARED GT#, LastGT#
GT# = TIMER(.001): LastGT# = GT#
InitCircles
InitBoxes
InitShapes
'Crc = TRUE
'Bxs = TRUE
'//////////////////////////////////////// Main Loop ////////////////////////////////////////////////////////////
DO
_LIMIT 60
_FPS 60
GT# = TIMER(.001)
dt = GT# - LastGT#
IF Crc THEN UpdateCircles dt
IF Bxs THEN UpdateBoxes dt
IF Crc AND Bxs THEN HandleBoxCircleCollisions dt
UpdateShapes dt
HandleAllCollisions
LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, 20), BF
IF Crc THEN DrawCircles
IF Bxs THEN DrawBoxes
RenderShapes
_DISPLAY
LastGT# = GT#
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
TYPE Vector
X AS SINGLE
Y AS SINGLE
END TYPE
'The new Box type for a rotated rectangle, without pre-calculated corners
TYPE Box
Position AS Vector
WidthHeight AS Vector
Rotation AS SINGLE
RotationPointOffset AS Vector
Rotation_Speed AS SINGLE ' New: For rotational speed
Velocity AS Vector ' Movement vector for this box
pColor AS LONG ' Color for drawing
IsColliding AS INTEGER ' Flag to indicate collision state
FlashTimer AS SINGLE ' Timer for collision flash
Mass AS SINGLE
END TYPE
TYPE Circle
Position AS Vector ' Position vector for the circle's center
Radius AS SINGLE ' Radius of the circle
Rotation AS SINGLE ' Rotational property, kept as circles can still spin
Rotation_Speed AS SINGLE ' Rotational speed
Velocity AS Vector ' Movement vector for this circle
pColor AS LONG ' Color for drawing
IsColliding AS INTEGER ' Flag to indicate collision state
FlashTimer AS SINGLE ' Timer for collision flash
Mass AS SINGLE
END TYPE
TYPE Shape
ShapeType AS INTEGER
Position AS Vector
Rotation AS SINGLE
Rotation_Speed AS SINGLE
RotationPointOffset AS Vector
Velocity AS Vector
pColor AS LONG
Mass AS SINGLE
IsColliding AS INTEGER
FlashTimer AS SINGLE
Radius AS SINGLE
WidthHeight AS Vector
numpoints AS INTEGER
MemVertices AS _MEM
END TYPE
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Draws a box using its calculated corner vertices.
SUB DrawBox (Box AS Box, bcolor AS LONG)
DIM Corners(3) AS Vector
CALL GetBoxCorners(Box, Corners())
LINE (Corners(0).X, Corners(0).Y)-(Corners(1).X, Corners(1).Y), bcolor
LINE (Corners(1).X, Corners(1).Y)-(Corners(2).X, Corners(2).Y), bcolor
LINE (Corners(2).X, Corners(2).Y)-(Corners(3).X, Corners(3).Y), bcolor
LINE (Corners(3).X, Corners(3).Y)-(Corners(0).X, Corners(0).Y), bcolor
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Rotates a point around a pivot point by a given angle (in radians)
SUB RotatePoint (Result AS Vector, p AS Vector, pivot AS Vector, angle AS SINGLE)
DIM temp_x AS SINGLE, temp_y AS SINGLE
temp_x = p.X - pivot.X
temp_y = p.Y - pivot.Y
Result.X = temp_x * COS(angle) - temp_y * SIN(angle)
Result.Y = temp_x * SIN(angle) + temp_y * COS(angle)
Result.X = Result.X + pivot.X
Result.Y = Result.Y + pivot.Y
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Calculates the corner vertices for a given box
SUB GetBoxCorners (Box AS Box, Corners() AS Vector)
DIM HalfW AS SINGLE, HalfH AS SINGLE
DIM UnrotatedCorner AS Vector
DIM Center AS Vector
HalfW = Box.WidthHeight.X / 2
HalfH = Box.WidthHeight.Y / 2
Center = Box.Position
UnrotatedCorner.X = Center.X - HalfW
UnrotatedCorner.Y = Center.Y - HalfH
CALL RotatePoint(Corners(0), UnrotatedCorner, Center, Box.Rotation)
UnrotatedCorner.X = Center.X + HalfW
UnrotatedCorner.Y = Center.Y - HalfH
CALL RotatePoint(Corners(1), UnrotatedCorner, Center, Box.Rotation)
UnrotatedCorner.X = Center.X + HalfW
UnrotatedCorner.Y = Center.Y + HalfH
CALL RotatePoint(Corners(2), UnrotatedCorner, Center, Box.Rotation)
UnrotatedCorner.X = Center.X - HalfW
UnrotatedCorner.Y = Center.Y + HalfH
CALL RotatePoint(Corners(3), UnrotatedCorner, Center, Box.Rotation)
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Checks for overlap of projections on a given axis
FUNCTION Overlap_On_Axis (Corners1() AS Vector, Corners2() AS Vector, Axis AS Vector)
DIM Min1 AS SINGLE, Max1 AS SINGLE, Min2 AS SINGLE, Max2 AS SINGLE
DIM Projection AS SINGLE, I AS LONG
Min1 = 9999999!: Max1 = -9999999!
Min2 = 9999999!: Max2 = -9999999!
FOR I = 0 TO 3
Projection = Corners1(I).X * Axis.X + Corners1(I).Y * Axis.Y
IF Projection < Min1 THEN Min1 = Projection
IF Projection > Max1 THEN Max1 = Projection
NEXT I
FOR I = 0 TO 3
Projection = Corners2(I).X * Axis.X + Corners2(I).Y * Axis.Y
IF Projection < Min2 THEN Min2 = Projection
IF Projection > Max2 THEN Max2 = Projection
NEXT I
IF Max1 >= Min2 AND Max2 >= Min1 THEN Overlap_On_Axis = -1 ELSE Overlap_On_Axis = 0
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Checks for intersection using SAT
FUNCTION Box_Intersect (Box1 AS Box, Box2 AS Box)
DIM Box1_Corners(3) AS Vector, Box2_Corners(3) AS Vector
DIM Axis(3) AS Vector, length AS SINGLE, I AS LONG
CALL GetBoxCorners(Box1, Box1_Corners())
CALL GetBoxCorners(Box2, Box2_Corners())
Axis(0).X = -(Box1_Corners(1).Y - Box1_Corners(0).Y): Axis(0).Y = Box1_Corners(1).X - Box1_Corners(0).X
Axis(1).X = -(Box1_Corners(0).Y - Box1_Corners(3).Y): Axis(1).Y = Box1_Corners(0).X - Box1_Corners(3).X
FOR I = 0 TO 1
length = SQR(Axis(I).X * Axis(I).X + Axis(I).Y * Axis(I).Y)
IF length > 0 THEN Axis(I).X = Axis(I).X / length: Axis(I).Y = Axis(I).Y / length
IF NOT Overlap_On_Axis(Box1_Corners(), Box2_Corners(), Axis(I)) THEN Box_Intersect = 0: EXIT FUNCTION
NEXT I
Axis(2).X = -(Box2_Corners(1).Y - Box2_Corners(0).Y): Axis(2).Y = Box2_Corners(1).X - Box2_Corners(0).X
Axis(3).X = -(Box2_Corners(0).Y - Box2_Corners(3).Y): Axis(3).Y = Box2_Corners(0).X - Box2_Corners(3).X
FOR I = 2 TO 3
length = SQR(Axis(I).X * Axis(I).X + Axis(I).Y * Axis(I).Y)
IF length > 0 THEN Axis(I).X = Axis(I).X / length: Axis(I).Y = Axis(I).Y / length
IF NOT Overlap_On_Axis(Box1_Corners(), Box2_Corners(), Axis(I)) THEN Box_Intersect = 0: EXIT FUNCTION
NEXT I
Box_Intersect = -1
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION Circle_Intersect (Circle1 AS Circle, Circle2 AS Circle)
' Calculate the squared distance between the circle centers
DIM dx AS SINGLE: dx = Circle1.Position.X - Circle2.Position.X
DIM dy AS SINGLE: dy = Circle1.Position.Y - Circle2.Position.Y
DIM distance_squared AS SINGLE: distance_squared = dx * dx + dy * dy
' Calculate the sum of the radii and square it
DIM radii_sum AS SINGLE: radii_sum = Circle1.Radius + Circle2.Radius
DIM radii_sum_squared AS SINGLE: radii_sum_squared = radii_sum * radii_sum
' If the distance squared is less than or equal to the sum of radii squared, they intersect
IF distance_squared <= radii_sum_squared THEN
Circle_Intersect = -1 ' Collision
ELSE
Circle_Intersect = 0 ' No collision
END IF
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB InitCircles
DIM I AS LONG, R AS SINGLE, S AS SINGLE
FOR I = 0 TO MAX_CIRCLES - 1
R = 5 + RND * 25 ' Radius
S = 1 + RND * 10 ' Speed factor
Circles(I).Position.X = RND * _WIDTH
Circles(I).Position.Y = RND * _HEIGHT
Circles(I).Radius = R
Circles(I).Rotation_Speed = (RND - 5) * 0.3 ' Random speed and direction
Circles(I).Velocity.X = (RND * 300) + -150
Circles(I).Velocity.Y = (RND * 300) + -150
Circles(I).pColor = _RGB32(RND * 255, RND * 255, RND * 255)
Circles(I).IsColliding = FALSE
Circles(I).FlashTimer = 0
Circles(I).Mass = _PI * Circles(I).Radius * Circles(I).Radius
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB UpdateCircles (dt AS SINGLE)
DIM I AS LONG, J AS LONG
DIM Circle_Hit AS INTEGER
FOR I = 0 TO MAX_CIRCLES - 1
' Update position and rotation
Circles(I).Position.X = Circles(I).Position.X + Circles(I).Velocity.X * dt
Circles(I).Position.Y = Circles(I).Position.Y + Circles(I).Velocity.Y * dt
Circles(I).Rotation = Circles(I).Rotation + Circles(I).Rotation_Speed * dt
' Screen wrapping
IF Circles(I).Position.X + Circles(I).Radius < 0 THEN Circles(I).Position.X = _WIDTH + Circles(I).Radius
IF Circles(I).Position.X - Circles(I).Radius > _WIDTH THEN Circles(I).Position.X = 0 - Circles(I).Radius
IF Circles(I).Position.Y + Circles(I).Radius < 0 THEN Circles(I).Position.Y = _HEIGHT + Circles(I).Radius
IF Circles(I).Position.Y - Circles(I).Radius > _HEIGHT THEN Circles(I).Position.Y = 0 - Circles(I).Radius
' Check for collision with other circles
Circle_Hit = FALSE
FOR J = I + 1 TO MAX_CIRCLES - 1
IF Circle_Intersect(Circles(I), Circles(J)) THEN
Circle_Hit = TRUE
' Simple bounce logic (swapping velocities)
DIM tempX AS SINGLE, tempY AS SINGLE
tempX = Circles(I).Velocity.X: tempY = Circles(I).Velocity.Y
Circles(I).Velocity.X = Circles(J).Velocity.X: Circles(I).Velocity.Y = Circles(J).Velocity.Y
Circles(J).Velocity.X = tempX: Circles(J).Velocity.Y = tempY
Circles(J).FlashTimer = FLASH_TIME
END IF
NEXT J
' Manage flash timer
IF Circle_Hit THEN
Circles(I).FlashTimer = FLASH_TIME
ELSEIF Circles(I).FlashTimer > 0 THEN
Circles(I).FlashTimer = Circles(I).FlashTimer - dt
END IF
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB DrawCircles
DIM I AS LONG, pColor AS LONG
FOR I = 0 TO MAX_CIRCLES - 1
IF Circles(I).FlashTimer > 0 THEN
pColor = _RGB32(255, 255, 255) ' White flash color
ELSE
pColor = Circles(I).pColor
END IF
' Draw the circle using QB64's CIRCLE command
CIRCLE (Circles(I).Position.X, Circles(I).Position.Y), Circles(I).Radius, pColor
' To draw a filled circle, use PAINT after drawing the outline.
PAINT (Circles(I).Position.X, Circles(I).Position.Y), pColor, pColor
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB DrawBoxes
DIM I AS LONG
DIM pColor AS LONG
DIM Corners(3) AS Vector ' This needs to be defined
FOR I = 0 TO MAX_BOXES - 1
' Set color, flashing white if collision timer is active
IF Boxes(I).FlashTimer > 0 THEN
pColor = _RGB32(255, 255, 255) ' White flash color
ELSE
pColor = Boxes(I).pColor
END IF
' Get the world-space coordinates of the box's four corners
CALL GetBoxCorners(Boxes(I), Corners())
' Draw the box outline by connecting the corners
LINE (Corners(0).X, Corners(0).Y)-(Corners(1).X, Corners(1).Y), pColor
LINE (Corners(1).X, Corners(1).Y)-(Corners(2).X, Corners(2).Y), pColor
LINE (Corners(2).X, Corners(2).Y)-(Corners(3).X, Corners(3).Y), pColor
LINE (Corners(3).X, Corners(3).Y)-(Corners(0).X, Corners(0).Y), pColor
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION DistanceSquared (Vec1 AS Vector, Vec2 AS Vector)
DIM dx AS SINGLE: dx = Vec1.X - Vec2.X
DIM dy AS SINGLE: dy = Vec1.Y - Vec2.Y
DistanceSquared = dx * dx + dy * dy
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION BoxCircle_Intersect (Box AS Box, pCircle AS Circle)
DIM BoxCenter AS Vector
DIM LocalCirclePos AS Vector
DIM ClampedPos AS Vector
DIM dx AS SINGLE, dy AS SINGLE, distance_squared AS SINGLE
DIM HalfWidth AS SINGLE, HalfHeight AS SINGLE
' Calculate the box's true center in world space, accounting for the rotation offset
BoxCenter.X = Box.Position.X + Box.RotationPointOffset.X
BoxCenter.Y = Box.Position.Y + Box.RotationPointOffset.Y
' Create a copy of the circle's position to rotate
LocalCirclePos = pCircle.Position
' Rotate the circle's position into the box's local, axis-aligned space
CALL RotateVector(LocalCirclePos, BoxCenter, -Box.Rotation)
' Separate the declaration and initialization as required by QB64
HalfWidth = Box.WidthHeight.X / 2.0
HalfHeight = Box.WidthHeight.Y / 2.0
' Clamp the local circle's position to the axis-aligned box in local space.
ClampedPos.X = LocalCirclePos.X
IF LocalCirclePos.X < BoxCenter.X - HalfWidth THEN ClampedPos.X = BoxCenter.X - HalfWidth
IF LocalCirclePos.X > BoxCenter.X + HalfWidth THEN ClampedPos.X = BoxCenter.X + HalfWidth
ClampedPos.Y = LocalCirclePos.Y
IF LocalCirclePos.Y < BoxCenter.Y - HalfHeight THEN ClampedPos.Y = BoxCenter.Y - HalfHeight
IF LocalCirclePos.Y > BoxCenter.Y + HalfHeight THEN ClampedPos.Y = BoxCenter.Y + HalfHeight
' Calculate the squared distance between the clamped point and the rotated circle's center
dx = ClampedPos.X - LocalCirclePos.X
dy = ClampedPos.Y - LocalCirclePos.Y
distance_squared = dx * dx + dy * dy
' Compare with the squared radius
IF distance_squared <= pCircle.Radius * pCircle.Radius THEN
BoxCircle_Intersect = -1 ' Collision
ELSE
BoxCircle_Intersect = 0 ' No collision
END IF
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB InitBoxes
DIM I AS LONG, W AS SINGLE, H AS SINGLE, S AS SINGLE
FOR I = 0 TO MAX_BOXES - 1
' Randomize box dimensions
W = 10 + RND * 50
H = 10 + RND * 50
' Randomize box position within the screen boundaries
Boxes(I).Position.X = RND * _WIDTH
Boxes(I).Position.Y = RND * _HEIGHT
Boxes(I).WidthHeight.X = W
Boxes(I).WidthHeight.Y = H
Boxes(I).Mass = Boxes(I).WidthHeight.X * Boxes(I).WidthHeight.Y
' Randomize initial rotation and rotation speed
Boxes(I).Rotation = RND * 2 * _PI
Boxes(I).Rotation_Speed = (RND * .3) - .15 ' Rotational speed can be positive or negative
' Set the rotation point to the center of the box
Boxes(I).RotationPointOffset.X = W / 2: Boxes(I).RotationPointOffset.Y = H / 2
' Randomize velocity with a scaling factor
S = 10 + RND * 5
Boxes(I).Velocity.X = (RND * 30) + -15 ' RND * 2 - 1 gives a range from -1 to 1
Boxes(I).Velocity.Y = (RND * 30) + -15
' Randomize a color
Boxes(I).pColor = _RGB32(RND * 255, RND * 255, RND * 255)
' Reset collision and flash timer state
Boxes(I).IsColliding = FALSE
Boxes(I).FlashTimer = 0
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB RotateVector (PointToRotate AS Vector, Center AS Vector, Angle AS SINGLE)
DIM Translated AS Vector
DIM Rotated AS Vector
' Translate point so center of rotation is at the origin
Translated.X = PointToRotate.X - Center.X
Translated.Y = PointToRotate.Y - Center.Y
' Apply the rotation
Rotated.X = Translated.X * COS(Angle) - Translated.Y * SIN(Angle)
Rotated.Y = Translated.X * SIN(Angle) + Translated.Y * COS(Angle)
' Translate back and update the original vector
PointToRotate.X = Rotated.X + Center.X
PointToRotate.Y = Rotated.Y + Center.Y
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB UpdateBoxes (dt AS SINGLE)
DIM I AS LONG, J AS LONG
DIM Box_Hit AS INTEGER
DIM tempX AS SINGLE, tempY AS SINGLE
DIM minX AS SINGLE, maxX AS SINGLE, minY AS SINGLE, maxY AS SINGLE
DIM Corners(3) AS Vector ' This needs to be defined
FOR I = 0 TO MAX_BOXES - 1
' Update position and rotation
Boxes(I).Position.X = Boxes(I).Position.X + Boxes(I).Velocity.X * dt
Boxes(I).Position.Y = Boxes(I).Position.Y + Boxes(I).Velocity.Y * dt
Boxes(I).Rotation = Boxes(I).Rotation + Boxes(I).Rotation_Speed * dt
' --- Screen wrapping logic ---
' Calculate the AABB (Axis-Aligned Bounding Box) of the rotated box to find its min/max extents
CALL GetBoxCorners(Boxes(I), Corners()) ' Assuming GetBoxCorners fills the Corners array
minX = Corners(0).X: maxX = Corners(0).X
minY = Corners(0).Y: maxY = Corners(0).Y
FOR k = 1 TO 3
IF Corners(k).X < minX THEN minX = Corners(k).X
IF Corners(k).X > maxX THEN maxX = Corners(k).X
IF Corners(k).Y < minY THEN minY = Corners(k).Y
IF Corners(k).Y > maxY THEN maxY = Corners(k).Y
NEXT k
' Apply wrapping based on the AABB
IF maxX < 0 THEN Boxes(I).Position.X = _WIDTH + (Boxes(I).Position.X - minX)
IF minX > _WIDTH THEN Boxes(I).Position.X = 0 - (maxX - Boxes(I).Position.X)
IF maxY < 0 THEN Boxes(I).Position.Y = _HEIGHT + (Boxes(I).Position.Y - minY)
IF minY > _HEIGHT THEN Boxes(I).Position.Y = 0 - (maxY - Boxes(I).Position.Y)
' --- Collision handling ---
Box_Hit = FALSE
FOR J = I + 1 TO MAX_BOXES - 1
IF Box_Intersect(Boxes(I), Boxes(J)) THEN
Box_Hit = TRUE
' Simple bounce logic
tempX = Boxes(I).Velocity.X: tempY = Boxes(I).Velocity.Y
Boxes(I).Velocity.X = Boxes(J).Velocity.X: Boxes(I).Velocity.Y = Boxes(J).Velocity.Y
Boxes(J).Velocity.X = tempX: Boxes(J).Velocity.Y = tempY
Boxes(J).FlashTimer = FLASH_TIME
END IF
NEXT J
' Manage flash timer for box
IF Box_Hit THEN
Boxes(I).FlashTimer = FLASH_TIME
ELSEIF Boxes(I).FlashTimer > 0 THEN
Boxes(I).FlashTimer = Boxes(I).FlashTimer - dt
END IF
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB HandleBoxCircleCollisions (dt AS SINGLE)
DIM I AS LONG, J AS LONG, Vector(0, 0) AS Vector
DIM BoxCenter AS Vector
DIM LocalCirclePos AS Vector
DIM HalfWidth AS SINGLE, HalfHeight AS SINGLE
DIM ClampedPos AS Vector
DIM Normal AS Vector
DIM Length AS SINGLE
DIM Penetration AS SINGLE
DIM MassInverseSum AS SINGLE
DIM PosCorrection AS SINGLE
DIM RelVel AS Vector
DIM VelAlongNormal AS SINGLE
DIM Restitution AS SINGLE
DIM ImpulseScalar AS SINGLE
DIM MinSeparation AS SINGLE
' Constants for the physics simulation
Restitution = 0.9
MinSeparation = 0.01
FOR I = 0 TO MAX_CIRCLES - 1
FOR J = 0 TO MAX_BOXES - 1
IF BoxCircle_Intersect(Boxes(J), Circles(I)) THEN
Circles(I).FlashTimer = FLASH_TIME
Boxes(J).FlashTimer = FLASH_TIME
' === Collision Resolution ===
' Calculate the box's true center in world space
BoxCenter.X = Boxes(J).Position.X + Boxes(J).RotationPointOffset.X
BoxCenter.Y = Boxes(J).Position.Y + Boxes(J).RotationPointOffset.Y
' Get local space circle position
LocalCirclePos = Circles(I).Position
CALL RotateVector(LocalCirclePos, BoxCenter, -Boxes(J).Rotation)
' Get box dimensions
HalfWidth = Boxes(J).WidthHeight.X / 2.0
HalfHeight = Boxes(J).WidthHeight.Y / 2.0
' Clamp the local circle's position to the axis-aligned box
ClampedPos.X = LocalCirclePos.X
IF LocalCirclePos.X < BoxCenter.X - HalfWidth THEN ClampedPos.X = BoxCenter.X - HalfWidth
IF LocalCirclePos.X > BoxCenter.X + HalfWidth THEN ClampedPos.X = BoxCenter.X + HalfWidth
ClampedPos.Y = LocalCirclePos.Y
IF LocalCirclePos.Y < BoxCenter.Y - HalfHeight THEN ClampedPos.Y = BoxCenter.Y - HalfHeight
IF LocalCirclePos.Y > BoxCenter.Y + HalfHeight THEN ClampedPos.Y = BoxCenter.Y + HalfHeight
' Calculate the normal vector and penetration depth
Normal.X = LocalCirclePos.X - ClampedPos.X
Normal.Y = LocalCirclePos.Y - ClampedPos.Y
Length = SQR(Normal.X * Normal.X + Normal.Y * Normal.Y)
Penetration = Circles(I).Radius - Length
IF Penetration > 0 THEN
IF Length > 0 THEN
' Normalize the normal vector
Normal.X = Normal.X / Length
Normal.Y = Normal.Y / Length
ELSE
' This case occurs if the circle's center is exactly on the box's center.
' Choose a random normal to prevent a division by zero.
Normal.X = 1: Normal.Y = 0
END IF
' Rotate the normal back into world space
CALL RotateVector(Normal, Vector(0, 0), Boxes(J).Rotation)
' === Positional Correction ===
MassInverseSum = 1 / Circles(I).Mass + 1 / Boxes(J).Mass
IF MassInverseSum > 0 THEN
PosCorrection = _MAX(Penetration - MinSeparation, 0) / MassInverseSum
Circles(I).Position.X = Circles(I).Position.X + Normal.X * PosCorrection / Circles(I).Mass
Circles(I).Position.Y = Circles(I).Position.Y + Normal.Y * PosCorrection / Circles(I).Mass
Boxes(J).Position.X = Boxes(J).Position.X - Normal.X * PosCorrection / Boxes(J).Mass
Boxes(J).Position.Y = Boxes(J).Position.Y - Normal.Y * PosCorrection / Boxes(J).Mass
END IF
' === Velocity Impulse ===
RelVel.X = Circles(I).Velocity.X - Boxes(J).Velocity.X
RelVel.Y = Circles(I).Velocity.Y - Boxes(J).Velocity.Y
VelAlongNormal = RelVel.X * Normal.X + RelVel.Y * Normal.Y
IF VelAlongNormal < 0 THEN
IF MassInverseSum > 0 THEN
ImpulseScalar = -(1 + Restitution) * VelAlongNormal / MassInverseSum
Circles(I).Velocity.X = Circles(I).Velocity.X + ImpulseScalar * Normal.X / Circles(I).Mass
Circles(I).Velocity.Y = Circles(I).Velocity.Y + ImpulseScalar * Normal.Y / Circles(I).Mass
Boxes(J).Velocity.X = Boxes(J).Velocity.X - ImpulseScalar * Normal.X / Boxes(J).Mass
Boxes(J).Velocity.Y = Boxes(J).Velocity.Y - ImpulseScalar * Normal.Y / Boxes(J).Mass
END IF
END IF
END IF
END IF
NEXT J
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_NewPolygon (Shape AS Shape, Position AS Vector, Vertices() AS Vector, numpoints AS INTEGER, Mass AS SINGLE)
DIM I AS INTEGER
Shape.ShapeType = SHAPE_POLYGON
Shape.Position = Position
Shape.Mass = Mass
' Allocate and copy vertices using the MEM-based helper functions
CALL Shape_NewPolygon_Mem(Shape, numpoints)
FOR I = 0 TO numpoints - 1
CALL Shape_SetVertex(Shape, I, Vertices(I))
NEXT I
' Set the rotation point to the average center of the vertices
' You may need a more sophisticated method for complex shapes
DIM Center AS Vector
Center.X = 0: Center.Y = 0
FOR I = 0 TO numpoints - 1
Center.X = Center.X + Vertices(I).X
Center.Y = Center.Y + Vertices(I).Y
NEXT I
Shape.RotationPointOffset.X = Center.X / numpoints
Shape.RotationPointOffset.Y = Center.Y / numpoints
' Initialize other properties
Shape.Velocity.X = 0: Shape.Velocity.Y = 0
Shape.Rotation = 0
Shape.Rotation_Speed = 0
Shape.pColor = _RGB32(255, 255, 255)
Shape.IsColliding = 0
Shape.FlashTimer = 0
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Helper for the memory allocation part, using a different name to avoid confusion
SUB Shape_NewPolygon_Mem (Shape AS Shape, numpoints AS INTEGER)
Shape.MemVertices = _MEMNEW(numpoints * Vector_Size)
Shape.numpoints = numpoints
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_SetVertex (Shape AS Shape, index AS INTEGER, Vertex AS Vector)
_MEMPUT Shape.MemVertices, Shape.MemVertices.OFFSET + (index * Vector_Size), Vertex
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_GetVertex (Shape AS Shape, index AS INTEGER, Result AS Vector)
' Set the result UDT to default values
Result.X = 0
Result.Y = 0
IF index >= 0 AND index < Shape.numpoints THEN
_MEMGET Shape.MemVertices, Shape.MemVertices.OFFSET + (index * Vector_Size), Result
END IF
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_Free (Shape AS Shape)
IF _MEMEXISTS(Shape.MemVertices) THEN
_MEMFREE Shape.MemVertices
END IF
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_NewCircle (Shape AS Shape, Position AS Vector, Radius AS SINGLE, Mass AS SINGLE)
Shape.ShapeType = SHAPE_CIRCLE
Shape.Position = Position
Shape.Radius = Radius
Shape.Mass = Mass
' Initialize other properties
Shape.Velocity.X = 0: Shape.Velocity.Y = 0
Shape.Rotation = 0
Shape.Rotation_Speed = 0
Shape.RotationPointOffset.X = 0: Shape.RotationPointOffset.Y = 0
Shape.pColor = _RGB32(255, 255, 255)
Shape.IsColliding = 0
Shape.FlashTimer = 0
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_NewBox (Shape AS Shape, Position AS Vector, WidthHeight AS Vector, Mass AS SINGLE)
Shape.ShapeType = SHAPE_BOX
Shape.Position = Position
Shape.WidthHeight = WidthHeight
Shape.Mass = Mass
' Set the rotation point to the center of the box for convenience
Shape.RotationPointOffset.X = WidthHeight.X / 2: Shape.RotationPointOffset.Y = WidthHeight.Y / 2
' Initialize other properties
Shape.Velocity.X = 0: Shape.Velocity.Y = 0
Shape.Rotation = 0
Shape.Rotation_Speed = 0
Shape.pColor = _RGB32(255, 255, 255)
Shape.IsColliding = 0
Shape.FlashTimer = 0
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB Shape_Handle_Collisions (Shape1 AS Shape, Shape2 AS Shape)
DIM CollisionDetected AS INTEGER
DIM tempX AS SINGLE, tempY AS SINGLE
CollisionDetected = 0
SELECT CASE Shape1.ShapeType
CASE SHAPE_CIRCLE
SELECT CASE Shape2.ShapeType
CASE SHAPE_CIRCLE
IF Intersect_CircleCircle(Shape1, Shape2) THEN CollisionDetected = -1
CASE SHAPE_BOX
IF Intersect_CircleBox(Shape1, Shape2) THEN CollisionDetected = -1
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
IF Intersect_CirclePolygon(Shape1, Shape2) THEN CollisionDetected = -1
END SELECT
CASE SHAPE_BOX
SELECT CASE Shape2.ShapeType
CASE SHAPE_CIRCLE
IF Intersect_CircleBox(Shape2, Shape1) THEN CollisionDetected = -1
CASE SHAPE_BOX
IF Intersect_PolygonPolygon(Shape1, Shape2) THEN CollisionDetected = -1
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
IF Intersect_PolygonPolygon(Shape1, Shape2) THEN CollisionDetected = -1
END SELECT
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
SELECT CASE Shape2.ShapeType
CASE SHAPE_CIRCLE
IF Intersect_CirclePolygon(Shape2, Shape1) THEN CollisionDetected = -1
CASE SHAPE_BOX
IF Intersect_PolygonPolygon(Shape1, Shape2) THEN CollisionDetected = -1
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
IF Intersect_PolygonPolygon(Shape1, Shape2) THEN CollisionDetected = -1
END SELECT
END SELECT
IF CollisionDetected THEN
' Flash to indicate collision
Shape1.FlashTimer = FLASH_TIME
Shape2.FlashTimer = FLASH_TIME
' === HACKY SIMPLE BOUNCE LOGIC ===
' This swaps velocity vectors, which produces a bouncy but not perfectly accurate result.
tempX = Shape1.Velocity.X: tempY = Shape1.Velocity.Y
Shape1.Velocity.X = Shape2.Velocity.X: Shape1.Velocity.Y = Shape2.Velocity.Y
Shape2.Velocity.X = tempX: Shape2.Velocity.Y = tempY
END IF
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
SUB HandleAllCollisions
DIM I AS INTEGER, J AS INTEGER
FOR I = 0 TO MAX_SHAPES - 1
FOR J = I + 1 TO MAX_SHAPES - 1
CALL Shape_Handle_Collisions(Shapes(I), Shapes(J))
NEXT J
NEXT I
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION Intersect_CircleCircle (Shape1 AS Shape, Shape2 AS Shape)
DIM dx AS SINGLE, dy AS SINGLE, distance_squared AS SINGLE
dx = Shape1.Position.X - Shape2.Position.X
dy = Shape1.Position.Y - Shape2.Position.Y
distance_squared = dx * dx + dy * dy
DIM radii_sum AS SINGLE
radii_sum = Shape1.Radius + Shape2.Radius
IF distance_squared <= radii_sum * radii_sum THEN
Intersect_CircleCircle = -1
ELSE
Intersect_CircleCircle = 0
END IF
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION Intersect_CirclePolygon (Circ AS Shape, Polygon AS Shape)
' Logic adapted from previous box-circle collision, but generalized for polygons.
DIM PolyCenter AS Vector, LocalCirclePos AS Vector, ClampedPos AS Vector
DIM Normal AS Vector, Length AS SINGLE, Penetration AS SINGLE
DIM I AS INTEGER, EdgeStart AS Vector, EdgeEnd AS Vector, ClampedPointOnEdge AS Vector
PolyCenter.X = Polygon.Position.X + Polygon.RotationPointOffset.X
PolyCenter.Y = Polygon.Position.Y + Polygon.RotationPointOffset.Y
LocalCirclePos = Circ.Position
CALL RotateVector(LocalCirclePos, PolyCenter, -Polygon.Rotation)
' Loop through each edge of the polygon to find the closest point
DIM MinDistanceSq AS SINGLE: MinDistanceSq = -1 ' Use a negative number as an initial flag
FOR I = 0 TO Polygon.numpoints - 1
CALL Shape_GetVertex(Polygon, I, EdgeStart)
CALL Shape_GetVertex(Polygon, (I + 1) MOD Polygon.numpoints, EdgeEnd)
ClosestPointOnLineSegment EdgeStart, EdgeEnd, LocalCirclePos, ClampedPointOnEdge
distSq = DistanceSquared(ClampedPointOnEdge, LocalCirclePos)
IF MinDistanceSq < 0 OR distSq < MinDistanceSq THEN
MinDistanceSq = distSq
ClampedPos = ClampedPointOnEdge
END IF
NEXT I
IF MinDistanceSq < 0 THEN
Intersect_CirclePolygon = 0: EXIT FUNCTION
END IF
DIM dx AS SINGLE, dy AS SINGLE
dx = ClampedPos.X - LocalCirclePos.X
dy = ClampedPos.Y - LocalCirclePos.Y
distance_squared = dx * dx + dy * dy
IF distance_squared <= Circle.Radius * Circle.Radius THEN
Intersect_CirclePolygon = -1
ELSE
Intersect_CirclePolygon = 0
END IF
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
FUNCTION Intersect_CircleBox (Shape1 AS Shape, Shape2 AS Shape)
' Ensure correct shape types for this function
IF Shape1.ShapeType <> SHAPE_CIRCLE OR Shape2.ShapeType <> SHAPE_BOX THEN
Intersect_CircleBox = 0
EXIT FUNCTION
END IF
DIM BoxCenter AS Vector
DIM LocalCirclePos AS Vector
DIM ClampedPos AS Vector
DIM dx AS SINGLE, dy AS SINGLE, distance_squared AS SINGLE
DIM HalfWidth AS SINGLE, HalfHeight AS SINGLE
' Calculate the box's true center in world space, accounting for the rotation offset
BoxCenter.X = Shape2.Position.X + Shape2.RotationPointOffset.X
BoxCenter.Y = Shape2.Position.Y + Shape2.RotationPointOffset.Y
' Create a copy of the circle's position to rotate
LocalCirclePos = Shape1.Position
' Rotate the circle's position into the box's local, axis-aligned space
CALL RotateVector(LocalCirclePos, BoxCenter, -Shape2.Rotation)
' Separate the declaration and initialization as required by QB64
HalfWidth = Shape2.WidthHeight.X / 2.0
HalfHeight = Shape2.WidthHeight.Y / 2.0
' Clamp the local circle's position to the axis-aligned box in local space.
ClampedPos.X = LocalCirclePos.X
IF LocalCirclePos.X < BoxCenter.X - HalfWidth THEN ClampedPos.X = BoxCenter.X - HalfWidth
IF LocalCirclePos.X > BoxCenter.X + HalfWidth THEN ClampedPos.X = BoxCenter.X + HalfWidth
ClampedPos.Y = LocalCirclePos.Y
IF LocalCirclePos.Y < BoxCenter.Y - HalfHeight THEN ClampedPos.Y = BoxCenter.Y - HalfHeight
IF LocalCirclePos.Y > BoxCenter.Y + HalfHeight THEN ClampedPos.Y = BoxCenter.Y + HalfHeight
' Calculate the squared distance between the clamped point and the rotated circle's center
dx = ClampedPos.X - LocalCirclePos.X
dy = ClampedPos.Y - LocalCirclePos.Y
distance_squared = dx * dx + dy * dy
' Compare with the squared radius
IF distance_squared <= Shape1.Radius * Shape1.Radius THEN
Intersect_CircleBox = -1 ' Collision
ELSE
Intersect_CircleBox = 0 ' No collision
END IF
END FUNCTION
SUB ClosestPointOnLineSegment (StartPoint AS Vector, EndPoint AS Vector, TestPoint AS Vector, ResultPoint AS Vector)
DIM Vector_AB AS Vector
DIM Vector_AC AS Vector
DIM ScalarProjection AS SINGLE
DIM LengthSq AS SINGLE
DIM T AS SINGLE
' Vector from start point (A) to end point (B)
Vector_AB.X = EndPoint.X - StartPoint.X
Vector_AB.Y = EndPoint.Y - StartPoint.Y
' Vector from start point (A) to test point (C)
Vector_AC.X = TestPoint.X - StartPoint.X
Vector_AC.Y = TestPoint.Y - StartPoint.Y
' Calculate the scalar projection of Vector_AC onto Vector_AB
ScalarProjection = Vector_AC.X * Vector_AB.X + Vector_AC.Y * Vector_AB.Y
' Calculate the squared length of Vector_AB
LengthSq = Vector_AB.X * Vector_AB.X + Vector_AB.Y * Vector_AB.Y
' Calculate the parameter 't' for the closest point on the infinite line
IF LengthSq > 0 THEN
T = ScalarProjection / LengthSq
ELSE
' The segment has zero length (StartPoint equals EndPoint), so the closest point is StartPoint
T = 0
END IF
' Clamp 't' to the range [0, 1] to ensure the closest point is on the line segment
IF T < 0 THEN
T = 0
ELSEIF T > 1 THEN
T = 1
END IF
' Calculate the final result point on the line segment
ResultPoint.X = StartPoint.X + T * Vector_AB.X
ResultPoint.Y = StartPoint.Y + T * Vector_AB.Y
END SUB
SUB InitShapes
DIM I AS INTEGER, shapeType AS INTEGER
DIM Post AS Vector, Wh AS Vector
DIM Vertices(10) AS Vector ' Temp array for polygon vertices
RANDOMIZE TIMER ' Seed the random number generator
FOR I = 0 TO MAX_SHAPES - 1
shapeType = INT(RND * 4) + 1 ' Randomly pick a shape type
shapeType = SHAPE_POLYGON '//temp
Post.X = RND * _WIDTH
Post.Y = RND * _HEIGHT
SELECT CASE shapeType
CASE SHAPE_CIRCLE
CALL Shape_NewCircle(Shapes(I), Post, 5 + RND * 20, 10 + RND * 40)
Shapes(I).Velocity.X = (RND * 2 - 1) * 50
Shapes(I).Velocity.Y = (RND * 2 - 1) * 50
CASE SHAPE_BOX
Wh.X = 10 + RND * 40
Wh.Y = 10 + RND * 40
CALL Shape_NewBox(Shapes(I), Post, Wh, 10 + RND * 40)
Shapes(I).Rotation = RND * 2 * _PI
Shapes(I).Rotation_Speed = (RND * 2 - 1) * 0.5
Shapes(I).Velocity.X = (RND * 2 - 1) * 50
Shapes(I).Velocity.Y = (RND * 2 - 1) * 50
CASE SHAPE_TRIANGLE
Vertices(0).X = -15: Vertices(0).Y = -15
Vertices(1).X = 15: Vertices(1).Y = -15
Vertices(2).X = 0: Vertices(2).Y = 15
CALL Shape_NewPolygon(Shapes(I), Post, Vertices(), 3, 10 + RND * 20)
Shapes(I).Rotation = RND * 2 * _PI
Shapes(I).Rotation_Speed = (RND * 2 - 1) * 0.5
Shapes(I).Velocity.X = (RND * 2 - 1) * 50
Shapes(I).Velocity.Y = (RND * 2 - 1) * 50
CASE SHAPE_POLYGON
DIM sides AS INTEGER: sides = INT(RND * 6) + 3 ' 5 to 8 sides
DIM angleStep AS SINGLE: angleStep = 2 * _PI / sides
DIM radius AS SINGLE: radius = 15 + RND * 15
FOR J = 0 TO sides - 1
Vertices(J).X = COS(J * angleStep) * radius
Vertices(J).Y = SIN(J * angleStep) * radius
NEXT J
CALL Shape_NewPolygon(Shapes(I), Post, Vertices(), sides, 10 + RND * 40)
Shapes(I).Rotation = RND * 2 * _PI
Shapes(I).Rotation_Speed = (RND * 2 - 1) * 0.5
Shapes(I).Velocity.X = (RND * 2 - 1) * 50
Shapes(I).Velocity.Y = (RND * 2 - 1) * 50
END SELECT
Shapes(I).pColor = _RGB32(RND * 255, RND * 255, RND * 255)
NEXT I
END SUB
SUB UpdateShapes (dt AS SINGLE)
DIM I AS INTEGER
DIM RotatedCorner AS Vector
DIM minX AS SINGLE, maxX AS SINGLE, minY AS SINGLE, maxY AS SINGLE
DIM Corner AS Vector
FOR I = 0 TO MAX_SHAPES - 1
' Update position and rotation
Shapes(I).Position.X = Shapes(I).Position.X + Shapes(I).Velocity.X * dt
Shapes(I).Position.Y = Shapes(I).Position.Y + Shapes(I).Velocity.Y * dt
Shapes(I).Rotation = Shapes(I).Rotation + Shapes(I).Rotation_Speed * dt
' Screen wrapping based on shape type
SELECT CASE Shapes(I).ShapeType
CASE SHAPE_CIRCLE
IF Shapes(I).Position.X + Shapes(I).Radius < 0 THEN Shapes(I).Position.X = _WIDTH + Shapes(I).Radius
IF Shapes(I).Position.X - Shapes(I).Radius > _WIDTH THEN Shapes(I).Position.X = 0 - Shapes(I).Radius
IF Shapes(I).Position.Y + Shapes(I).Radius < 0 THEN Shapes(I).Position.Y = _HEIGHT + Shapes(I).Radius
IF Shapes(I).Position.Y - Shapes(I).Radius > _HEIGHT THEN Shapes(I).Position.Y = 0 - Shapes(I).Radius
CASE SHAPE_BOX
' Simplified wrapping for box
DIM halfW AS SINGLE: halfW = Shapes(I).WidthHeight.X / 2
DIM halfH AS SINGLE: halfH = Shapes(I).WidthHeight.Y / 2
IF Shapes(I).Position.X + halfW < 0 THEN Shapes(I).Position.X = _WIDTH + halfW
IF Shapes(I).Position.X - halfW > _WIDTH THEN Shapes(I).Position.X = 0 - halfW
IF Shapes(I).Position.Y + halfH < 0 THEN Shapes(I).Position.Y = _HEIGHT + halfH
IF Shapes(I).Position.Y - halfH > _HEIGHT THEN Shapes(I).Position.Y = 0 - halfH
CASE ELSE ' Polygons
minX = 1000000!: maxX = -1000000!
minY = 1000000!: maxY = -1000000!
FOR J = 0 TO Shapes(I).numpoints - 1
CALL Shape_GetVertex(Shapes(I), J, Corner)
Corner.X = Shapes(I).Position.X + Corner.X
Corner.Y = Shapes(I).Position.Y + Corner.Y
IF Corner.X < minX THEN minX = Corner.X
IF Corner.X > maxX THEN maxX = Corner.X
IF Corner.Y < minY THEN minY = Corner.Y
IF Corner.Y > maxY THEN maxY = Corner.Y
NEXT J
IF maxX < 0 THEN Shapes(I).Position.X = _WIDTH + (Shapes(I).Position.X - minX)
IF minX > _WIDTH THEN Shapes(I).Position.X = 0 - (maxX - Shapes(I).Position.X)
IF maxY < 0 THEN Shapes(I).Position.Y = _HEIGHT + (Shapes(I).Position.Y - minY)
IF minY > _HEIGHT THEN Shapes(I).Position.Y = 0 - (maxY - Shapes(I).Position.Y)
END SELECT
' Manage flash timer
IF Shapes(I).FlashTimer > 0 THEN
Shapes(I).FlashTimer = Shapes(I).FlashTimer - dt
END IF
NEXT I
END SUB
SUB RenderShapes
DIM I AS INTEGER, J AS INTEGER
DIM pColor AS LONG
DIM prevX AS SINGLE, prevY AS SINGLE
DIM CurrentVertex AS Vector, RotatedVertex AS Vector, Vector(0, 0) AS Vector
DIM ShapeCenter AS Vector
FOR I = 0 TO MAX_SHAPES - 1
IF Shapes(I).FlashTimer > 0 THEN
pColor = _RGB32(255, 255, 255) ' White flash color
ELSE
pColor = Shapes(I).pColor
END IF
SELECT CASE Shapes(I).ShapeType
CASE SHAPE_CIRCLE
CIRCLE (Shapes(I).Position.X, Shapes(I).Position.Y), Shapes(I).Radius, pColor
CASE SHAPE_BOX
' Calculate corners and draw lines
ShapeCenter.X = Shapes(I).Position.X + Shapes(I).RotationPointOffset.X
ShapeCenter.Y = Shapes(I).Position.Y + Shapes(I).RotationPointOffset.Y
DIM HalfW AS SINGLE: HalfW = Shapes(I).WidthHeight.X / 2
DIM HalfH AS SINGLE: HalfH = Shapes(I).WidthHeight.Y / 2
REDIM Corners(3) AS Vector
Corners(0).X = ShapeCenter.X - HalfW: Corners(0).Y = ShapeCenter.Y - HalfH
Corners(1).X = ShapeCenter.X + HalfW: Corners(1).Y = ShapeCenter.Y - HalfH
Corners(2).X = ShapeCenter.X + HalfW: Corners(2).Y = ShapeCenter.Y + HalfH
Corners(3).X = ShapeCenter.X - HalfW: Corners(3).Y = ShapeCenter.Y + HalfH
FOR J = 0 TO 3
CALL RotateVector(Corners(J), ShapeCenter, Shapes(I).Rotation)
NEXT J
FOR J = 0 TO 3
LINE (Corners(J).X, Corners(J).Y)-(Corners((J + 1) MOD 4).X, Corners((J + 1) MOD 4).Y), pColor
NEXT J
CASE SHAPE_TRIANGLE, SHAPE_POLYGON
IF Shapes(I).numpoints > 0 THEN
ShapeCenter.X = Shapes(I).Position.X + Shapes(I).RotationPointOffset.X
ShapeCenter.Y = Shapes(I).Position.Y + Shapes(I).RotationPointOffset.Y
CALL Shape_GetVertex(Shapes(I), 0, CurrentVertex)
RotatedVertex = CurrentVertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shapes(I).Rotation)
prevX = RotatedVertex.X + Shapes(I).Position.X
prevY = RotatedVertex.Y + Shapes(I).Position.Y
FOR J = 1 TO Shapes(I).numpoints - 1
CALL Shape_GetVertex(Shapes(I), J, CurrentVertex)
RotatedVertex = CurrentVertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shapes(I).Rotation)
LINE (prevX, prevY)-(RotatedVertex.X + Shapes(I).Position.X, RotatedVertex.Y + Shapes(I).Position.Y), pColor
prevX = RotatedVertex.X + Shapes(I).Position.X
prevY = RotatedVertex.Y + Shapes(I).Position.Y
NEXT J
' Connect the last vertex to the first
CALL Shape_GetVertex(Shapes(I), 0, CurrentVertex)
RotatedVertex = CurrentVertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shapes(I).Rotation)
LINE (prevX, prevY)-(RotatedVertex.X + Shapes(I).Position.X, RotatedVertex.Y + Shapes(I).Position.Y), pColor
END IF
END SELECT
NEXT I
END SUB
FUNCTION Intersect_PolygonPolygon (Polygon1 AS Shape, Polygon2 AS Shape)
DIM I AS INTEGER, J AS INTEGER
DIM Vertex1 AS Vector, Vertex2 AS Vector, EdgeNormal AS Vector, Vector(0, 0) AS Vector
DIM Min1 AS SINGLE, Max1 AS SINGLE, Min2 AS SINGLE, Max2 AS SINGLE
DIM Edge AS Vector
' Project onto axes of Polygon1
FOR I = 0 TO Polygon1.numpoints - 1
' Get edge vector
CALL Shape_GetVertex(Polygon1, I, Vertex1)
CALL Shape_GetVertex(Polygon1, (I + 1) MOD Polygon1.numpoints, Vertex2)
Edge.X = Vertex2.X - Vertex1.X
Edge.Y = Vertex2.Y - Vertex1.Y
' Get normal to the edge
EdgeNormal.X = -Edge.Y
EdgeNormal.Y = Edge.X
length = SQR(EdgeNormal.X * EdgeNormal.X + EdgeNormal.Y * EdgeNormal.Y)
IF length > 0 THEN
EdgeNormal.X = EdgeNormal.X / length
EdgeNormal.Y = EdgeNormal.Y / length
END IF
' Rotate normal to world space
CALL RotateVector(EdgeNormal, Vector(0, 0), Polygon1.Rotation)
' Project polygons onto this axis
CALL ProjectPolygon(Polygon1, EdgeNormal, Min1, Max1)
CALL ProjectPolygon(Polygon2, EdgeNormal, Min2, Max2)
' Check for overlap
IF NOT Overlap(Min1, Max1, Min2, Max2) THEN
Intersect_PolygonPolygon = 0
EXIT FUNCTION
END IF
NEXT I
' Project onto axes of Polygon2
FOR I = 0 TO Polygon2.numpoints - 1
' Get edge vector
CALL Shape_GetVertex(Polygon2, I, Vertex1)
CALL Shape_GetVertex(Polygon2, (I + 1) MOD Polygon2.numpoints, Vertex2)
Edge.X = Vertex2.X - Vertex1.X
Edge.Y = Vertex2.Y - Vertex1.Y
' Get normal to the edge
EdgeNormal.X = -Edge.Y
EdgeNormal.Y = Edge.X
length = SQR(EdgeNormal.X * EdgeNormal.X + EdgeNormal.Y * EdgeNormal.Y)
IF length > 0 THEN
EdgeNormal.X = EdgeNormal.X / length
EdgeNormal.Y = EdgeNormal.Y / length
END IF
' Rotate normal to world space
CALL RotateVector(EdgeNormal, Vector(0, 0), Polygon2.Rotation)
' Project polygons onto this axis
CALL ProjectPolygon(Polygon1, EdgeNormal, Min1, Max1)
CALL ProjectPolygon(Polygon2, EdgeNormal, Min2, Max2)
' Check for overlap
IF NOT Overlap(Min1, Max1, Min2, Max2) THEN
Intersect_PolygonPolygon = 0
EXIT FUNCTION
END IF
NEXT I
' If no separating axis found, there is a collision
Intersect_PolygonPolygon = -1
END FUNCTION
' Helper sub to project a polygon onto an axis
SUB ProjectPolygon (Shape AS Shape, Axis AS Vector, Min AS SINGLE, Max AS SINGLE)
DIM I AS INTEGER
DIM Vertex AS Vector, Vector(0, 0) AS Vector
DIM RotatedVertex AS Vector
DIM Projection AS SINGLE
' Rotate first vertex to world space
CALL Shape_GetVertex(Shape, 0, Vertex)
RotatedVertex = Vertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shape.Rotation)
RotatedVertex.X = RotatedVertex.X + Shape.Position.X
RotatedVertex.Y = RotatedVertex.Y + Shape.Position.Y
' Project first vertex onto axis
Projection = RotatedVertex.X * Axis.X + RotatedVertex.Y * Axis.Y
Min = Projection
Max = Projection
' Loop through remaining vertices
FOR I = 1 TO Shape.numpoints - 1
CALL Shape_GetVertex(Shape, I, Vertex)
RotatedVertex = Vertex
CALL RotateVector(RotatedVertex, Vector(0, 0), Shape.Rotation)
RotatedVertex.X = RotatedVertex.X + Shape.Position.X
RotatedVertex.Y = RotatedVertex.Y + Shape.Position.Y
' Project vertex onto axis
Projection = RotatedVertex.X * Axis.X + RotatedVertex.Y * Axis.Y
' Update min and max projections
IF Projection < Min THEN Min = Projection
IF Projection > Max THEN Max = Projection
NEXT I
END SUB
' Helper function to check if two intervals overlap
FUNCTION Overlap (Min1 AS SINGLE, Max1 AS SINGLE, Min2 AS SINGLE, Max2 AS SINGLE)
IF Min1 <= Max2 AND Min2 <= Max1 THEN
Overlap = -1
ELSE
Overlap = 0
END IF
END FUNCTIONWhat WE (the community) is lacking currently is, FAST pixel perfect sprites collisions and ANY 3d bounding box/sphere collisions...give me one of them and i'll give you +2!
Unseen
(Dont take this as a cuss please, I love things like this!)