diff --git a/docs/gallery.md b/docs/gallery.md
index 55a0478..767c287 100644
--- a/docs/gallery.md
+++ b/docs/gallery.md
@@ -211,3 +211,18 @@ This file is auto-generated by docs/render_all.sh. DO NOT EDIT.
+## tut_glue_physics
+
+
+ View tut_glue_physics.hs
+
+ {!examples/tut_glue_physics.hs!}
+
+
+
+
+
+
+
+
+
diff --git a/docs/gen_gallery.sh b/docs/gen_gallery.sh
index d7a369d..e93c0c1 100755
--- a/docs/gen_gallery.sh
+++ b/docs/gen_gallery.sh
@@ -3,7 +3,8 @@
ROOT=`stack path --project-root`
EXAMPLES='boundingbox colormaps goo latex_basic latex_color latex_draw
latex_wheel raster sphere blender_default_cube
- tut_glue_svg tut_glue_animate tut_glue_keyframe tut_glue_fourier'
+ tut_glue_svg tut_glue_animate tut_glue_keyframe tut_glue_fourier
+ tut_glue_physics'
WIDTH=640
HEIGHT=$((WIDTH*9/16))
diff --git a/docs/glue_tut.md b/docs/glue_tut.md
index ccedd14..9dce8fc 100644
--- a/docs/glue_tut.md
+++ b/docs/glue_tut.md
@@ -86,6 +86,19 @@ The following examples shows how something as seemingly complicated as fourier s
TODO: Write about how lots of libraries are available for Haskell. Use chiphunk
as an example. Show SVG primitives with 2D physics.
+
+ Toggle source code.
+
+ {!examples/tut_glue_physics.hs!}
+
+
+
+
+
+
+
+
+
## Pillar II: LaTeX
TODO: Show that LaTeX is a provider of SVG graphics. It has the type
diff --git a/examples/tut_glue_physics.hs b/examples/tut_glue_physics.hs
new file mode 100755
index 0000000..ee1f498
--- /dev/null
+++ b/examples/tut_glue_physics.hs
@@ -0,0 +1,72 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Main (main) where
+
+import Chiphunk.Low
+import Control.Monad
+import Graphics.SvgTree (Tree)
+import Linear.V2
+import Reanimate.Chiphunk
+import Reanimate
+import Reanimate.PolyShape
+import System.IO.Unsafe
+import Codec.Picture
+
+test :: Animation
+test = unsafePerformIO $ do
+ bodyStore <- newBodyStore
+ let gravity = Vect 0 (-1)
+
+ -- Create an empty space.
+ space <- spaceNew
+ -- spaceCollisionSlop space $= (screenWidth/2560)
+ spaceGravity space $= gravity
+
+ static <- get $ spaceStaticBody space
+ ground <- segmentShapeNew static
+ (Vect (-screenWidth/2) (-screenHeight/2))
+ (Vect (screenWidth/2) (-screenHeight/2)) 0
+ shapeFriction ground $= 1
+ spaceAddShape space ground
+ shapeElasticity ground $= 1
+
+ let toVect (V2 x y) = Vect x y
+
+ let svg = center $ scale 4 $ latex "$F=ma$"
+ poly = svgToPolyShapes svg
+ vectGroup = plDecompose poly
+
+ forM_ vectGroup $ \polygon -> do
+ bd <- polygonsToBody space [map toVect polygon]
+ bodyPosition bd $= Vect 0 (screenHeight/3)
+ addToBodyStore bodyStore bd $
+ renderPolyShape $ plFromPolygon polygon
+
+ ani <- simulate space bodyStore 60 10 10
+ spaceFreeRecursive space
+ return ani
+
+
+chunkPolyshapes :: Tree -> Tree
+chunkPolyshapes t =
+ mkGroup
+ [
+ withStrokeWidth 0.01 $
+ withStrokeColor "black" $
+ -- withFillOpacity 0 $
+ withFillColor "black" $
+ mkGroup $ map renderPolyShape $
+ svgToPolyShapes t
+ ]
+
+reorient :: Tree -> Tree
+reorient = id -- scale 6 . translate 0 (-0.9)
+
+
+main :: IO ()
+main = reanimate $ bg `parA` mapA reorient (mapA chunkPolyshapes test)
+ where
+ bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)
+
diff --git a/src/Reanimate/Chiphunk.hs b/src/Reanimate/Chiphunk.hs
index 3ff4ef9..b9fb3d2 100644
--- a/src/Reanimate/Chiphunk.hs
+++ b/src/Reanimate/Chiphunk.hs
@@ -87,6 +87,7 @@ polygonsToBody space polygons = do
shapeDensity polyShape $= 1
spaceAddShape space polyShape
shapeFriction polyShape $= 0.7
+ shapeElasticity polyShape $= 0.5
return plBody
spaceFreeRecursive :: Space -> IO ()