-- |
-- Module      : Harmonic.Interface.Tidal.Form
-- Description : Kinetics framework for form-driven range gating
--
-- Encodes macro-level compositional arc as programmable structure, realised
-- as TidalCycles patterns, looping endlessly.
--
-- A form is a list of nodes. Each node fixes a point in time and the two
-- signals that drive everything downstream: /kinetics/ (how active the music
-- is) and /dynamics/ (how loud). Instruments gate themselves on kinetics, so
-- the arc is written once and every line follows it.
--
-- Nodes come in two time bases — 'at' takes wall-clock seconds, 'rh' takes
-- bars (rehearsal marks). Primed variants ('at'', 'rh'') snap rather than
-- interpolate, for a hard cut into a new section:
--
-- @
-- form =           -- time    k     d
--   [ rh    1      0.0   0.0   s
--   , rh   17      0.2   0.3   s    -- elements layer in
--   , rh'  29      0.35  0.55  s    -- riser: sparse but loud, then snap
--   , rh   33      1.0   1.0   s    -- drop
--   ]
-- @
--
-- The form is compiled into an 'IK' — the performance context every
-- instrument reads — by pairing it with a tempo and a chord-selection
-- pattern:
--
-- @k = iK tempo form (warp \"[1 2 3 4]\/4\")@
--
-- The simplest useful form is a single constant node, which holds one
-- progression at full kinetics forever:
--
-- @form = [ at 0 1.0 1.0 s ]@

module Harmonic.Interface.Tidal.Form
  ( -- * Types
    FormNode(..)
  , FormTime(..)
  , Transition(..)
  , Kinetics(..)
  , IK

    -- * Construction
  , at
  , at'
  , rh
  , rh'
  , iK
  , lK

    -- * Realization
  , formK

    -- * Primitives
  , beatsPerBar
  , ki
  , slate
  , mark
  , mark'
  , markbar
  , marksec
  , markAt
  , kinPick
  , isolate
  , isolate'
  , withForm

  ) where

import Data.List (nub, sortOn)
import qualified Harmonic.Rules.Types.ProgressionContext as PC
import Sound.Tidal.Context

-------------------------------------------------------------------------------
-- Types
-------------------------------------------------------------------------------

-- |A node's position in time — wall-clock 'Secs' elapsed (0 = the start) or
-- musical 'Bars' (4\/4), numbered from 1 as the 12 Step counts them (bar 1 =
-- the start). Resolved to Tidal cycles at realization (see 'formK'). Mix freely
-- in one form.
data FormTime = Secs Double | Bars Double
  deriving (Int -> FormTime -> ShowS
[FormTime] -> ShowS
FormTime -> [Char]
(Int -> FormTime -> ShowS)
-> (FormTime -> [Char]) -> ([FormTime] -> ShowS) -> Show FormTime
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormTime -> ShowS
showsPrec :: Int -> FormTime -> ShowS
$cshow :: FormTime -> [Char]
show :: FormTime -> [Char]
$cshowList :: [FormTime] -> ShowS
showList :: [FormTime] -> ShowS
Show, FormTime -> FormTime -> Bool
(FormTime -> FormTime -> Bool)
-> (FormTime -> FormTime -> Bool) -> Eq FormTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormTime -> FormTime -> Bool
== :: FormTime -> FormTime -> Bool
$c/= :: FormTime -> FormTime -> Bool
/= :: FormTime -> FormTime -> Bool
Eq)

-- |How a section moves to the next node: 'Smooth' (ramped) or 'Snap'
-- (hold this node's value, then jump on the next node's exact time).
data Transition = Smooth | Snap
  deriving (Int -> Transition -> ShowS
[Transition] -> ShowS
Transition -> [Char]
(Int -> Transition -> ShowS)
-> (Transition -> [Char])
-> ([Transition] -> ShowS)
-> Show Transition
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Transition -> ShowS
showsPrec :: Int -> Transition -> ShowS
$cshow :: Transition -> [Char]
show :: Transition -> [Char]
$cshowList :: [Transition] -> ShowS
showList :: [Transition] -> ShowS
Show, Transition -> Transition -> Bool
(Transition -> Transition -> Bool)
-> (Transition -> Transition -> Bool) -> Eq Transition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Transition -> Transition -> Bool
== :: Transition -> Transition -> Bool
$c/= :: Transition -> Transition -> Bool
/= :: Transition -> Transition -> Bool
Eq)

-- |A node in a form definition: a point in time with kinetics level,
-- dynamic level, active progression, and the transition style of the
-- section starting here.
data FormNode = FormNode
  { FormNode -> FormTime
fnTime     :: FormTime                -- ^ Position (seconds or bars)
  , FormNode -> Double
fnKinetics :: Double                  -- ^ 0.0-1.0 kinetics level
  , FormNode -> Double
fnDynamic  :: Double                  -- ^ 0.0-1.0 dynamic level
  , FormNode -> ProgressionContext
fnProg     :: PC.ProgressionContext   -- ^ Active 3-layer progression at this node
  , FormNode -> Transition
fnTrans    :: Transition              -- ^ Transition of the segment starting at this node
  } deriving (Int -> FormNode -> ShowS
[FormNode] -> ShowS
FormNode -> [Char]
(Int -> FormNode -> ShowS)
-> (FormNode -> [Char]) -> ([FormNode] -> ShowS) -> Show FormNode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormNode -> ShowS
showsPrec :: Int -> FormNode -> ShowS
$cshow :: FormNode -> [Char]
show :: FormNode -> [Char]
$cshowList :: [FormNode] -> ShowS
showList :: [FormNode] -> ShowS
Show, FormNode -> FormNode -> Bool
(FormNode -> FormNode -> Bool)
-> (FormNode -> FormNode -> Bool) -> Eq FormNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormNode -> FormNode -> Bool
== :: FormNode -> FormNode -> Bool
$c/= :: FormNode -> FormNode -> Bool
/= :: FormNode -> FormNode -> Bool
Eq)

-- |Realized form: continuous and discrete signals for live performance.
data Kinetics = Kinetics
  { Kinetics -> Pattern Double
kSignal   :: Pattern Double                -- ^ Kinetics level 0-1 (continuous interpolated)
  , Kinetics -> Pattern Double
kDynamic  :: Pattern Double                -- ^ Dynamic envelope 0-1 (continuous interpolated)
  , Kinetics -> Pattern ProgressionContext
kProg     :: Pattern PC.ProgressionContext -- ^ Active 3-layer progression (step function)
  , Kinetics -> [ProgressionContext]
kProgs    :: [PC.ProgressionContext]       -- ^ The distinct progressions 'kProg' can emit —
                                               --   finite and known at construction (form nodes,
                                               --   or the single 'lK' progression). Voicing
                                               --   caches derive from THIS list, exactly and
                                               --   horizon-free, instead of sampling 'kProg'
                                               --   over an arbitrary time window.
  , Kinetics -> Double
kLoopSecs :: Double                        -- ^ Form total duration in seconds; 0 = atemporal
                                               --   (single-node iK or lK). Consumers like the
                                               --   4-char-display helper read this to drive a
                                               --   wall-clock counter that wraps every kLoopSecs.
  , Kinetics -> Double
kCps      :: Double                        -- ^ Cycles per second at form construction
                                               --   (= bpm\/60). Used by the display broadcaster to
                                               --   convert cycle time → seconds. Stays coherent
                                               --   with Tidal's actual cps because both are
                                               --   derived from the same @bpm@ on every launcher
                                               --   re-evaluation.
  , Kinetics -> Int -> Bool
kDegrees  :: Int -> Bool                   -- ^ Launcher-wide degree filter, applied by
                                               --   'arrange' on top of each line's own range
                                               --   ('isolate', 'isolate''); @const True@ = all.
  }

-- |Performance context: Kinetics bundled with chord selection pattern.
-- Reduces parameter threading — @r@ and @k@ are always passed together.
type IK = (Kinetics, Pattern Int)

-------------------------------------------------------------------------------
-- Construction
-------------------------------------------------------------------------------

-- |Form node builders. Time unit and transition are orthogonal:
-- @at@\/@at'@ take wall-clock seconds elapsed, @rh@\/@rh'@ take musical bar
-- numbers (rehearsal marks, 4\/4, bar 1 = the start of the form);
-- unprimed = smooth transition, primed = snap.
--
-- @at  0 0 0 s@   seconds, smooth   @rh  10 0.5 0.5 s@   bars, smooth
-- @at' 60 1 1 s@  seconds, snap     @rh' 18 0.9 0.9 s@  bars, snap
at, at', rh, rh' :: Double -> Double -> Double -> PC.ProgressionContext -> FormNode
at :: Double -> Double -> Double -> ProgressionContext -> FormNode
at  Double
t Double
k Double
d ProgressionContext
pc = FormTime
-> Double -> Double -> ProgressionContext -> Transition -> FormNode
FormNode (Double -> FormTime
Secs Double
t) Double
k Double
d ProgressionContext
pc Transition
Smooth
at' :: Double -> Double -> Double -> ProgressionContext -> FormNode
at' Double
t Double
k Double
d ProgressionContext
pc = FormTime
-> Double -> Double -> ProgressionContext -> Transition -> FormNode
FormNode (Double -> FormTime
Secs Double
t) Double
k Double
d ProgressionContext
pc Transition
Snap
rh :: Double -> Double -> Double -> ProgressionContext -> FormNode
rh  Double
b Double
k Double
d ProgressionContext
pc = FormTime
-> Double -> Double -> ProgressionContext -> Transition -> FormNode
FormNode (Double -> FormTime
Bars Double
b) Double
k Double
d ProgressionContext
pc Transition
Smooth
rh' :: Double -> Double -> Double -> ProgressionContext -> FormNode
rh' Double
b Double
k Double
d ProgressionContext
pc = FormTime
-> Double -> Double -> ProgressionContext -> Transition -> FormNode
FormNode (Double -> FormTime
Bars Double
b) Double
k Double
d ProgressionContext
pc Transition
Snap

-- |Construct performance context from BPM, form nodes, and chord selection.
--
-- @k = iK tempo [at 0 0 0 s, at 30 1 1 s] (warp \"[1 2 3 4]\/8\")@
iK :: Double -> [FormNode] -> Pattern Int -> IK
iK :: Double -> [FormNode] -> Pattern Int -> IK
iK Double
bpm [FormNode]
nodes Pattern Int
chordPat = (Double -> [FormNode] -> Kinetics
formK Double
bpm [FormNode]
nodes, Pattern Int
chordPat)

-- |Live kinetics: build IK from reactive kinetics\/dynamics signals.
-- Bypasses form interpolation — use when the envelope is driven by live
-- input (e.g. MIDI CC) rather than a static keyframed form.
--
-- @k = lK exP exP s r@  -- pedal drives both kinetics and dynamics
lK :: Pattern Double          -- ^ Kinetics signal (0-1, live)
   -> Pattern Double          -- ^ Dynamics signal (0-1, live)
   -> PC.ProgressionContext   -- ^ Active 3-layer progression
   -> Pattern Int             -- ^ Chord-selection pattern
   -> IK
lK :: Pattern Double
-> Pattern Double -> ProgressionContext -> Pattern Int -> IK
lK Pattern Double
sigP Pattern Double
dyn ProgressionContext
pc Pattern Int
chordPat = (Pattern Double
-> Pattern Double
-> Pattern ProgressionContext
-> [ProgressionContext]
-> Double
-> Double
-> (Int -> Bool)
-> Kinetics
Kinetics Pattern Double
sigP Pattern Double
dyn (ProgressionContext -> Pattern ProgressionContext
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgressionContext
pc) [ProgressionContext
pc] Double
0 Double
0 (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True), Pattern Int
chordPat)

-------------------------------------------------------------------------------
-- Realization
-------------------------------------------------------------------------------

-- |Beats per bar for 'Bars' resolution. 4\/4, matching BootTidal's @bar@ helper
-- (1 bar = 4 cycles, since @cps = bpm\/60@ makes a cycle one beat).
beatsPerBar :: Double
beatsPerBar :: Double
beatsPerBar = Double
4

-- |Bars are numbered musically: bar 1 starts at cycle 0, as the 12 Step counts.
barCycles :: Double -> Double
barCycles :: Double -> Double
barCycles Double
b
  | Double
b Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1     = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error ([Char]
"bar " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": bars count from 1 (bar 1 = the start of the form)")
  | Bool
otherwise = (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
beatsPerBar

-- |Resolve a node's position to Tidal cycles from form start.
nodeCycles :: Double -> FormNode -> Double
nodeCycles :: Double -> FormNode -> Double
nodeCycles Double
cpsV FormNode
nd = case FormNode -> FormTime
fnTime FormNode
nd of
  Secs Double
secs -> Double
secs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cpsV
  Bars Double
b    -> Double -> Double
barCycles Double
b

-- |Node position in wall-clock seconds (for 'kLoopSecs' \/ the display).
nodeSecs :: Double -> FormNode -> Double
nodeSecs :: Double -> FormNode -> Double
nodeSecs Double
cpsV FormNode
nd = case FormNode -> FormTime
fnTime FormNode
nd of
  Secs Double
secs -> Double
secs
  Bars Double
b    -> Double -> Double
barCycles Double
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cpsV

-- |Realize a form definition into Kinetics signals at a given BPM.
-- Single-node forms produce constant signals (global state).
-- Multi-node forms produce per-segment signals — smooth (ramp) or snap (step)
-- per each node's 'fnTrans' — and a step-function progression, looping at the
-- form's total duration. Time is resolved from each node's 'FormTime'.
--
-- Contract details:
--
-- * The LAST node is the loop terminator, not a playable section: segments
--   run between consecutive node pairs, and the final node's time sets
--   'kLoopSecs'. Its kinetics\/dynamic values only shape the ramp INTO it.
-- * Nodes are sorted by resolved time before use, so a moved rehearsal
--   mark cannot produce negative-width segments. Nodes sharing a time
--   yield a zero-width segment (the earlier one is inaudible).
-- * @formK bpm []@ yields silence on every signal — safe to evaluate
--   mid-edit; nothing sounds until a node exists.
-- * Smooth ramps render at 16 steps per SEGMENT regardless of length
--   (see @formSignal@) — a long segment crosses kinetics thresholds on a
--   correspondingly coarse grid.
formK :: Double -> [FormNode] -> Kinetics
formK :: Double -> [FormNode] -> Kinetics
formK Double
bpm [FormNode]
nodes0 = Kinetics
  { kSignal :: Pattern Double
kSignal   = Double -> [FormNode] -> (FormNode -> Double) -> Pattern Double
formSignal Double
cpsV [FormNode]
nodes FormNode -> Double
fnKinetics
  , kDynamic :: Pattern Double
kDynamic  = Double -> [FormNode] -> (FormNode -> Double) -> Pattern Double
formSignal Double
cpsV [FormNode]
nodes FormNode -> Double
fnDynamic
  , kProg :: Pattern ProgressionContext
kProg     = Double
-> [FormNode]
-> (FormNode -> ProgressionContext)
-> Pattern ProgressionContext
forall a. Double -> [FormNode] -> (FormNode -> a) -> Pattern a
formStep   Double
cpsV [FormNode]
nodes FormNode -> ProgressionContext
fnProg
  , kProgs :: [ProgressionContext]
kProgs    = [ProgressionContext] -> [ProgressionContext]
forall a. Eq a => [a] -> [a]
nub ((FormNode -> ProgressionContext)
-> [FormNode] -> [ProgressionContext]
forall a b. (a -> b) -> [a] -> [b]
map FormNode -> ProgressionContext
fnProg [FormNode]
nodes)
  , kLoopSecs :: Double
kLoopSecs = case [FormNode]
nodes of
                  (FormNode
_:FormNode
_:[FormNode]
_) -> Double -> FormNode -> Double
nodeSecs Double
cpsV ([FormNode] -> FormNode
forall a. HasCallStack => [a] -> a
last [FormNode]
nodes)   -- multi-node: form duration (seconds)
                  [FormNode]
_       -> Double
0                           -- single-node or empty: atemporal
  , kCps :: Double
kCps      = Double
cpsV
  , kDegrees :: Int -> Bool
kDegrees  = Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True
  }
  where
    cpsV :: Double
cpsV = Double
bpm Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
60
    -- Nodes sorted by resolved time: an out-of-order form (a rehearsal
    -- mark moved without reordering the list) previously produced
    -- negative-width timecat segments with no diagnostic.
    nodes :: [FormNode]
nodes = (FormNode -> Double) -> [FormNode] -> [FormNode]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Double -> FormNode -> Double
nodeCycles Double
cpsV) [FormNode]
nodes0

-- |Kinetics\/dynamic signal: piecewise per segment, ramped when the segment's
-- start node is 'Smooth', held (stepped) when 'Snap'. Single node: constant.
-- Ramp resolution is a fixed 16 steps per segment (a 148-second segment
-- moves in ~9-second stairs) — deliberate coarseness so instrument
-- activation bands switch on a musically legible grid rather than
-- per-event.
formSignal :: Double -> [FormNode] -> (FormNode -> Double) -> Pattern Double
formSignal :: Double -> [FormNode] -> (FormNode -> Double) -> Pattern Double
formSignal Double
_   []     FormNode -> Double
_        = Pattern Double
forall a. Pattern a
silence
formSignal Double
_   [FormNode
node] FormNode -> Double
accessor = Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ FormNode -> Double
accessor FormNode
node)
formSignal Double
cpsV [FormNode]
nodes  FormNode -> Double
accessor =
  let totalCycles :: Time
totalCycles = Double -> Time
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> FormNode -> Double
nodeCycles Double
cpsV ([FormNode] -> FormNode
forall a. HasCallStack => [a] -> a
last [FormNode]
nodes)) :: Time
      pairs :: [(FormNode, FormNode)]
pairs       = [FormNode] -> [FormNode] -> [(FormNode, FormNode)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FormNode]
nodes (Int -> [FormNode] -> [FormNode]
forall a. Int -> [a] -> [a]
drop Int
1 [FormNode]
nodes)
      segments :: [(Time, Pattern Double)]
segments    = [ ( Double -> Time
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> FormNode -> Double
nodeCycles Double
cpsV FormNode
n2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> FormNode -> Double
nodeCycles Double
cpsV FormNode
n1)
                      , case FormNode -> Transition
fnTrans FormNode
n1 of
                          Transition
Snap   -> Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ FormNode -> Double
accessor FormNode
n1)
                          Transition
Smooth -> Pattern Time -> Pattern Double -> Pattern Double
forall a. Pattern Time -> Pattern a -> Pattern a
segment Pattern Time
16 (Pattern Double -> Pattern Double)
-> Pattern Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ 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 b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Pattern Double) -> Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ FormNode -> Double
accessor FormNode
n1)
                                                       (Double -> Pattern Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Pattern Double) -> Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ FormNode -> Double
