A three mirror kaleidescope with random confetti.

Author: Jeffrey Rosenbluth

Download raw source code

> import Diagrams.Backend.SVG.CmdLine
> {-# LANGUAGE NoMonomorphismRestriction #-}
> import           Control.Monad                 (replicateM)
> import           Control.Monad.Random
> import           Data.Colour.Palette.ColorSet
> import           Data.List                     (zipWith, zipWith3)
> import           Diagrams.Prelude
> import           System.Random

A helper function like iterate but also takes the list index as a parameter.

> iterateIdx :: (Int -> 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)

Take any Diagram and cut out an equilateral triangle of side 1 from the center. This is the triangle inside of the three mirrors that make up a kaleidescope. The image is created by first repeatedly refecting this triangle and assembling the resulting triagles into a hexagon. Then the image plane is tiled with this hexagon.

> kaleidoscope :: Diagram B -> Diagram B
> kaleidoscope d = 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 $ cutTriangle d
>     next i = reflectAbout (0 ^& 0) (rotateBy (- fromIntegral i / 6) xDir)
> cutTriangle :: Diagram B -> Diagram B
> cutTriangle = clipped (triangle 1) # lw none

We pass as arguments the number of pieces of confetti n and a random seed r. Between 10 and 100 pieces seem to work nicely.

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

To create an image for use in the kadeidescope we generate a bunch of disks with random location, size, color, and opacity. This is the confetti used as the image. Of course using circles is arbitrary, any shapes and sizes will do.

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

We use monadRandom to hide the plumbing of the many random numbers we need. The colors are choosen from the 330+ webColors defined in the package Data.Colour.Palette.ColorSet.

> confetti :: Int -> Rand StdGen (Diagram B)
> 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 -> Diagram B
>       mkCirc s c a = circle s # fc (webColors c) # lw none # opacity a
>       pos = zipWith mkP2 xs ys
>       conf = zipWith3 mkCirc ss cs as
>   return $ position (zip pos conf)

Make the confetti diagram and extract it from the monad.

> mkConfetti :: Int -> (StdGen -> Diagram B)
> mkConfetti n = evalRand $ confetti n
> example = confettiScope 39 0
> main = mainWith (example :: Diagram B)