bjorklund.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module DiagramsTidal where

import Sound.Tidal.Pattern hiding (square)
import Sound.Tidal.Time
import Sound.Tidal.Utils
import Diagrams hiding (arc, cat)
import Data.Monoid

import Diagrams.Backend.SVG.CmdLine
import Data.Colour.Names
import Data.Colour


infixl 8 &
(&) :: a -> (a -> b) -> b
x & f = f x

infixl 5 <&>
(<&>) :: (Functor f) => f a -> (a -> b) -> f b
x <&> f = f <$> x

arc2TransformLin :: Arc -> Diagram B -> Diagram B
arc2TransformLin (s, e) = translate (r2 (fromRational s, 0)) . scaleX (fromRational $ e - s)

runPattern :: Pattern (Diagram B) -> Diagram B
runPattern (Pattern a) = mconcat ((\(arc,_, x) -> arc2TransformLin arc x) <$> a (0, 1))


bjorklundSquare :: Int -> Diagram B
bjorklundSquare len = runPattern
  $ stack ( do
              i <- [1..len]
              sq' <- return $ (return $ sq
                               & (scaleY (1 / (fromIntegral len)))
                               & translate (r2 (0, (fromIntegral i - 1) / fromIntegral len))
                              )
              return $ e i  len sq'
          )

  where
    circ = circle 0.5
    sq = square 1
         & fcA (black `withOpacity` 1.0)
         & lw none



main = mainWith $ vcat . map alignL
  -- $ [1..50]
  $ [313]
  <&> bjorklundSquare

n = 1..k from bottom row to top
k = 200

200:

n = 1..k
k = 1..100