diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,4 +2,5 @@ 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. +See app/Main.hs for quick example of usage. Rendering is done by NanoVG, you will need pkg-config +to have GLU and GLEW files (e.g. `aptitude install libglu-dev libglew-dev` on Ubuntu), diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,168 @@ +{-# 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/120 + 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) . + mconcat <$> + sequence (fmap 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) $ + mconcat + [ 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 @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 3b21f15c38f8966ef0527241feb3899a7e824712920c28672784293c6a71c98b +-- hash: affa04d0e05ec0c06f300e0e619be66311279ba5faa40e044602907b6e933043 name: chiphunk -version: 0.1.2.2 +version: 0.1.3.0 synopsis: Haskell bindings for Chipmunk2D physics engine description: Please see the README on GitHub at category: Physics @@ -53,6 +53,10 @@ src/Chiphunk/wrapper.h Chipmunk2D-7.0.2/src/prime.h +flag library-only + manual: False + default: True + library exposed-modules: Chiphunk.Low @@ -121,3 +125,20 @@ Chipmunk2D-7.0.2/src/cpSweep1D.c src/Chiphunk/wrapper.c + +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.5.0.0 && <0.6 + if flag(library-only) + buildable: False + default-language: Haskell2010 diff --git a/src/Chiphunk/Low.hs b/src/Chiphunk/Low.hs --- a/src/Chiphunk/Low.hs +++ b/src/Chiphunk/Low.hs @@ -94,6 +94,12 @@ -- then rolls off. Print out the coordinates of the ball. -- -- @ + -- module Main where + -- + -- import Chiphunk.Low + -- import Text.Printf (printf) + -- import Control.Concurrent (threadDelay) + -- -- main :: IO () -- main = do -- let gravity = 'Vect' 0 (-100) @@ -138,12 +144,13 @@ -- -- 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 2 timeStep $ \time -> do + -- runFor 2 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" + -- 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 $ 1000000 * timeStep -- 'spaceStep' space timeStep -- -- 'shapeFree' ballShape