diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,3 +1,5 @@ # chiphunk Chiphunk is a Haskell bindings for Chipmunk2D physics library. See `Chiphunk.Low` module for documentation. + +Simple examples of usage can be found in `chiphunk-example` package. diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 --- a/app/Main.hs +++ /dev/null @@ -1,168 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -module Main where - -import Chiphunk.Low -import Data.Functor -import Text.Printf (printf) -import Control.Monad -import Control.Concurrent.MVar -import Control.Concurrent (threadDelay) -import Control.Concurrent.Async - -import qualified Graphics.NanoVG.Simple as N -import qualified Graphics.NanoVG.Picture as N -import qualified NanoVG as NVG -import Data.IORef - -main :: IO () -main = do - dm <- newEmptyMVar - race_ - (simulate dm) - (display dm) - -simulate :: MVar [VisObj] -> IO () -simulate dm = do - let gravity = Vect 0 (-100) - -- Create an empty space. - space <- spaceNew - spaceGravity space $= gravity - - static <- get $ spaceStaticBody space - - -- Add a static line segment shape for the ground. - -- We'll make it slightly tilted so the ball will roll off. - -- We attach it to a static body to tell Chipmunk it shouldn't be movable. - let (segA, segB) = (Vect (-20) (-5), Vect 20 (-25)) - ground <- segmentShapeNew static segA segB 0 - shapeElasticity ground $= 0.6 - shapeFriction ground $= 1 - - spaceAddShape space ground - - -- Now let's make a ball that falls onto the line and rolls off. - -- First we need to make a cpBody to hold the physical properties of the object. - -- These include the mass, position, velocity, angle, etc. of the object. - -- Then we attach collision shapes to the cpBody to give it a size and shape. - - let radius = 5 - let mass = 1 - let mass100 = 100 - - -- The moment of inertia is like mass for rotation - -- Use the cpMomentFor*() functions to help you approximate it. - let moment = momentForCircle mass 0 radius (Vect 0 0) - let moment100 = momentForCircle mass100 0 radius (Vect 0 0) - - -- The cpSpaceAdd*() functions return the thing that you are adding. - -- It's convenient to create and add an object in one line. - ballBody <- bodyNew mass moment - spaceAddBody space ballBody - - -- Now we create the collision shape for the ball. - -- You can create multiple collision shapes that point to the same body. - -- They will all be attached to the body and move around to follow it. - ballShape <- circleShapeNew ballBody radius (Vect 0 0) - shapeFriction ballShape $= 0.9 - shapeElasticity ballShape $= 1 - spaceAddShape space ballShape - - anotherBall <- bodyNew mass100 moment100 - spaceAddBody space anotherBall - - anotherBallShape <- circleShapeNew anotherBall radius (Vect 0 0) - shapeFriction anotherBallShape $= 0.9 - shapeElasticity anotherBallShape $= 0.4 - spaceAddShape space anotherBallShape - - putMVar dm - [ mkStaticObj $ Segment segA segB - , mkBallBody ballBody radius - , mkBallBody anotherBall radius - ] - - void $ forever $ do - bodyPosition ballBody $= Vect (-15) 30 - bodyPosition anotherBall $= Vect (-5) 75 - -- need to reset ball velocity after previous iteration - bodyVelocity ballBody $= Vect 0 0 - bodyAngularVelocity ballBody $= 0 - bodyVelocity anotherBall $= Vect 0 0 - bodyAngularVelocity anotherBall $= 0 - - -- Now that it's all set up, we simulate all the objects in the space by - -- stepping forward through time in small increments called steps. - -- It is *highly* recommended to use a fixed size time step. - let timeStep = 1/60 - runFor 3 timeStep $ \time -> do - pos <- get $ bodyPosition ballBody - vel <- get $ bodyVelocity ballBody - printf "Time is %4.2f. ballBody is at (%6.2f, %6.2f), it's velocity is (%6.2f, %6.2f).\n" - time (vX pos) (vY pos) (vX vel) (vY vel) - - threadDelay $ round $ timeStep * 1000 * 1000 - spaceStep space timeStep - - shapeFree ballShape - bodyFree ballBody - shapeFree ground - spaceFree space - where - runFor time step inner = go time - where - go time' - | time' <= 0 = pure () - | otherwise = inner (time - time') *> go (time' - step) - -display :: MVar [VisObj] -> IO () -display dm = do - d <- takeMVar dm - N.run 800 600 "Chiphunk" $ - N.showFPS "Liberation Sans" $ - N.loadFont "/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf" "Liberation Sans" $ - N.asWindow $ - N.translateP 400 300 . - N.scaleP' (0, 0) 10 . - N.scalePy (0, 0) (-1) . - N.pictures <$> - sequence ((render <$>) . runVisObj <$> d) - where - render = \case - Segment (Vect ax ay) (Vect bx by) -> N.stroke (NVG.Color 1 1 1 1) $ - N.line (realToFrac ax, realToFrac ay) (realToFrac bx, realToFrac by) - Ball (Vect x y) r a -> - let c = (realToFrac x, realToFrac y) - in N.stroke (NVG.Color 1 1 1 1) $ - N.rotateS c (realToFrac a) $ - N.shapes - [ N.circle c (realToFrac r) - , N.line c (realToFrac $ x - r / 2, realToFrac y) - ] - -data VisShape = - Segment - { segEndpointA :: Vect - , segEndpointB :: Vect - } - | Ball - { ballCenter :: Vect - , ballRadius :: Double - , ballAngle :: Double - } - deriving Show - -newtype VisObj = VisObj - { runVisObj :: IO VisShape - } - -mkRefObj :: IORef VisShape -> VisObj -mkRefObj r = VisObj $ readIORef r - -mkStaticObj :: VisShape -> VisObj -mkStaticObj = VisObj . pure - -mkBallBody :: Body -> Double -> VisObj -mkBallBody b r = VisObj $ Ball <$> get (bodyPosition b) - <*> pure r - <*> get (bodyAngle b) diff --git a/chiphunk.cabal b/chiphunk.cabal --- a/chiphunk.cabal +++ b/chiphunk.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.30.0. +-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack -- --- hash: f50e497ef36b7bccd11480031bfdf007228b47569437a09c2c2469d2e57c9968 +-- hash: e6e34b0f3a7347782c482b79a689d989bed10c837045db9756529b0b9ba1bc80 name: chiphunk -version: 0.1.0.3 +version: 0.1.1.0 synopsis: Haskell bindings for Chipmunk2D physics engine description: Please see the README on GitHub at category: Physics @@ -53,10 +53,6 @@ src/Chiphunk/wrapper.h Chipmunk2D-7.0.2/src/prime.h -flag library-only - manual: False - default: True - library exposed-modules: Chiphunk.Low @@ -79,6 +75,16 @@ include-dirs: Chipmunk2D-7.0.2/include src/Chiphunk + build-depends: + StateVar >=1.1.1.1 && <1.3 + , base >=4.7 && <5 + , hashable >=1.2.6.0 && <1.3 + , safe-exceptions >=0.1.7.0 && <0.2 + , vector-space >=0.13 && <0.17 + if os(darwin) + cpp-options: -D__attribute__(X)= -D_Null_unspecified= -D__asm(X)= -U__has_extension -DCP_USE_CGTYPES=0 + default-language: Haskell2010 + build-tool-depends: c2hs:c2hs >= 0.28.1 && < 0.29 c-sources: Chipmunk2D-7.0.2/src/chipmunk.c Chipmunk2D-7.0.2/src/cpConstraint.c @@ -114,27 +120,3 @@ Chipmunk2D-7.0.2/src/cpSweep1D.c src/Chiphunk/wrapper.c - build-depends: - StateVar >=1.1.1.1 && <1.2 - , base >=4.7 && <5 - , safe-exceptions >=0.1.7.0 && <0.2 - , vector-space >=0.13 && <0.16 - default-language: Haskell2010 - build-tool-depends: c2hs:c2hs >= 0.28.1 && < 0.29 - -executable chiphunk - main-is: Main.hs - other-modules: - Paths_chiphunk - hs-source-dirs: - app - ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N2 - build-depends: - async >=2.2.1 && <2.3 - , base >=4.7 && <5 - , chiphunk - , nanovg >=0.6.0.0 && <0.7 - , nanovg-simple >=0.4.0.0 && <0.5 - if flag(library-only) - buildable: False - default-language: Haskell2010 diff --git a/src/Chiphunk/Low/Types.chs b/src/Chiphunk/Low/Types.chs --- a/src/Chiphunk/Low/Types.chs +++ b/src/Chiphunk/Low/Types.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -23,17 +24,21 @@ ) where import Data.Cross +import Data.Hashable import Data.StateVar import Data.VectorSpace import Foreign +import GHC.Generics (Generic) #include -- | 2D vector packed into a struct. data Vect = Vect { vX :: !Double, vY :: !Double - } deriving (Eq, Show) + } deriving (Eq, Show, Ord, Generic) +instance Hashable Vect + instance AdditiveGroup Vect where zeroV = Vect 0 0 negateV (Vect x y) = Vect (-x) (-y) @@ -65,8 +70,10 @@ -- | Simple bounding box struct. Stored as left, bottom, right, top values. data BB = BB { bbL :: !Double, bbB :: !Double, bbR :: !Double, bbT :: !Double - } deriving (Show) + } deriving (Show, Eq, Ord, Generic) +instance Hashable BB + instance Storable BB where sizeOf _ = {# sizeof cpBB #} alignment _ = {# alignof cpBB #} @@ -88,7 +95,10 @@ -- | Rigid body somewhere in C code. {# pointer *cpBody as Body newtype #} + deriving (Eq, Ord, Generic) +instance Hashable Body + instance Storable Body where sizeOf (Body p) = sizeOf p alignment (Body p) = alignment p @@ -134,7 +144,10 @@ -- | Spaces in Chipmunk are the basic unit of simulation. You add rigid bodies, shapes, and constraints to the space -- and then step them all forward through time together. {# pointer *cpSpace as Space newtype #} + deriving (Eq, Ord, Generic) +instance Hashable Space + instance Storable Space where sizeOf (Space p) = sizeOf p alignment (Space p) = alignment p @@ -154,7 +167,10 @@ -- Combining multiple shapes gives you the flexibility to make any object you want -- as well as providing different areas of the same object with different friction, elasticity or callback values. {# pointer *cpShape as Shape newtype #} + deriving (Eq, Ord, Generic) +instance Hashable Shape + instance Storable Shape where sizeOf (Shape p) = sizeOf p alignment (Shape p) = alignment p @@ -165,7 +181,10 @@ -- Constraints can be simple joints that allow bodies to pivot around each other like the bones in your body, -- or they can be more abstract like the gear joint or motors. {# pointer *cpConstraint as Constraint newtype #} + deriving (Eq, Ord, Generic) +instance Hashable Constraint + instance Storable Constraint where sizeOf (Constraint p) = sizeOf p alignment (Constraint p) = alignment p @@ -182,7 +201,10 @@ -- It was a fun, fitting name and was shorter to type than CollisionPair which I had been using. -- It was originally meant to be a private internal structure only, but evolved to be useful from callbacks. {# pointer *cpArbiter as Arbiter newtype #} + deriving (Eq, Ord, Generic) +instance Hashable Arbiter + instance Storable Arbiter where sizeOf (Arbiter p) = sizeOf p alignment (Arbiter p) = alignment p @@ -192,7 +214,7 @@ -- | Type used for 2×3 affine transforms in Chipmunk. data Transform = Transform { tA :: !Double, tB :: !Double, tC :: !Double, tD :: !Double, tTx :: !Double, tTy :: !Double - } deriving Show + } deriving (Show, Eq) instance Storable Transform where sizeOf _ = {# sizeof cpTransform #}