-- |
-- Module      : Harmonic.Interface.Tidal.Devices.RC10R
-- Description : Boss RC-10R Rhythm Loop Station — structural looper control
--
-- The pedal's own switches own everything one-off or stateful: recording,
-- undo\/redo, phrase memories, clearing. This module covers the timed,
-- repeated and structural side: starting and stopping the recorded tracks,
-- breaks, the preset rhythm's start, stop, fills and A\/B groove, the rhythm
-- kit, and levels that follow the form.
--
-- Every function is a control change on MIDI channel 10, CC 70-84. The rig's
-- X3 interface consumes that lane before the MPC sees it and re-sends it on
-- the RC-10R's own wire (X3 Out C): CC 70-83 on the RC-10R's control channel
-- (1), CC 84 as a program change on its note channel (2). The pedal's MIDI
-- menu carries the matching assignments:
--
-- @
-- CC  RC-10R function        CC  RC-10R function
-- 70  TRK1 START             78  RHY STOP
-- 71  TRK1 STOP              79  RHY FILLIN
-- 72  TRK2 START             80  RHY DIVISION
-- 73  TRK2 STOP              81  LOOP LEVEL
-- 74  LOOP STOP              82  RHY LEVEL
-- 75  ALL BREAK              83  TOTAL LEVEL
-- 76  RHY BREAK              84  rhythm kit (program change, value = kit 1-16)
-- 77  RHY START
-- RX CONTROL CH 1 · RX NOTE CH 2 · SYNC CLOCK MIDI (Tidal's clock, re-clocked by the X3)
-- @
--
-- Presses take a gate, like the drum names: @rcFill \"[0 0 0 0 0 0 0 1]\/32\"@,
-- @mark 33 k [silence, rcBreak \"1\"]@, @once $ rcStop \"1\"@.
--
-- The pedal's drum kit is played through the MPC on a second lane, ch 10
-- CC 33-48: CC 33 + pad, value = velocity. The X3 consumes it and sends each
-- hit as note 19-34 (pad + 19, clear of every other ch 10 note) out of its USB
-- port 2 (Drums) to an MPC MIDI track (pads Chromatic C-2 transposed +19), which
-- records or plays it and sends it on through port 3
-- (Looper); the X3 translates those notes to the kit's own and plays them on
-- the note channel. A @dkit@ block is written with the shared drum names
-- ("Harmonic.Interface.Tidal.Devices.JV1010", notes 0-15) and finished by
-- 'x3rc10'.
module Harmonic.Interface.Tidal.Devices.RC10R
  (
    -- * Loop tracks
    rcTrk1, rcTrk1Stop, rcTrk2, rcTrk2Stop, rcStop

    -- * Breaks
  , rcBreak, rcRhythmBreak

    -- * Preset rhythm
  , rcRhythm, rcRhythmStop, rcFill, rcPattern, rcKit

    -- * Levels
  , rcLoopLevel, rcRhythmLevel, rcLevel

    -- * Loops entering with the form
  , rcGate

    -- * Drum kit
  , x3rc10
  ) where

import qualified Data.Map.Strict as Map
import Sound.Tidal.Context
import Harmonic.Interface.Tidal.Instruments (ch)
import Harmonic.Interface.Tidal.Form (Kinetics(..), IK, beatsPerBar)

-- The lane every RC-10R message rides: channel 10, consumed by the X3.
rcLane :: Pattern ValueMap
rcLane :: Pattern ValueMap
rcLane = Int -> Pattern ValueMap
ch Int
10

-- A raw control-change value (0-127) on the lane.
ccRaw :: Pattern Double -> Pattern Double -> ControlPattern
ccRaw :: Pattern Double -> Pattern Double -> Pattern ValueMap
ccRaw Pattern Double
num Pattern Double
v = Pattern Double -> Pattern ValueMap
control Pattern Double
v Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> Pattern ValueMap
midicmd Pattern String
"control" Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
ctlNum Pattern Double
num Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern ValueMap
rcLane

-- | A footswitch press on CC @num@ at each true onset of the gate: value 127,
-- then 0 a sixteenth of a cycle later, so every press is a fresh transition.
pressCC :: Pattern Double -> Pattern Bool -> ControlPattern
pressCC :: Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
num Pattern Bool
g = [Pattern ValueMap] -> Pattern ValueMap
forall a. [Pattern a] -> Pattern a
stack
  [ Pattern Bool -> Pattern ValueMap -> Pattern ValueMap
forall a. Pattern Bool -> Pattern a -> Pattern a
struct Pattern Bool
g (Pattern Double -> Pattern Double -> Pattern ValueMap
ccRaw Pattern Double
num Pattern Double
127)
  , (Pattern Time
1Pattern Time -> Pattern Time -> Pattern Time
forall a. Fractional a => a -> a -> a
/Pattern Time
16) Pattern Time -> Pattern ValueMap -> Pattern ValueMap
forall a. Pattern Time -> Pattern a -> Pattern a
~> Pattern Bool -> Pattern ValueMap -> Pattern ValueMap
forall a. Pattern Bool -> Pattern a -> Pattern a
struct Pattern Bool
g (Pattern Double -> Pattern Double -> Pattern ValueMap
ccRaw Pattern Double
num Pattern Double
0)
  ]

-------------------------------------------------------------------------------
-- Loop tracks
-------------------------------------------------------------------------------

-- | Start or stop a recorded track. With LOOP TRACK MODE set to PARALLEL the
-- two tracks are independent, so they can be arranged like instruments.
rcTrk1, rcTrk1Stop, rcTrk2, rcTrk2Stop :: Pattern Bool -> ControlPattern
rcTrk1 :: Pattern Bool -> Pattern ValueMap
rcTrk1     = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
70
rcTrk1Stop :: Pattern Bool -> Pattern ValueMap
rcTrk1Stop = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
71
rcTrk2 :: Pattern Bool -> Pattern ValueMap
rcTrk2     = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
72
rcTrk2Stop :: Pattern Bool -> Pattern ValueMap
rcTrk2Stop = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
73

-- | Stop the looper (both tracks), observing the pedal's STOP MODE.
rcStop :: Pattern Bool -> ControlPattern
rcStop :: Pattern Bool -> Pattern ValueMap
rcStop = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
74

-------------------------------------------------------------------------------
-- Breaks
-------------------------------------------------------------------------------

-- | ALL BREAK: rhythm and loops cut out for the rest of the bar and return on
-- the next downbeat.
rcBreak :: Pattern Bool -> ControlPattern
rcBreak :: Pattern Bool -> Pattern ValueMap
rcBreak = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
75

-- | RHY BREAK: the same, drums only; the loops keep playing.
rcRhythmBreak :: Pattern Bool -> ControlPattern
rcRhythmBreak :: Pattern Bool -> Pattern ValueMap
rcRhythmBreak = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
76

-------------------------------------------------------------------------------
-- Preset rhythm
-------------------------------------------------------------------------------

rcRhythm, rcRhythmStop, rcFill, rcPattern :: Pattern Bool -> ControlPattern
rcRhythm :: Pattern Bool -> Pattern ValueMap
rcRhythm     = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
77   -- RHY START
rcRhythmStop :: Pattern Bool -> Pattern ValueMap
rcRhythmStop = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
78   -- RHY STOP, observing the pedal's STOP MODE
rcFill :: Pattern Bool -> Pattern ValueMap
rcFill       = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
79   -- RHY FILLIN
rcPattern :: Pattern Bool -> Pattern ValueMap
rcPattern    = Pattern Double -> Pattern Bool -> Pattern ValueMap
pressCC Pattern Double
80   -- RHY DIVISION: toggles PTN1 / PTN2; the pedal holds the state

-- | Select the rhythm kit, 1-16, in Roland's order: Studio, Live, Light,
-- Heavy, Rock, Metal, Jazz, Brushes, Cajon, Drum&Bs, R&B, Dance, Techno,
-- Dance Beats, Hiphop, 808+909. One message per event:
-- @mark 1 k [silence, rcKit 8]@.
rcKit :: Pattern Double -> ControlPattern
rcKit :: Pattern Double -> Pattern ValueMap
rcKit = Pattern Double -> Pattern Double -> Pattern ValueMap
ccRaw Pattern Double
84

-------------------------------------------------------------------------------
-- Levels
-------------------------------------------------------------------------------

-- | Playback levels, 0-1. Any signal — a constant, an @lfo@, or the form's own
-- @kDynamic (fst k)@ — sampled sixteen times per bar.
rcLoopLevel, rcRhythmLevel, rcLevel :: Pattern Double -> ControlPattern
rcLoopLevel :: Pattern Double -> Pattern ValueMap
rcLoopLevel   = Pattern Double -> Pattern Double -> Pattern ValueMap
levelCC Pattern Double
81
rcRhythmLevel :: Pattern Double -> Pattern ValueMap
rcRhythmLevel = Pattern Double -> Pattern Double -> Pattern ValueMap
levelCC Pattern Double
82
rcLevel :: Pattern Double -> Pattern ValueMap
rcLevel       = Pattern Double -> Pattern Double -> Pattern ValueMap
levelCC Pattern Double
83   -- TOTAL LEVEL: rhythm and loops together

levelCC :: Pattern Double -> Pattern Double -> ControlPattern
levelCC :: Pattern Double -> Pattern Double -> Pattern ValueMap
levelCC Pattern Double
num Pattern Double
v = Pattern Double -> Pattern Double -> Pattern ValueMap
ccRaw Pattern Double
num ((Double -> Double) -> Pattern Double -> Pattern Double
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1 Double
x) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
127) :: Int)) (Pattern Time -> Pattern Double -> Pattern Double
forall a. Pattern Time -> Pattern a -> Pattern a
segment Pattern Time
4 Pattern Double
v))

