module Sound.Tidal.Bjorklund (bjorklund) where

{-
    Bjorklund.hs - Euclidean patterns
    Copyright (C) 2006-2020, Rohan Drape and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

-- The below is taken from the hmt library. Tidal used to just include
-- the library but removed for now due to dependency problems.. We
-- could however likely benefit from other parts of the library..

type STEP a = ((Int, Int), ([[a]], [[a]]))

left :: STEP a -> STEP a
left :: forall a. STEP a -> STEP a
left ((Int
i, Int
j), ([[a]]
xs, [[a]]
ys)) =
  let ([[a]]
xs', [[a]]
xs'') = Int -> [[a]] -> ([[a]], [[a]])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
j [[a]]
xs
   in ((Int
j, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j), (([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) [[a]]
xs' [[a]]
ys, [[a]]
xs''))

right :: STEP a -> STEP a
right :: forall a. STEP a -> STEP a
right ((Int
i, Int
j), ([[a]]
xs, [[a]]
ys)) =
  let ([[a]]
ys', [[a]]
ys'') = Int -> [[a]] -> ([[a]], [[a]])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [[a]]
ys
   in ((Int
i, Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i), (([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) [[a]]
xs [[a]]
ys', [[a]]
ys''))

bjorklund' :: STEP a -> STEP a
bjorklund' :: forall a. STEP a -> STEP a
bjorklund' ((Int, Int)
n, ([[a]], [[a]])
x) =
  let (Int
i, Int
j) = (Int, Int)
n
   in if Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
        then ((Int, Int)
n, ([[a]], [[a]])
x)
        else ((Int, Int), ([[a]], [[a]])) -> ((Int, Int), ([[a]], [[a]]))
forall a. STEP a -> STEP a
bjorklund' (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
j then ((Int, Int), ([[a]], [[a]])) -> ((Int, Int), ([[a]], [[a]]))
forall a. STEP a -> STEP a
left ((Int, Int)
n, ([[a]], [[a]])
x) else ((Int, Int), ([[a]], [[a]])) -> ((Int, Int), ([[a]], [[a]]))
forall a. STEP a -> STEP a
right ((Int, Int)
n, ([[a]], [[a]])
x))

bjorklund :: (Int, Int) -> [Bool]
bjorklund :: (Int, Int) -> [Bool]
bjorklund (Int
i, Int
j') =
  let j :: Int
j = Int
j' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
      x :: [[Bool]]
x = Int -> [Bool] -> [[Bool]]
forall a. Int -> a -> [a]
replicate Int
i [Bool
True]
      y :: [[Bool]]
y = Int -> [Bool] -> [[Bool]]
forall a. Int -> a -> [a]
replicate Int
j [Bool
False]
      ((Int, Int)
_, ([[Bool]]
x', [[Bool]]
y')) = ((Int, Int), ([[Bool]], [[Bool]]))
-> ((Int, Int), ([[Bool]], [[Bool]]))
forall a. STEP a -> STEP a
bjorklund' ((Int
i, Int
j), ([[Bool]]
x, [[Bool]]
y))
   in [[Bool]] -> [Bool]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bool]]
x' [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [[Bool]] -> [Bool]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bool]]
y'