Kaleidoscope

{-# LANGUAGE NoMonomorphismRestriction #-}

import           Control.Monad                 (replicateM)
import           Control.Monad.Random
import           Data.Colour.Palette.ColorSet
import           Data.List                     (zipWith, zipWith3)
import           Diagrams.Prelude
import           Diagrams.Backend.Rasterific.CmdLine
import           System.Random

type Dia = Diagram B R2

iterateIdx :: Integral i => (i -> a -> a) -> a -> [a]
iterateIdx f t = go f t 0
  where
    go f t i = let t' = f i t in t' : go f t' (i + 1)

kaleidoscope :: Dia -> Double -> Dia
kaleidoscope d y = appends hex hexs
  where
    hexs   = zip dirs (replicate 6 hex)
    dirs   = iterate (rotateBy (1/6)) (rotateBy (1/12) unitX)
    hex    = mconcat . take 6 $ iterateIdx next tri
    tri    = alignBR $ mkTriangle (translateY (-y) d)
    next i = reflectAbout (0 ^& 0) (rotateBy (- fromIntegral i / 6) unitX)

mkTriangle :: Dia -> Dia
mkTriangle = clipped (triangle 1) # lw none

confettiScope :: Int -> Int -> Double -> Dia
confettiScope n r y
  = kaleidoscope (mkConfetti n (mkStdGen r)) y
          # centerXY <> (circle 2.75 # fc black)
          # pad 1.1

sizeValue :: (RandomGen g) => Rand g Double
sizeValue = getRandomR (0.05, 0.25)

coordValue :: (RandomGen g) => Rand g Double
coordValue = getRandomR (-0.5, 0.5)

confetti :: Int -> Rand StdGen Dia
confetti n = do
  ss <- replicateM n sizeValue   -- radius
  cs <- replicateM n getRandom   -- color index
  as <- replicateM n getRandom   -- opacity
  xs <- replicateM n coordValue  -- x coordinate
  ys <- replicateM n coordValue  -- y coordinate
  let mkCirc :: Double -> Int -> Double -> Dia
      mkCirc s c a = circle s # fc (webColors c) # opacity a
      pos = zipWith mkP2 xs ys
      conf = zipWith3 mkCirc ss cs as
  return $ position (zip pos conf)

mkConfetti :: Int -> (StdGen -> Dia)
mkConfetti n = evalRand $ confetti n

main = mainWith gif

dias = map (confettiScope 50 0) [-0.5,-0.49..0.5]

gif :: [(Diagram B R2, Int)]
gif = zip (dias ++ reverse dias) (repeat 5)