Hipmunk-5.0.0: A Haskell binding for Chipmunk.Source codeContentsIndex
Physics.Hipmunk.Shape
Portabilityportable (needs FFI)
Stabilityprovisional
Maintainerfelipe.lessa@gmail.com
Contents
Shapes
Properties
Collision type
Group
Layers
Elasticity
Friction
Surface velocity
Utilities
For polygons
Description
Shapes used for collisions, their properties and some useful polygon functions.
Synopsis
data Shape
data ShapeType
= Circle {
radius :: !Distance
}
| LineSegment {
start :: !Position
end :: !Position
thickness :: !Distance
}
| Polygon {
vertices :: ![Position]
}
newShape :: Body -> ShapeType -> Position -> IO Shape
type CollisionType = Word32
getCollisionType :: Shape -> IO CollisionType
setCollisionType :: Shape -> CollisionType -> IO ()
type Group = Word32
getGroup :: Shape -> IO Group
setGroup :: Shape -> Group -> IO ()
type Layers = Word32
getLayers :: Shape -> IO Layers
setLayers :: Shape -> Layers -> IO ()
type Elasticity = CpFloat
getElasticity :: Shape -> IO Elasticity
setElasticity :: Shape -> Elasticity -> IO ()
type Friction = CpFloat
getFriction :: Shape -> IO Friction
setFriction :: Shape -> Friction -> IO ()
type SurfaceVel = Vector
getSurfaceVel :: Shape -> IO SurfaceVel
setSurfaceVel :: Shape -> SurfaceVel -> IO ()
getBody :: Shape -> Body
moment :: Mass -> ShapeType -> Position -> Moment
momentForCircle :: Mass -> (Distance, Distance) -> Position -> Moment
momentForSegment :: Mass -> Position -> Position -> Moment
momentForPoly :: Mass -> [Position] -> Position -> Moment
shapePointQuery :: Shape -> Position -> Layers -> Group -> IO Bool
shapeSegmentQuery :: Shape -> Position -> Position -> Layers -> Group -> IO (Maybe (CpFloat, Vector))
type Segment = (Position, Position)
data Intersection
= IntNowhere
| IntPoint !Position
| IntSegmt !Segment
epsilon :: CpFloat
(.==.) :: CpFloat -> CpFloat -> Bool
isLeft :: (Position, Position) -> Position -> Ordering
isClockwise :: [Position] -> Bool
isConvex :: [Position] -> Bool
intersects :: Segment -> Segment -> Intersection
polyReduce :: Distance -> [Position] -> [Position]
polyCenter :: [Position] -> Position
convexHull :: [Position] -> [Position]
Shapes
data Shape Source