accessor FormNode
n2) Pattern Double
forall a. (Fractional a, Real a) => Pattern a
saw
                      )
                    | (FormNode
n1, FormNode
n2) <- [(FormNode, FormNode)]
pairs
                    ]
  in Pattern Time -> Pattern Double -> Pattern Double
forall a. Pattern Time -> Pattern a -> Pattern a
slow (Time -> Pattern Time
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
totalCycles) (Pattern Double -> Pattern Double)
-> Pattern Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ [(Time, Pattern Double)] -> Pattern Double
forall a. [(Time, Pattern a)] -> Pattern a
timecat [(Time, Pattern Double)]
segments

-- |Step signal: hold each node's value until the next (progression can't ramp).
-- Independent of 'fnTrans'. Single node: constant value.
formStep :: Double -> [FormNode] -> (FormNode -> a) -> Pattern a
formStep :: forall a. Double -> [FormNode] -> (FormNode -> a) -> Pattern a
formStep Double
_   []     FormNode -> a
_        = Pattern a
forall a. Pattern a
silence
formStep Double
_   [FormNode
node] FormNode -> a
accessor = a -> Pattern a
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormNode -> a
accessor FormNode
node)
formStep Double
cpsV [FormNode]
nodes  FormNode -> a
accessor =
  let totalCycles :: Time
