Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
56 lines (46 sloc) 1.43 KB
{-# LANGUAGE OverloadedStrings #-}
-- Recursive picture animation.
--
-- Inspired by a similar animation (not equal)
-- to be found in the examples of the gloss library.
import Graphics.Web.Processing.Simple
import Graphics.Web.Processing.Html
main :: IO ()
main = writeHtml "processing.js" "mill.pde" "Mill demo" "mill.html" mill
mill :: ProcScript
mill = animateFigure Nothing Nothing 50 (Color 0 0 0 255) millf
speed :: Proc_Float
speed = 0.02
millf :: Proc_Int -> Figure
millf n =
let t = intToFloat n * speed
in FillColor (Color 0 0 0 0)
$ LineColor (Color 255 255 255 255)
$ millUnit 0 250 t
millUnit :: Int -- ^ Recursive level.
-> Proc_Float -- ^ Radius.
-> Proc_Float -- ^ Angle.
-> Figure
-- Recursion stop level.
millUnit 5 _ _ = mempty
-- Recursive call.
millUnit n r alpha =
let parity = even n
r2 = r/2
f a = (r2 * sin a, r2 * cos a)
p0 = (0,0)
p1 = f 0
p2 = f $ 2*pi/3
p3 = f $ 4*pi/3
r' = dist p1 p2 / 2
in Rotate (if parity then alpha else (-2) * alpha)
$ mconcat [
Line [p0,p1] , Line [p0,p2] , Line [p0,p3]
, Circle p1 r' , Circle p2 r' , Circle p3 r'
, Translate p1 $ millUnit (n+1) r' alpha
, Translate p2 $ millUnit (n+1) r' alpha
, Translate p3 $ millUnit (n+1) r' alpha
]
-- | Distance between two points.
dist :: Proc_Point -> Proc_Point -> Proc_Float
dist (a,b) (c,d) = sqrt $ (a - c)^2 + (b - d)^2