diff --git a/README.md b/README.md index 5964a49..31358d2 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,6 @@ # chiphunk Chiphunk is a Haskell bindings for Chipmunk2D physics library. See `Chiphunk.Low` module for documentation. + +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 index 0000000..6981ee8 --- /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 index 526a7f8..4e25ecf 100644 --- a/chiphunk.cabal +++ b/chiphunk.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- 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 @@ extra-source-files: 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 @@ library 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/package.yaml b/package.yaml index cb3ed31..ff18dd3 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ 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 homepage: https://github.com/CthulhuDen/chiphunk#readme @@ -124,3 +124,26 @@ library: Chipmunk2D-7.0.2/src/cpSweep1D.c src/Chiphunk/wrapper.c + +executables: + chiphunk: + when: + - condition: flag(library-only) + buildable: false + source-dirs: app + main: Main.hs + ghc-options: + - -O2 + - -threaded + - -rtsopts + - -with-rtsopts=-N2 + dependencies: + - chiphunk + - async >= 2.2.1 && < 2.3 + - nanovg >= 0.6.0.0 && < 0.7 + - nanovg-simple >= 0.5.0.0 && < 0.6 + +flags: + library-only: + default: true + manual: false diff --git a/stack.yaml b/stack.yaml index 332e2e4..b7b3083 100644 --- a/stack.yaml +++ b/stack.yaml @@ -3,4 +3,10 @@ resolver: lts-16.14 packages: - . -extra-deps: [] +extra-deps: + - nanovg-0.6.0.0 + - nanovg-simple-0.5.0.0 + +flags: + chiphunk: + library-only: false diff --git a/stack.yaml.lock b/stack.yaml.lock index 2c5dc5d..fd645fe 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -3,7 +3,21 @@ # For more information, please see the documentation at: # https://docs.haskellstack.org/en/stable/lock_files -packages: [] +packages: +- completed: + hackage: nanovg-0.6.0.0@sha256:326e73fe2c4ec56656fa42894c53a8e26b3e60449c69578f5f6da50c0ad60ed2,4146 + pantry-tree: + size: 2477 + sha256: a5e327e2216aea778723aeb77d8868376ff4999d1b3cd4d4fe17d38d0ff04265 + original: + hackage: nanovg-0.6.0.0 +- completed: + hackage: nanovg-simple-0.5.0.0@sha256:57a194573b63f7c22ba48376e02341aebde2d577e2898e75d6c669c69f6507e4,1895 + pantry-tree: + size: 725 + sha256: 3be82ff9c16cfd9476701eeba5020a27cd1f9c6767379acf522a77138dd9f240 + original: + hackage: nanovg-simple-0.5.0.0 snapshots: - completed: size: 532382