totalCycles = Double -> Time
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> FormNode -> Double
nodeCycles Double
cpsV ([FormNode] -> FormNode
forall a. HasCallStack => [a] -> a
last [FormNode]
nodes)) :: Time
      pairs :: [(FormNode, FormNode)]
pairs       = [FormNode] -> [FormNode] -> [(FormNode, FormNode)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FormNode]
nodes (Int -> [FormNode] -> [FormNode]
forall a. Int -> [a] -> [a]
drop Int
1 [FormNode]
nodes)
      segments :: [(Time, Pattern a)]
segments    = [ ( Double -> Time
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> FormNode -> Double
nodeCycles Double
cpsV FormNode
n2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> FormNode -> Double
nodeCycles Double
cpsV FormNode
n1)
                      , a -> Pattern a
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormNode -> a
accessor FormNode
n1)
                      )
                    | (FormNode
n1, FormNode
n2) <- [(FormNode, FormNode)]
pairs
                    ]
  in Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
slow (Time -> Pattern Time
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
totalCycles) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ [(Time, Pattern a)] -> Pattern a
forall a. [(Time, Pattern a)] -> Pattern a
timecat [(Time, Pattern a)]
segments

-------------------------------------------------------------------------------
-- Primitives
-------------------------------------------------------------------------------