-------------------------------------------------------------------------------
-- Loops entering with the form
-------------------------------------------------------------------------------

-- | A recorded track that enters and leaves with the form, like a section at
-- its kinetics threshold: TRK@trk@ START on the first bar the form's kinetics is
-- inside @(lo, hi)@, TRK@trk@ STOP on the first bar it is outside. Sampled at
-- each downbeat; only the crossings send anything, so no state is kept.
rcGate :: (Double, Double) -> IK -> Int -> ControlPattern
rcGate :: (Double, Double) -> IK -> Int -> Pattern ValueMap
rcGate (Double
lo, Double
hi) IK
k Int
trk =
  let bar :: Time
bar      = Double -> Time
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
beatsPerBar :: Time
      inBand :: Pattern Bool
inBand   = (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 (IK -> Kinetics
forall a b. (a, b) -> a
fst IK
k))
      now :: Pattern Bool
now      = Pattern Time -> Pattern Bool -> Pattern Bool
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
bar) (Pattern Time -> Pattern Bool -> Pattern Bool
forall a. Pattern Time -> Pattern a -> Pattern a
segment Pattern Time
1 (Pattern Time -> Pattern Bool -> Pattern Bool
forall a. Pattern Time -> Pattern a -> Pattern a
fast (Time -> Pattern Time
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
bar) Pattern Bool
inBand))   -- one sample per bar, at the downbeat
      before :: Pattern Bool
