2D physics simulations using Chipmunk2D. (#16)

* Basic 2D physics support. * PolyShape: Code for decomposing arbitrary shapes into convex polygons. Former-commit-id: 6cdce508f8bb7b6a20833d1e5204b93e7b19707f
2026-09-13 09:02:54 +00:00 · 2019-09-24 10:12:01 +08:00 · 2019-09-24 10:12:01 +08:00 · 14c6f7bca8
commit 14c6f7bca8
parent bb8f145868
15 changed files with 636 additions and 15 deletions
--- a/examples/polyshape_test1.hs
+++ b/examples/polyshape_test1.hs
@ -0,0 +1,116 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+module Main (main) where
+
+import           Chiphunk.Low
+import           Control.Lens        ()
+import           Data.List
+import           Data.Map            (Map)
+import qualified Data.Map            as Map
+import           Data.Ord
+import           Data.Set            (Set)
+import qualified Data.Set            as Set
+import           Data.Text           (Text, pack)
+import           Debug.Trace
+import           Geom2D.CubicBezier  (ClosedPath (..), CubicBezier (..),
+                                      PathJoin (..), bezierIntersection,
+                                      bezierLineIntersections, closedPathCurves,
+                                      evalBezier, rotateScaleVec, transform)
+import qualified Geom2D.CubicBezier  as G
+import           Graphics.SvgTree (Number(Num))
+import           Linear.V2
+import           Numeric
+import           Reanimate.Chiphunk
+import           Reanimate.Constants
+import           Reanimate.Driver    (reanimate)
+import           Reanimate.LaTeX
+import           Reanimate.Monad
+import           Reanimate.PolyShape
+import           Reanimate.Signal
+import           Reanimate.Svg
+import           System.IO.Unsafe
+
+
+polygonTest :: Animation
+polygonTest = mkAnimation 1 $ do
+    s <- getSignal signalLinear
+    emit $ std $ gridLayout $ transpose
+      [ test0, test1, test2, test3, test4, test5 ]
+  where
+    test0 = column ppA poly1
+    test1 = column ppA poly2
+    test2 = column ppA poly3
+    test3 = column ppA poly4
+    test4 = column ppB [boxPolyShape]
+    test5 = column ppB [starPolyShape]
+
+    column pp poly = map pp
+      [ poly
+      , map plFromPolygon $ plDecompose' 0.05 poly
+      , map plFromPolygon $ plDecompose poly ]
+
+
+    poly1 =
+      svgToPolyShapes $ lowerTransformations $
+      center $ scale 3 $
+      latex "$\\Phi$"
+    poly2 =
+      svgToPolyShapes $ lowerTransformations $
+      center $ scale 3 $
+      latex "$\\vartheta$"
+    poly3 =
+      svgToPolyShapes $ lowerTransformations $
+      center $ scale 3 $
+      latex "$\\Xi$"
+    poly4 =
+      svgToPolyShapes $ lowerTransformations $
+      center $ scale 3 $
+      latex "$\\Theta$"
+
+    ppA = renderPolyShapes
+    ppB = lowerTransformations . scale 0.6 . center . renderPolyShapes
+    std =
+      withFillOpacity 1 .
+      withFillColor "blue" .
+      withStrokeWidth (Num 0.01) .
+      withStrokeColor "white"
+    offset = 0.2
+
+
+
+boxPolyShape :: PolyShape
+boxPolyShape = PolyShape $ G.ClosedPath
+  [(G.Point 0 0, G.JoinLine)
+  ,(G.Point 0 3, G.JoinLine)
+  ,(G.Point 1 3, G.JoinLine)
+  ,(G.Point 1 1, G.JoinLine)
+  ,(G.Point 2 1, G.JoinLine)
+  ,(G.Point 2 2, G.JoinLine)
+  ,(G.Point 0 2, G.JoinLine)
+  ,(G.Point 0 3, G.JoinLine)
+  ,(G.Point 3 3, G.JoinLine)
+  ,(G.Point 3 0, G.JoinLine)
+  ]
+
+squarePolyShape :: PolyShape
+squarePolyShape = PolyShape $ G.ClosedPath
+  [(G.Point 0 0, G.JoinLine)
+  ,(G.Point 1 0, G.JoinLine)
+  ,(G.Point 1 1, G.JoinLine)
+  ,(G.Point 0 1, G.JoinLine)]
+
+starPolyShape :: PolyShape
+starPolyShape = PolyShape $ G.ClosedPath
+  [(G.Point 0 0, G.JoinLine)
+  ,(G.Point 1 2, G.JoinLine)
+  ,(G.Point 2 0, G.JoinLine)
+  ,(G.Point 0 1, G.JoinLine)
+  ,(G.Point 2 1, G.JoinLine)
+  ]
+
+main :: IO ()
+main = reanimate $ bg `sim` polygonTest
+  where
+    bg = mkAnimation 0 $ emit $ mkBackground "black"