-- |Range gate: mask a pattern by kinetics signal level.
-- Events pass only when kSignal is within the (lo, hi) range.
ki :: (Double, Double) -> IK -> Pattern a -> Pattern a
ki :: forall a. (Double, Double) -> IK -> Pattern a -> Pattern a
ki (Double
lo, Double
hi) (Kinetics
kin, Pattern Int
_) = Pattern Bool -> Pattern a -> Pattern a
forall a. Pattern Bool -> Pattern a -> Pattern a
mask ((Double -> Bool) -> Pattern Double -> Pattern Bool
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
lo Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
hi) (Kinetics -> Pattern Double
kSignal Kinetics
kin))

-- |Gated stack: stack patterns and gate by kinetics range.
slate :: (Double, Double) -> IK -> [Pattern a] -> Pattern a
slate :: forall a. (Double, Double) -> IK -> [Pattern a] -> Pattern a
slate (Double, Double)
band IK
k [Pattern a]
pats = (Double, Double) -> IK -> Pattern a -> Pattern a
forall a. (Double, Double) -> IK -> Pattern a -> Pattern a
ki (Double, Double)
band IK
k (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack [Pattern a]
pats

-- |Form-relative cue: place patterns ONCE per form loop at a form time. The
-- list is stacked (the shape of 'slate'); each pattern's first cycle is squeezed
-- into the one-beat window starting at that time, so a plain one-note pattern
-- fires exactly on the beat and @\"1 1\"@ gives two hits within it. Loops in
-- lockstep with 'kSignal' — the same @slow loopCycles@ wrap as @formSignal@ —
-- so a cue and the kinetics can never drift apart. NOT kinetics-gated: a
-- placement is absolute (the launcher's @|* vel d@ still applies).
--
-- Time-unit doctrine: unprimed = bars, primed = seconds. 'mark' takes musical
-- bar numbers as written for 'rh' nodes (bar 1 = cycle 0, the number the 12 Step
-- shows); 'mark'' takes seconds elapsed as for 'at' nodes (the 12 Step's seconds
-- counter reads the same) and, like them, assumes cps has been constant since
-- cycle 0. 'markbar' \/ 'marksec' are synonyms.
--
-- Atemporal forms (single node, 'lK') fire once at absolute cycles. A time at
-- or beyond the loop end, or no cps, is silence.
--
-- @, mark 34 k [ pad 1 |* vel 0.9 ]      -- speech sample on the drop@
markAt :: FormTime -> IK -> [Pattern a] -> Pattern a
markAt :: forall a. FormTime -> IK -> [Pattern a] -> Pattern a
markAt FormTime
ft (Kinetics
kin, Pattern Int
_) [Pattern a]
pats =
  let body :: Pattern a
body  = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack [Pattern a]
pats
      cpsV :: Double
cpsV  = Kinetics -> Double
kCps Kinetics
kin
      loopC :: Time
loopC = Double -> Time
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Kinetics -> Double
kLoopSecs Kinetics
kin Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cpsV) :: Time
      c :: Time
