-- | Functions to play with Novation LaunchKey midi-controller
module Csound.Control.Midi.LaunchKey(
    LkChn(..)
  , knob
  , knobs
  , idKnobs
  , knob'
  , knobs'
  , idKnobs'
  , tapBtn
  , tapBtns
  , tapBtnRow
  , tapBtnRowSig
  , toggleBtn
  , toggleBtns
) where

import Control.Monad
import Csound.Base hiding (knob, knob')

-- | Midi channel
newtype LkChn = LkChn Int

instance Default LkChn where
  def :: LkChn
def = Int -> LkChn
LkChn Int
9

-- | Knob get unipolar value of the LK8 knob
--
-- > knob knobId initVal
--
-- knobId - [1, 16]
knob' :: LkChn -> Int -> D -> SE Sig
knob' :: LkChn -> Int -> D -> SE Sig
knob' (LkChn Int
chn) Int
n D
initValue = D -> D -> D -> SE Sig
umidiCtrl (Int -> D
int Int
chn) (Int -> D
getKnobId Int
n) D
initValue

knobs' :: LkChn -> [D] -> SE [Sig]
knobs' :: LkChn -> [D] -> SE [Sig]
knobs' LkChn
chn = LkChn -> [Int] -> [D] -> SE [Sig]
idKnobs' LkChn
chn [Int
1..]

idKnobs' :: LkChn -> [Int] -> [D] -> SE [Sig]
idKnobs' :: LkChn -> [Int] -> [D] -> SE [Sig]
idKnobs' LkChn
chn [Int]
ids [D]
initVals = ((Int, D) -> SE Sig) -> [(Int, D)] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> D -> SE Sig) -> (Int, D) -> SE Sig
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> D -> SE Sig) -> (Int, D) -> SE Sig)
-> (Int -> D -> SE Sig) -> (Int, D) -> SE Sig
forall a b. (a -> b) -> a -> b
$ LkChn -> Int -> D -> SE Sig
knob' LkChn
chn) ([(Int, D)] -> SE [Sig]) -> [(Int, D)] -> SE [Sig]
forall a b. (a -> b) -> a -> b
$ [Int] -> [D] -> [(Int, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ids [D]
initVals

knob :: Int -> D -> SE Sig
knob :: Int -> D -> SE Sig
knob = LkChn -> Int -> D -> SE Sig
knob' LkChn
forall a. Default a => a
def

knobs :: [D] -> SE [Sig]
knobs :: [D] -> SE [Sig]
knobs = LkChn -> [D] -> SE [Sig]
knobs' LkChn
forall a. Default a => a
def

idKnobs :: [Int] -> [D] -> SE [Sig]
idKnobs :: [Int] -> [D] -> SE [Sig]
idKnobs = LkChn -> [Int] -> [D] -> SE [Sig]
idKnobs' LkChn
forall a. Default a => a
def

getKnobId :: Int -> D
getKnobId :: Int -> D
getKnobId Int
n
  | Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8  = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
  | Int
9 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16 = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)
  | Bool
otherwise         = [Char] -> D
forall a. HasCallStack => [Char] -> a
error [Char]
"LK8 has only 16 knobs"

--------------------------

tapBtn :: LkChn -> Int -> SE Tick
tapBtn :: LkChn -> Int -> SE Tick
tapBtn (LkChn Int
n) Int
idx = (Evt D -> Tick) -> SE (Evt D) -> SE Tick
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((D -> Unit) -> Evt D -> Tick
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((D -> Unit) -> Evt D -> Tick) -> (D -> Unit) -> Evt D -> Tick
forall a b. (a -> b) -> a -> b
$ Unit -> D -> Unit
forall a b. a -> b -> a
const Unit
unit) (SE (Evt D) -> SE Tick) -> SE (Evt D) -> SE Tick
forall a b. (a -> b) -> a -> b
$ MidiChn -> D -> SE (Evt D)
midiKeyOn (Int -> MidiChn
Chn Int
n) (Int -> D
getBtnNote Int
idx)

tapBtns :: LkChn -> SE [Tick]
tapBtns :: LkChn -> SE [Tick]
tapBtns LkChn
chn = (Int -> SE Tick) -> [Int] -> SE [Tick]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (LkChn -> Int -> SE Tick
tapBtn LkChn
chn) [Int
1..Int
8]

tapBtnRow :: LkChn -> SE (Evt D)
tapBtnRow :: LkChn -> SE (Evt D)
tapBtnRow LkChn
chn = do
  [Tick]
evts <- LkChn -> SE [Tick]
tapBtns LkChn
chn
  Evt D -> SE (Evt D)
forall (m :: * -> *) a. Monad m => a -> m a
return (Evt D -> SE (Evt D)) -> Evt D -> SE (Evt D)
forall a b. (a -> b) -> a -> b
$ [Evt D] -> Evt D
forall a. Monoid a => [a] -> a
mconcat ([Evt D] -> Evt D) -> [Evt D] -> Evt D
forall a b. (a -> b) -> a -> b
$ (D -> Tick -> Evt D) -> [D] -> [Tick] -> [Evt D]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\D
n Tick
ev -> (Unit -> D) -> Tick -> Evt D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Unit -> D
forall a b. a -> b -> a
const D
n) Tick
ev) ((Int -> D) -> [Int] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> D
int [Int
1..]) [Tick]
evts

tapBtnRowSig :: LkChn -> SE Sig
tapBtnRowSig :: LkChn -> SE Sig
tapBtnRowSig = Sig -> Evt Sig -> SE Sig
forall a. Tuple a => a -> Evt a -> SE a
stepper Sig
0 (Evt Sig -> SE Sig) -> (Evt D -> Evt Sig) -> Evt D -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> Sig) -> Evt D -> Evt Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap D -> Sig
sig (Evt D -> SE Sig) -> (LkChn -> SE (Evt D)) -> LkChn -> SE Sig
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< LkChn -> SE (Evt D)
tapBtnRow

getBtnNote :: Int -> D
getBtnNote :: Int -> D
getBtnNote Int
n
  | Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4 = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
  | Int
5 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
  | Bool
otherwise        = [Char] -> D
forall a. HasCallStack => [Char] -> a
error [Char]
"LK8 has only 8 buttons"

toggleBtn :: LkChn -> Int -> SE (Evt D)
toggleBtn :: LkChn -> Int -> SE (Evt D)
toggleBtn LkChn
chn Int
idx = (Tick -> Evt D) -> SE Tick -> SE (Evt D)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tick -> Evt D
toTog (SE Tick -> SE (Evt D)) -> SE Tick -> SE (Evt D)
forall a b. (a -> b) -> a -> b
$ LkChn -> Int -> SE Tick
tapBtn LkChn
chn Int
idx

toggleBtns :: LkChn -> SE [Evt D]
toggleBtns :: LkChn -> SE [Evt D]
toggleBtns LkChn
chn = (Int -> SE (Evt D)) -> [Int] -> SE [Evt D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (LkChn -> Int -> SE (Evt D)
toggleBtn LkChn
chn) [Int
1..Int
8]


-- pressBtn :: Chn -> Int -> Evt Bool

-- pressBtnSig :: Chn -> Int -> SE Sig
-- toggleBtnSig :: Chn -> Int -> SE Sig