> 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)