c     = Double -> Time
forall a b. (Real a, Fractional b) => a -> b
realToFrac (case FormTime
ft of
                            Bars Double
b -> Double -> Double
barCycles Double
b
                            Secs Double
t -> Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cpsV) :: Time
  in if Double
cpsV Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 then Pattern a
forall a. Pattern a
silence
     else if Time
loopC Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
0 then Time -> Time -> Pattern a -> Pattern a
forall a. Time -> Time -> Pattern a -> Pattern a
playFor Time
c (Time
c Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
1) (Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
rotR Time
c Pattern a
body)
     else if Time
c Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
1 Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
loopC then Pattern a
forall a. Pattern a
silence
     else Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
slow (Time -> Pattern Time
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
loopC) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
compressArc (Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time
c Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
loopC) ((Time
c Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
1) Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
loopC)) Pattern a
body

-- |'markAt' in bars (see the doctrine there).
mark, markbar :: Double -> IK -> [Pattern a] -> Pattern a
mark :: forall a. Double -> IK -> [Pattern a] -> Pattern a
mark    = FormTime -> IK -> [Pattern a] -> Pattern a
forall a. FormTime -> IK -> [Pattern a] -> Pattern a
markAt (FormTime -> IK -> [Pattern a] -> Pattern a)
-> (Double -> FormTime) -> Double -> IK -> [Pattern a] -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FormTime
Bars
markbar :: forall a. Double -> IK -> [Pattern a] -> Pattern a
markbar = Double -> IK -> [Pattern a] -> Pattern a
forall a. Double -> IK -> [Pattern a] -> Pattern a
mark

