First stab at physics example for tutorial.

Former-commit-id: 904d556aa1b0beaaeb8adae67dedd63c57abb6da

docs/gallery.md

@@ -211,3 +211,18 @@ This file is auto-generated by docs/render_all.sh. DO NOT EDIT.
 
 <br/><hr><br/>
 
+## tut_glue_physics
+
+<details>
+  <summary>View tut_glue_physics.hs</summary>
+  <pre><code class="haskell">
+  {!examples/tut_glue_physics.hs!}
+  </code></pre>
+</details>
+<br/>
+<video width="640" height="360" autoplay loop>
+  <source src="https://github.com/Lemmih/reanimate/raw/master/docs/rendered/tut_glue_physics.mp4">
+</video>
+
+<br/><hr><br/>
+

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))

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.
 
+<details>
+  <summary>Toggle source code.</summary>
+  <pre><code class="haskell">
+  {!examples/tut_glue_physics.hs!}
+  </code></pre>
+</details>
+<br/>
+<video width="640" height="360" autoplay loop>
+  <source src="../rendered/tut_glue_physics.mp4">
+  <source src="https://github.com/Lemmih/reanimate/raw/master/docs/rendered/tut_glue_physics.mp4">
+</video>
+
+
 ## Pillar II: LaTeX
 
 TODO: Show that LaTeX is a provider of SVG graphics. It has the type

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)
+

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 ()