Add stars example. (#71)

Former-commit-id: cda8a6c63bc5be127c2b06dbab7482f16ed66cdb

README.md

@@ -33,8 +33,9 @@ main = reanimate $ docEnv $ playThenReverseA drawCircle
 [![Geo JSON](https://i.imgur.com/OrKiOqF.gif)](videos/map-projection/gif.hs)
 [![Object tracing](https://i.imgur.com/Y6NsPWF.gif)](examples/tut_glue_potrace.hs)
 
-## Mathematical typesetting
+## Mathematical typesetting and effects
 [![LaTeX](https://i.imgur.com/e6oO4wz.gif)](examples/tut_glue_latex.hs)
+[![Stars](https://i.imgur.com/yek3v4b.gif)](examples/demo_stars.hs)
 
 ## 2D physics and 3D graphics
 [![2D Physics](https://i.imgur.com/ZHUfWdp.gif)](examples/tut_glue_physics.hs)

examples/demo_stars.hs

@@ -0,0 +1,77 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ParallelListComp #-}
+module Main
+  ( main
+  )
+where
+
+import           Reanimate
+import           Reanimate.Interpolate
+import           Reanimate.Builtin.Documentation
+import           System.Random
+import Data.List
+import Codec.Picture.Types
+import qualified Data.Vector as V
+
+main :: IO ()
+main = reanimate $ sceneAnimation $ do
+  newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor
+  play $ trails 0.05 starAnimation
+
+starAnimation :: Animation
+starAnimation = mkAnimation 10 $ \t ->
+  let camZ = t * 4
+  in  withStrokeWidth 0 $ rotate (t * 360) $ mkGroup
+        [ translate (x / newZ) (y / newZ) $ dot (1 - newZ)
+        | (x, y, z) <-
+          reverse $ take nStars $ dropWhile (\(_, _, z) -> z < camZ) $ allStars
+        , let newZ = z - camZ
+        ]
+ where
+  black = PixelRGB8 0x0 0x0 0x0
+  dot o =
+    withFillColorPixel
+        ( promotePixel
+        $ interpolateRGB8 labComponents (dropTransparency rtfdBackgroundColor) black o
+        )
+      $ mkCircle 0.05
+
+{-# INLINE trails #-}
+trails :: Double -> Animation -> Animation
+trails trailDur raw = mkAnimation (duration raw) $ \t ->
+  let idx = round (t * fromIntegral nFrames)
+  in  construct $ reverse [idx - trailFrames .. idx]
+ where
+  fps = 200
+  construct []     = mkGroup []
+  construct (x:xs) = mkGroup
+    [ withGroupOpacity (fromIntegral trailFrames / fromIntegral (trailFrames + 1))
+      $ construct xs
+    , getFrame x
+    ]
+  trailFrames = round (trailDur * fps)
+  nFrames     = round (duration raw * fps)
+  getFrame idx = frames V.! (idx `mod` nFrames)
+  frames = V.fromList
+    [ frameAt (fromIntegral i / fromIntegral nFrames * duration raw) raw
+    | i <- [0 .. nFrames]
+    ]
+
+nStars :: Int
+nStars = 1000
+
+stars, allStars :: [(Double, Double, Double)]
+allStars = [ (x, y, z + n) | n <- [0 ..], (x, y, z) <- stars ]
+stars = sortOn takeZ $ take nStars
+  [ (x, y, z)
+  | x <- randomRs (-screenWidth/2, screenWidth/2) seedX
+  | y <- randomRs (-screenWidth/2, screenWidth/2) seedY
+  | z <- randomRs (0, 1) seedZ ]
+  where takeZ (_,_,z) = z
+
+seedX, seedY, seedZ :: StdGen
+seedX = mkStdGen 0xDEAFBEEF
+seedY = mkStdGen 0x12345678
+seedZ = mkStdGen 0x87654321

reanimate.cabal

@@ -111,7 +111,7 @@ library
                        containers, reanimate-svg >= 0.9.7.0, xml, bytestring, lens, linear, mtl, matrix,
                        JuicyPixels, attoparsec, parallel,
                        cubicbezier, websockets >= 0.12.7.0,
-                       hashable, fsnotify, open-browser, random-shuffle, base64-bytestring,
+                       hashable, fsnotify, open-browser, random, random-shuffle, base64-bytestring,
                        vector >= 0.12.0.0, colour, cassava, ansi-wl-pprint, here, temporary,
                        optparse-applicative, chiphunk >= 0.1.2.1,
                        geojson, aeson >= 1.3.0.0,