-- |'markAt' in seconds.
mark', marksec :: Double -> IK -> [Pattern a] -> Pattern a
mark' :: forall a. Double -> IK -> [Pattern a] -> Pattern a
mark'   = FormTime -> IK -> [Pattern a] -> Pattern a
forall a. FormTime -> IK -> [Pattern a] -> Pattern a
markAt (FormTime -> IK -> [Pattern a] -> Pattern a)
-> (Double -> FormTime) -> Double -> IK -> [Pattern a] -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FormTime
Secs
marksec :: forall a. Double -> IK -> [Pattern a] -> Pattern a
marksec = Double -> IK -> [Pattern a] -> Pattern a
forall a. Double -> IK -> [Pattern a] -> Pattern a
mark'

-- |Kinetics-windowed dispatch: partition [0,1] into N equal windows of
-- width 1\/N, where N = length pats, and play only the pattern whose
-- window contains the current kSignal. Windows are derived at call time;
-- any N >= 1 works (N=1 collapses to "always play this pattern").
--
-- Boundaries belong to the lower window: window i covers
-- @(i\/N, (i+1)\/N]@, with window 0 also including 0. So at the boundary
-- between window i and window i+1, the lower window plays.
--
--   N=2 → [0, 1\/2], (1\/2, 1]
--   N=3 → [0, 1\/3], (1\/3, 2\/3], (2\/3, 1]
--
-- Empty list → silence. Outside [0,1] → silence (no window matches).
kinPick :: IK -> [Pattern a] -> Pattern a
kinPick :: forall a. IK -> [Pattern a] -> Pattern a
kinPick IK
_ [] = Pattern a
forall a. Pattern a
silence
kinPick (Kinetics
kin, Pattern Int
_) [Pattern a]
pats =
  let nPats :: Int
