Color matrix

Main.purs

module Main where

import Prelude

import Data.List.Lazy
import Data.Maybe
import Data.Tuple
import Data.Int (pow, toNumber)
import Flare
import Flare.Drawing
import Color.Blending
import Color.Scale
import Color.Scale.Perceptual
import Color.Scheme.Harmonic
import Color.Scheme.MaterialDesign


------------------------------------
----- TRY ONE OF THE FOLLOWING -----
------------------------------------


--colorStream = repeat black

--colorStream = cycle $ fromFoldable [black, white]

--colorStream = palindrome $ fromFoldable [black, purple, pink, orange, yellow]

colorStream = every 3 (lighten 0.2) $ every 5 (lighten 0.1) $ repeat deepPurple -- FizzBuzz

--colorStream = iterate (rotateHue 0.5) red -- this is quite slow, unfortunately

--colorStream = every 3 (lighten 0.1) $ palindrome $ colors' viridis (3 * 33)

--colorStream = every 2 (rotateHue 180.0) $ colors' cool (33 * 33)

--colorStream = every 2 (lighten 0.2) $ colors' (uniformScale LCh pink [blue] pink) (33 * 33)

--colorStream = sample magma <$> randn

{-
colorStream =
  every 16 (const orange) $
  every 8  (const (graytone 0.7)) $
  every 4  (const blue) $
  every 2  (const (graytone 0.9)) $
  repeat white
-}

{-
colorStream =
  every 17 (blend' amber) $
  every 13 (blend' brown) $
  every 7  (blend' red) $
  every 5  (blend' yellow) $
  every 3  (blend' green) $
  repeat blueGrey
  where blend' = blend Screen
-}

{-
colorStream = cycle $ fromFoldable [b, b, b, b, w,
                                    b, g, g, b, b,
                                    b, g, g, b, w,
                                    b, b, b, b, w,
                                    w, w, w, b, w,
                                    w, w, w]
  where b = black
        w = white
        g = graytone 0.8
-}




-- Some helper functions (inspired by TidalCycles)

-- Apply a function on every n-th iteration
every :: forall a. Int -> (a -> a) -> List a -> List a
every 0 f xs = xs
every 1 f xs = map f xs
every n f xs = zipWith ($) (cycle fns) xs
  where
    fns = snoc (replicate (n - 1) id) f

-- Append the reversed copy of a list to itself, and repeat
palindrome :: forall a. List a -> List a
palindrome xs = cycle (append xs (reverse xs))

-- Lazy version of 'colors'
colors' :: ColorScale -> Int -> List Color
colors' s = fromFoldable <<< colors s

-- Simple pseudo-random numbers
seed = 5681
m = 2 `pow` 15
a = 2 `pow` 8 + 3

randi = iterate (\s -> (a * s + 7) `mod` m) seed
randn = map (\n -> toNumber n / toNumber m) randi

-- Draw the matrix
colorMatrix width height size margin bg =
  filled (fillColor bg) (rectangle 0.0 0.0 800.0 600.0) <>
  fold (zipWith square coords colorStream)
  
  where
    coords = do
      y <- 0 .. (height - 1)
      x <- 0 .. (width - 1)
      pure (Tuple x y)

    psize = toNumber size
    pmargin = toNumber margin

    square (Tuple x y) col =
      filled (fillColor col) (rectangle px py psize psize)
        where
          px = toNumber x * (psize + pmargin)
          py = toNumber y * (psize + pmargin)

-- User interface
ui :: UI _ Drawing
ui = colorMatrix <$> intRange "Width" 1 60 33
                 <*> intRange "Height" 1 60 33
                 <*> intRange "Cell size" 1 40 15
                 <*> intRange "Padding" 0 40 0
                 <*> color "Background" white

main = runFlareDrawing "controls" "canvas" ui