mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-12 00:23:08 +00:00
14c6f7bca8
* Basic 2D physics support. * PolyShape: Code for decomposing arbitrary shapes into convex polygons. Former-commit-id: 6cdce508f8bb7b6a20833d1e5204b93e7b19707f
88 lines
2.8 KiB
Haskell
Executable file
88 lines
2.8 KiB
Haskell
Executable file
#!/usr/bin/env stack
|
|
-- stack runghc --package reanimate
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
module Main (main) where
|
|
|
|
import Chiphunk.Low
|
|
import Control.Lens
|
|
import Data.Text (Text, pack)
|
|
import Graphics.SvgTree hiding (Text)
|
|
import Numeric
|
|
import Reanimate.Chiphunk
|
|
import Reanimate.Driver (reanimate)
|
|
import Reanimate.LaTeX
|
|
import Reanimate.Monad
|
|
import Reanimate.Signal
|
|
import Reanimate.Constants
|
|
import Reanimate.Svg
|
|
import System.IO.Unsafe
|
|
|
|
|
|
test :: Animation
|
|
test = unsafePerformIO $ do
|
|
bodyStore <- newBodyStore
|
|
let gravity = Vect 0 (-10)
|
|
|
|
-- Create an empty space.
|
|
space <- spaceNew
|
|
spaceGravity space $= gravity
|
|
|
|
-- 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.
|
|
static <- get $ spaceStaticBody space
|
|
ground <- segmentShapeNew static
|
|
(Vect (-screenWidth/2) 0)
|
|
(Vect (screenWidth/2) (-screenHeight/2)) 0
|
|
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 Body to give it a size and shape.
|
|
|
|
let radius = 1
|
|
let mass = 1
|
|
|
|
-- The moment of inertia is like mass for rotation
|
|
-- Use the momentFor* functions to help you approximate it.
|
|
let moment = momentForCircle mass 0 radius (Vect 0 0)
|
|
|
|
-- The spaceAdd* functions return the thing that you are adding.
|
|
ballBody <- bodyNew mass moment
|
|
spaceAddBody space ballBody
|
|
bodyPosition ballBody $= Vect 0 (screenHeight/2)
|
|
|
|
-- 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)
|
|
spaceAddShape space ballShape
|
|
shapeFriction ballShape $= 0.7
|
|
|
|
addToBodyStore bodyStore ballBody $
|
|
withFillColor "white" $
|
|
mkGroup
|
|
[ mkCircle (Num radius)
|
|
, withStrokeColor "black" $
|
|
mkLine (Num 0, Num 0) (Num 0, Num radius) ]
|
|
|
|
ani <- simulate space bodyStore 60 3 4
|
|
|
|
shapeFree ballShape
|
|
bodyFree ballBody
|
|
shapeFree ground
|
|
spaceFree space
|
|
return ani
|
|
|
|
|
|
main :: IO ()
|
|
main = reanimate $ bg `sim` line `sim` test
|
|
where
|
|
bg = mkAnimation 0 $ emit $ mkBackground "black"
|
|
line = mkAnimation 0 $ emit $ withStrokeColor "white" $
|
|
withStrokeWidth (Num 0.01) $
|
|
mkLine (Num (-screenWidth/2), Num 0)
|
|
(Num (screenWidth/2), Num $ -screenHeight/2)
|