nPats  = [Pattern a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a]
pats
      step :: Double
step   = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nPats
      window :: p -> Pattern a -> Pattern a
window p
i Pattern a
p =
        let lo :: Double
lo = p -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
i       Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
step
            hi :: Double
hi = p -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
i p -> p -> p
forall a. Num a => a -> a -> a
+ p
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
step
            inWin :: Double -> Bool
inWin Double
x | p
i p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0    = Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
lo Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
hi
                    | Bool
otherwise = Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>  Double
lo Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
hi
        in Pattern Bool -> Pattern a -> Pattern a
forall a. Pattern Bool -> Pattern a -> Pattern a
mask ((Double -> Bool) -> Pattern Double -> Pattern Bool
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Bool
inWin (Kinetics -> Pattern Double
kSignal Kinetics
kin)) Pattern a
p
  in [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ((Int -> Pattern a -> Pattern a)
-> [Int] -> [Pattern a] -> [Pattern a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Pattern a -> Pattern a
forall {p} {a}. Integral p => p -> Pattern a -> Pattern a
window [Int
0 :: Int ..] [Pattern a]
pats)

-- |A degree range for every line the launcher starts, applied in 'k':
--
-- @k = isolate (-4,2) $ iK tempo form (rep s 4)@
--
-- 'isolate' keeps degree indices lo..hi (inclusive), as a line's own
-- @(-9,9)@ does; 'isolate'' keeps only those outside it (lo and hi dropped).
-- Each line's own range still applies, so the two intersect, and calls
-- compose: @isolate (-9,4) . isolate' (0,0)@ is -9..4 without degree 0.
-- Lines that don't voice degree indices (drums, walking bass, subKick,
-- harmonics, kmap) are unaffected.
isolate, isolate' :: (Int, Int) -> IK -> IK
isolate :: (Int, Int) -> IK -> IK
isolate  (Int
lo, Int
hi) = (Int -> Bool) -> IK -> IK
withDegrees (\Int
d -> Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lo Bool -> Bool -> Bool
&& Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hi)
isolate' :: (Int, Int) -> IK -> IK
isolate' (Int
lo, Int
hi) = (Int -> Bool) -> IK -> IK
withDegrees (\Int
d -> Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lo Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
hi)

