Add trails

Main.hs

@@ -5,6 +5,7 @@ module Main (main) where
 
 import Graphics.Gloss
 import Graphics.Gloss.Geometry.Angle
+import Graphics.Gloss.Data.ViewPort
 
 data PolarCoord = PolarCoord { radius :: Float, angle :: Float }
 
@@ -30,6 +31,12 @@ minorRadius = 5
 framesPerSecond :: Int
 framesPerSecond = 120
 
+trailLength :: Int
+trailLength = 720
+
+trailColor :: Color
+trailColor = greyN 0.7
+
 render :: State -> Picture
 render state = pictures [ circleSolid majorRadius
                         , translatePolar (position state) $ circleSolid minorRadius ]
@@ -59,4 +66,23 @@ window :: Display
 window = InWindow "Foo" (800, 800) (100, 100)
 
 main :: IO ()
-main = simulate window white framesPerSecond initialState render step
+main = simulateTraced trailLength trailColor window white framesPerSecond initialState render step
+
+simulateTraced :: Int
+  -> Color
+  -> Display
+  -> Color
+  -> Int
+  -> a
+  -> (a -> Picture)
+  -> (ViewPort -> Float -> a -> a)
+  -> IO ()
+simulateTraced n col window bg fps init render step
+  = simulate window bg fps [init] (tracedRenderer col render) (tracedStepper n step)
+
+tracedRenderer :: Color -> (a -> Picture) -> [a] -> Picture
+tracedRenderer col render states = let renderings = map render states
+                                   in pictures . reverse $ head renderings : map (color col) (tail renderings)
+
+tracedStepper :: Int -> (a -> b -> c -> c) -> a -> b -> [c] -> [c]
+tracedStepper n step vp time states = step vp time (head states) : take (n - 1) states