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