withDegrees :: (Int -> Bool) -> IK -> IK
withDegrees :: (Int -> Bool) -> IK -> IK
withDegrees Int -> Bool
keep (Kinetics
kin, Pattern Int
chordPat) =
  (Kinetics
kin { kDegrees = \Int
d -> Kinetics -> Int -> Bool
kDegrees Kinetics
kin Int
d Bool -> Bool -> Bool
&& Int -> Bool
keep Int
d }, Pattern Int
chordPat)

-- |Bridge helper: apply a function taking 'Harmonic.Rules.Types.ProgressionContext.ProgressionContext' to a Kinetics context.
-- Uses innerJoin to reactively switch when the form changes progressions.
withForm :: IK -> (PC.ProgressionContext -> Pattern ValueMap) -> Pattern ValueMap
withForm :: IK -> (ProgressionContext -> Pattern ValueMap) -> Pattern ValueMap
withForm (Kinetics
kin, Pattern Int
_) ProgressionContext -> Pattern ValueMap
f = Pattern (Pattern ValueMap) -> Pattern ValueMap
forall b. Pattern (Pattern b) -> Pattern b
innerJoin (Pattern (Pattern ValueMap) -> Pattern ValueMap)
-> Pattern (Pattern ValueMap) -> Pattern ValueMap
forall a b. (a -> b) -> a -> b
$ (ProgressionContext -> Pattern ValueMap)
-> Pattern ProgressionContext -> Pattern (Pattern ValueMap)
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProgressionContext -> Pattern ValueMap
f (Kinetics -> Pattern ProgressionContext
kProg Kinetics
kin)