before   = Time
bar Time -> Pattern Bool -> Pattern Bool
forall a. Time -> Pattern a -> Pattern a
`rotR` Pattern Bool
now                            -- the previous bar's sample
      edge :: (Bool -> Bool -> Bool) -> Pattern Bool
edge Bool -> Bool -> Bool
f   = (Bool -> Bool) -> Pattern Bool -> Pattern Bool
forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues Bool -> Bool
forall a. a -> a
id (Bool -> Bool -> Bool
f (Bool -> Bool -> Bool) -> Pattern Bool -> Pattern (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Bool
now Pattern (Bool -> Bool) -> Pattern Bool -> Pattern Bool
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Bool
before)
      entering :: Pattern Bool
entering = (Bool -> Bool -> Bool) -> Pattern Bool
edge (\Bool
a Bool
b -> Bool
a Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
b)
      leaving :: Pattern Bool
leaving  = (Bool -> Bool -> Bool) -> Pattern Bool
edge (\Bool
a Bool
b -> Bool -> Bool
not Bool
a Bool -> Bool -> Bool
&& Bool
b)
      (Pattern Bool -> Pattern ValueMap
onTrk, Pattern Bool -> Pattern ValueMap
offTrk) = if Int
trk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then (Pattern Bool -> Pattern ValueMap
rcTrk2, Pattern Bool -> Pattern ValueMap
rcTrk2Stop) else (Pattern Bool -> Pattern ValueMap
rcTrk1, Pattern Bool -> Pattern ValueMap
rcTrk1Stop)
  in [Pattern ValueMap] -> Pattern ValueMap
forall a. [Pattern a] -> Pattern a
stack [Pattern Bool -> Pattern ValueMap
onTrk Pattern Bool
entering, Pattern Bool -> Pattern ValueMap
offTrk Pattern Bool
leaving]

-------------------------------------------------------------------------------
-- Drum kit
-------------------------------------------------------------------------------

-- | The @dkit@ block's finaliser: every drum-pad event (notes 0-15) becomes a
-- CC on the drum lane, CC 33 + pad with its final velocity (@amp@ x 127) as the
-- value. It comes last because a block applies @|* vel d@ after the names. An
-- event without @amp@ takes SuperDirt's default, 0.4, as it would on the MPC
-- kits. Any other note, and a velocity that rounds to 0, is dropped.
x3rc10 :: ControlPattern -> ControlPattern
x3rc10 :: Pattern ValueMap -> Pattern ValueMap
x3rc10 = Pattern (Maybe ValueMap) -> Pattern ValueMap
forall a. Pattern (Maybe a) -> Pattern a
filterJust (Pattern (Maybe ValueMap) -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern (Maybe ValueMap))
-> Pattern ValueMap
-> Pattern ValueMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValueMap -> Maybe ValueMap)
-> Pattern ValueMap -> Pattern (Maybe ValueMap)
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueMap -> Maybe ValueMap
forall {k}.
(Ord k, IsString k) =>
Map k Value -> Maybe (Map k Value)
toLane
  where
    toLane :: Map k Value -> Maybe (Map k Value)
toLane Map k Value
vm = do
      nt <- k -> Map k Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"note" Map k Value
vm Maybe Value -> (Value -> Maybe Note) -> Maybe Note
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Note
getN
      let a   = Double -> (Double -> Double) -> Maybe Double -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0.4 Double -> Double
forall a. a -> a
id (k -> Map k Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"amp" Map k Value
vm Maybe Value -> (Value -> Maybe Double) -> Maybe Double
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Double
getF)
          pad = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Note -> Double
unNote Note
nt) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
60 :: Int
          v   = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
127 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
127)) :: Int
      if pad < 0 || pad > 15 || v < 1 then Nothing else
        Just $ Map.union
          (Map.fromList [ ("s", VS "thru"), ("midichan", VF 9), ("midicmd", VS "control")
                        , ("ctlNum", VF (fromIntegral (33 + pad))), ("control", VF (fromIntegral v)) ])
          (foldr Map.delete vm ["note", "amp", "sustain"])