-- |
-- Module      : Harmonic.Interface.Tidal.Utils
-- Description : TidalCycles helper functions for octave transposition and time rotation
--
-- Shorthand utilities used across live-coding scripts: octave transposition
-- via 'oct', and time rotation operators 'pullBy'\/'pushBy' that wrap
-- TidalCycles' early\/late operators.

module Harmonic.Interface.Tidal.Utils (
    -- * Transposition
    oct,

    -- * Time rotation
    pullBy, pushBy,

    -- * Humanisation
    humanise,

    -- * Onset repair
    onset,

    -- * Note-length constants
    hemidemisemiquaver, demisemiquaver, semiquaver, quaver, crotchet, minim,
) where

import Sound.Tidal.Context

-- | Transpose by whole octaves. @oct 1@ is up an octave, @oct (-1)@ down.
--
-- Add onto a pattern:
--
-- @, cello T (0,1) k vl grid Bass |+ oct (-1)@
oct :: Int -> Pattern ValueMap
oct :: Int -> Pattern ValueMap
oct Int
n = Pattern Note -> Pattern ValueMap
note (Int -> Pattern Note
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n))

-- | Rotate a pattern earlier ('pullBy') or later ('pushBy') in time.
-- Function forms of the TidalCycles @\<~@ and @~>@ operators, so they compose
-- in a modifier chain rather than needing parentheses.
--
-- @, pushBy (1\/8) $ harp T (0,1) k vl flow Alto@
pullBy :: Time -> Pattern a -> Pattern a
pullBy :: forall a. Time -> Pattern a -> Pattern a
pullBy Time
t Pattern a
pat = (Time -> Pattern Time
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
t) Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
<~ Pattern a
pat

-- | Rotate a pattern later in time. See 'pullBy'.
pushBy :: Time -> Pattern a -> Pattern a
pushBy :: forall a. Time -> Pattern a -> Pattern a
pushBy Time
t Pattern a
pat = (Time -> Pattern Time
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
t) Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
~> Pattern a
pat

-- | Random per-event velocity jitter, for a less mechanical feel. The argument
-- scales the spread: @humanise 1@ varies @amp@ by up to &#177;0.09.
humanise :: Double -> Pattern ValueMap
humanise :: Double -> Pattern ValueMap
humanise Double
n = String -> Pattern Double -> Pattern ValueMap
pF String
"amp" (Pattern Double
-> Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => Pattern a -> Pattern a -> Pattern a -> Pattern a
range (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Double
0.09 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
n)) (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
0.09 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
n)) Pattern Double
forall a. Fractional a => Pattern a
rand)

-- | Ensure every event is an onset by aligning whole start with part start,
-- but only at cycle boundaries. Prevents TidalCycles' onset detection from
-- filtering events in cat constructions where inner patterns have period > 1
-- cycle, without causing MIDI flood from sub-cycle queries.
onset :: Pattern a -> Pattern a
onset :: forall a. Pattern a -> Pattern a
onset Pattern a
pat = Pattern a
pat {query = q, pureValue = Nothing}
  where
    q :: State -> [EventF (ArcF Time) a]
q State
st = (EventF (ArcF Time) a -> EventF (ArcF Time) a)
-> [EventF (ArcF Time) a] -> [EventF (ArcF Time) a]
forall a b. (a -> b) -> [a] -> [b]
map EventF (ArcF Time) a -> EventF (ArcF Time) a
forall {b}. EventF (ArcF Time) b -> EventF (ArcF Time) b
align (Pattern a -> State -> [EventF (ArcF Time) a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
pat State
st)
    align :: EventF (ArcF Time) b -> EventF (ArcF Time) b
align EventF (ArcF Time) b
ev = case EventF (ArcF Time) b -> Maybe (ArcF Time)
forall a b. EventF a b -> Maybe a
whole EventF (ArcF Time) b
ev of
      Maybe (ArcF Time)
Nothing -> EventF (ArcF Time) b
ev
      Just (Arc Time
_ Time
we) ->
        let ps :: Time
ps = ArcF Time -> Time
forall a. ArcF a -> a
start (EventF (ArcF Time) b -> ArcF Time
forall a b. EventF a b -> a
part EventF (ArcF Time) b
ev)
        in if Time
ps Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time -> Time
sam Time
ps
           then EventF (ArcF Time) b
ev {whole = Just (Arc ps (min we (nextSam ps)))}
           else EventF (ArcF Time) b
ev


-- | Note-length constants, as fractions of a cycle: @1\/64@, @1\/32@, @1\/16@,
-- @1\/8@, @1\/4@ and @1\/2@ respectively. Useful as arguments to 'pullBy' and
-- 'pushBy', where a named length reads better than a bare fraction.
hemidemisemiquaver, demisemiquaver, semiquaver, quaver, crotchet, minim :: Time
hemidemisemiquaver :: Time
hemidemisemiquaver = Time
1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
64
demisemiquaver :: Time
demisemiquaver = Time
1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
32
semiquaver :: Time
semiquaver = Time
1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
16
quaver :: Time
quaver = Time
1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
8
crotchet :: Time
crotchet = Time
1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
4
minim :: Time
minim = Time
1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
2