diff --git a/src/Sound/Tidal/Scales.hs b/src/Sound/Tidal/Scales.hs index 4c253815..23005cbc 100644 --- a/src/Sound/Tidal/Scales.hs +++ b/src/Sound/Tidal/Scales.hs @@ -240,6 +240,73 @@ getScale table sp p = (\n scaleName where octave s x = x `div` length s noteInScale s x = (s !!! x) + fromIntegral (12 * octave s x) +{- Variant of @scale@ allowing to modify the current scale (seen as a list) with an [a] -> [a] function. + +These are equivalent: + +> d1 $ up (scaleMod "major" (insert 1) $ run 8) # s "superpiano" +> d1 $ up "0 1 2 4 5 7 9 11" # s "superpiano" + +-} +scaleMod :: (Eq a, Fractional a) => Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a +scaleMod = getScaleMod scaleTable + +{- Variant of @scaleMod@ providing a list of modifier functions instead of a single function +-} +scaleMods :: (Eq a, Fractional a) => Pattern String -> ([[a] -> [a]]) -> Pattern Int -> Pattern a +scaleMods sp fs p = slowcat $ map (\f -> scaleMod sp f p) fs + +{- Variant of @getScale@ used to build the @scaleMod@ function +-} +getScaleMod :: (Eq a, Fractional a) => [(String, [a])] -> Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a +getScaleMod table sp f p = (\n scaleName + -> noteInScale (uniq $ f $ fromMaybe [0] $ lookup scaleName table) n) <$> p <* sp + where octave s x = x `div` length s + noteInScale s x = (s !!! x) + fromIntegral (12 * octave s x) + +{- Eliminates duplicates in a sorted list +-} +uniq :: (Eq a) => [a] -> [a] +uniq (h1:h2:tl) = if (h1 == h2) then h1:(uniq tl) else h1:(uniq (h2:tl)) +uniq l = l + +{- Raises a specified degree of a scale, provided as a numbers list. +Meant to be passed as an argument to @scaleMod@ +-} +raiseDegree :: Fractional a => Int -> [a] -> [a] +raiseDegree n (hd:[]) = (hd+1):[] +raiseDegree 0 (hd:tl) = (hd+1):tl +raiseDegree n (hd:tl) = hd:(raiseDegree (n-1) tl) +raiseDegree _ [] = error "Degree is not present in the scale" + +{- Lowers a specified degree of a scale, provided as a numbers list. +Meant to be passed as an argument to @scaleMod@ +-} +lowerDegree :: Fractional a => Int -> [a] -> [a] +lowerDegree n (hd:[]) = (hd-1):[] +lowerDegree 0 (hd:tl) = (hd-1):tl +lowerDegree n (hd:tl) = hd:(lowerDegree (n-1) tl) +lowerDegree _ [] = error "Degree is not present in the scale" + +{- Like @raiseDegree@, but raises a range of degrees instead of a single one +-} +raiseDegrees :: Fractional a => Int -> Int -> [a] -> [a] +raiseDegrees n m (hd:[]) = (hd+1):[] +raiseDegrees 0 0 (hd:tl) = (hd+1):tl +raiseDegrees 0 m (hd:tl) = (hd+1):(raiseDegrees 0 (m-1) tl) +raiseDegrees n m (hd:tl) = hd:(raiseDegrees (n-1) (m-1) tl) +raiseDegrees _ _ [] = error "Degrees are out of the scale" + +{- Like @lowerDegree@, but lowers a range of degrees instead of a single one +-} +lowerDegrees :: Fractional a => Int -> Int -> [a] -> [a] +lowerDegrees n m (hd:[]) = (hd-1):[] +lowerDegrees 0 0 (hd:tl) = (hd-1):tl +lowerDegrees 0 m (hd:tl) = (hd-1):(lowerDegrees 0 (m-1) tl) +lowerDegrees n m (hd:tl) = hd:(lowerDegrees (n-1) (m-1) tl) +lowerDegrees _ _ [] = error "Degrees are out of the scale" + + {-| Outputs this list of all the available scales: diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs index b3af7f38..aa26b381 100644 --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -2916,3 +2916,25 @@ necklace perCycle xs = _slow ((toRational $ sum xs) / perCycle) $ listToPat $ li where list :: [Int] -> [Bool] list [] = [] list (x:xs') = (True:(replicate (x-1) False)) ++ list xs' + +{- | Inserts chromatic notes into a pattern. + +The first argument indicates the (patternable) number of notes to insert, +and the second argument is the base pattern of "anchor notes" that gets transformed. + +The following are equivalent: + +> d1 $ up (chromaticiseBy "0 1 2 -1" "[0 2] [3 6] [5 6 8] [3 1 0]") # s "superpiano" +> d1 $ up "[0 2] [[3 4] [6 7]] [[5 6 7] [6 7 8] [8 9 10] [[3 2] [1 0] [0 -1]]" # s "superpiano" +-} +chromaticiseBy :: (Num a, Enum a, Ord a) => Pattern a -> Pattern a -> Pattern a +chromaticiseBy n pat = innerJoin $ (\np -> _chromaticiseBy np pat) <$> n + +_chromaticiseBy :: (Num a, Enum a, Ord a) => a -> Pattern a -> Pattern a +_chromaticiseBy n pat = squeezeJoin $ (\value -> fastcat + $ map pure (if n >=0 then [value .. (value+n)] + else (reverse $ [(value + n) .. value]))) <$> pat + +-- | Alias for chromaticiseBy +chromaticizeBy :: (Num a, Enum a, Ord a) => Pattern a -> Pattern a -> Pattern a +chromaticizeBy = chromaticiseBy