-- Quasicrystals demo. -- -- Based on code from: -- http://mainisusuallyafunction.blogspot.com/2011/10/quasicrystals-as-sums-of-waves-in-plane.html -- {-# LANGUAGE BangPatterns #-} import Graphics.Gloss.Raster.Field import System.Environment -- Types ---------------------------------------------------------------------- -- | Angle in radians. type Angle = Float -- | Angle offset used for animation. type Phi = Float -- | Number of waves to sum for each pixel. type Degree = Int -- | Feature size of visualisation. type Scale = Float -- | Time in seconds since the program started. type Time = Float -- Point ---------------------------------------------------------------------- -- | Compute a single point of the visualisation. quasicrystal :: Scale -> Degree -> Time -> Point -> Color quasicrystal !scale !degree !time !p = let -- Scale the time to be the phi value of the animation. -- The action seems to slow down at increasing phi values, -- so we increase phi faster as time moves on. phi = 1 + (time ** 1.5) * 0.005 in rampColor $ waves degree phi $ point scale p -- | Sum up all the waves at a particular point. waves :: Degree -> Phi -> Point -> Float waves !degree !phi !x = wrap $ waver 0 degree where !th = pi / phi waver :: Float -> Int -> Float waver !acc !n | n == 0 = acc | otherwise = waver (acc + wave (fromIntegral n * th) x) (n - 1) wrap n = let !n_ = truncate n :: Int !n' = n - fromIntegral n_ in if odd n_ then 1 - n' else n' -- | Generate the value for a single wave. wave :: Angle -> Point -> Float wave !th = f where !cth = cos th !sth = sin th {-# INLINE f #-} f (x, y) = (cos (cth*x + sth*y) + 1) / 2 -- | Convert an image point to a point on our wave plane. point :: Scale -> Point -> Point point !scale (x, y) = (x * scale, y * scale) -- | Color ramp from blue to white. rampColor :: Float -> Color rampColor v = rawColor v (0.4 + (v * 0.6)) 1 1 -- Main ----------------------------------------------------------------------- main :: IO () main = do args <- getArgs case args of [] -> run 800 600 2 30 5 [sizeX, sizeY, zoom, scale, degree] -> run (read sizeX) (read sizeY) (read zoom) (read scale) (read degree) _ -> putStr $ unlines [ "quazicrystal " , " sizeX, sizeY - visualisation size (default 800, 600)" , " zoom - pixel replication factor (default 5)" , " scale - feature size of visualisation (default 30)" , " degree - number waves to sum for each point (default 5)" , "" , " You'll want to run this with +RTS -N to enable threads" ] run :: Int -> Int -> Int -> Scale -> Degree -> IO () run sizeX sizeY zoom scale degree = animateField (InWindow "Crystal" (sizeX, sizeY) (10, 10)) (zoom, zoom) (quasicrystal scale degree)