A collision shape is attached to a Body to define its shape. Multiple shapes may be attached, including overlapping ones (shapes of a body don't generate collisions with each other).

Note that to have any effect, a Shape must also be added to a Space, even if the body was already added.

show/hide Instances
data ShapeType Source
There are three types of shapes that can be attached to bodies:
Constructors
CircleA circle is the fastest collision type. It also rolls smoothly.
radius :: !Distance
LineSegmentA line segment is meant to be used as a static shape. (It can be used with moving bodies, however two line segments never generate collisions between each other.)
start :: !Position
end :: !Position
thickness :: !Distance
PolygonPolygons are the slowest of all shapes but the most flexible. The list of vertices must form a convex hull with clockwise winding. Note that if you want a non-convex polygon you may add several convex polygons to the body.
vertices :: ![Position]
show/hide Instances
newShape :: Body -> ShapeType -> Position -> IO ShapeSource
newShape b type off creates a new shape attached to body b at offset off. Note that you have to add the shape to a space otherwise it won't generate collisions.
Properties
Collision type
type CollisionType = Word32Source
The collision type is used to determine which collision callback will be called. Its actual value doesn't have a meaning for Chipmunk other than the correspondence between shapes and the collision pair functions you add. (default is zero)
getCollisionType :: Shape -> IO CollisionTypeSource
setCollisionType :: Shape -> CollisionType -> IO ()Source
Group
type Group = Word32Source

Groups are used to filter collisions between shapes. If the group is zero, then it imposes no restriction to the collisions. However, if the group is non-zero then the shape will not collide with other shapes in the same non-zero group. (default is zero)

This is primarely used to create multi-body, multi-shape objects such as ragdolls. It may be thought as a lightweight alternative to creating a callback that filters the collisions.

getGroup :: Shape -> IO GroupSource
setGroup :: Shape -> Group -> IO ()Source
Layers
type Layers = Word32Source

Layers are similar to groups, but use a bitmask. For a collision to occur, two shapes must have at least one layer in common. In other words, layer1 .&. layer2 should be non-zero. (default is -1, meaning all bits set)

Note that although this type may have more than 32 bits, for portability you should only rely on the lower 32 bits.

getLayers :: Shape -> IO LayersSource
setLayers :: Shape -> Layers -> IO ()Source
Elasticity
type Elasticity = CpFloatSource

The elasticity of the shape is such that 0.0 gives no bounce while 1.0 give a "perfect" bounce. Note that due to inaccuracies using 1.0 or greater is not recommended.

The amount of elasticity applied during a collision is calculated by multiplying the elasticity of both shapes. (default is zero)

IMPORTANT: by default old-style elastic iterations are done when the space steps, which may result in a not-so-good simulation. It may be a good idea to use setElasticIterations with something greater than zero, maybe 10.

getElasticity :: Shape -> IO ElasticitySource
setElasticity :: Shape -> Elasticity -> IO ()Source
Friction
type Friction = CpFloatSource

The friction coefficient of the shape according to Coulumb friction model (i.e. 0.0 is frictionless, iron on iron is around 1.0, and it could be greater then 1.0).

The amount of friction applied during a collision is determined by multiplying the friction coefficient of both shapes. (default is zero)

getFriction :: Shape -> IO FrictionSource
setFriction :: Shape -> Friction -> IO ()Source
Surface velocity
type SurfaceVel = VectorSource
The surface velocity of the shape. Useful to create conveyor belts and players that move around. This value is only used when calculating friction, not collision. (default is zero)
getSurfaceVel :: Shape -> IO SurfaceVelSource
setSurfaceVel :: Shape -> SurfaceVel -> IO ()Source
Utilities
getBody :: Shape -> BodySource
getBody s is the body that this shape is associated to. Useful especially in a space callback.
moment :: Mass -> ShapeType -> Position -> MomentSource
moment m s off is a convenience function that calculates the moment of inertia for shape s with mass m and at a offset off of the body's center. Uses momentForCircle, momentForSegment and momentForPoly internally.
momentForCircle :: Mass -> (Distance, Distance) -> Position -> MomentSource
momentForCircle m (ri,ro) off is the moment of inertia of a circle of m mass, inner radius of ri, outer radius of ro and at an offset off from the center of the body.
momentForSegment :: Mass -> Position -> Position -> MomentSource
momentForSegment m p1 p2 is the moment of inertia of a segment of mass m going from point p1 to point p2.
momentForPoly :: Mass -> [Position] -> Position -> MomentSource
momentForPoly m verts off is the moment of inertia of a polygon of m mass, at offset off from the center of the body and comprised of verts vertices. This is similar to Polygon (and the same restrictions for the vertices apply as well).
shapePointQuery :: Shape -> Position -> Layers -> Group -> IO BoolSource
shapePointQuery shape p l g returns True iff the point in position p (in world's coordinates) lies within the shape shape, is not of the same group and share at least one layer.
shapeSegmentQuery :: Shape -> Position -> Position -> Layers -> Group -> IO (Maybe (CpFloat, Vector))Source
shapeSegmentQuery shape p1 p2 l g returns Just (t,n) iff the segment from p1 to p2 (in world's coordinates) intersects with the shape shape, is not of the same group and share at least one layer. In that case, 0 <= t <= 1 indicates that one of the intersections is at point p1 + (p2 - p1) `scale` t with normal n.
For polygons

This section is inspired by pymunk.util, a Python module made from http://code.google.com/p/pymunk/, although implementations are quite different.

Also, unless noted otherwise all polygons are assumed to be simple (i.e. no overlapping edges).

type Segment = (Position, Position)Source
A line segment.
data Intersection Source
A possible intersection between two segments.
Constructors
IntNowhereDon't intercept.
IntPoint !PositionIntercept in a point.
IntSegmt !SegmentShare a segment.
show/hide Instances
epsilon :: CpFloatSource
The epsilon used in the algorithms below when necessary to compare floats for "equality".
(.==.) :: CpFloat -> CpFloat -> BoolSource
"Equality" under epsilon. That is, a .==. b if abs (a - b) <= epsilon.
isLeft :: (Position, Position) -> Position -> OrderingSource

isLeft (p1,p2) vert is

  • LT if vert is at the left of the line defined by (p1,p2).
  • EQ if vert is at the line (p1,p2).
  • GT otherwise.
isClockwise :: [Position] -> BoolSource
O(n). isClockwise verts is True iff verts form a clockwise polygon.
isConvex :: [Position] -> BoolSource
O(n). isConvex verts is True iff vers form a convex polygon.
intersects :: Segment -> Segment -> IntersectionSource
O(1). intersects seg1 seg2 is the intersection between the two segments seg1 and seg2. See Intersection.
polyReduce :: Distance -> [Position] -> [Position]Source

O(n). polyReduce delta verts removes from verts all points that have less than delta distance in relation to the one preceding it.

Note that a very small polygon may be completely "eaten" if all its vertices are within a delta radius from the first.

polyCenter :: [Position] -> PositionSource
O(n). polyCenter verts is the position in the center of the polygon formed by verts.
convexHull :: [Position] -> [Position]Source

O(n log n). convexHull verts is the convex hull of the polygon defined by verts. The vertices of the convex hulls are given in clockwise winding. The polygon doesn't have to be simple.

Implemented using Graham scan, see http://cgm.cs.mcgill.ca/~beezer/cs507/3coins.html.

Produced by Haddock version 2.4.2