-- | 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
  -- * arrow buttons
  -- | Note that we need to set +-raw_controller_mode=1
  -- to use these buttons in Csound options/flags.

  -- ** Signal producers (1 / 0)
  , arrowUpSig
  , arrowDownSig
  , arrowLeftSig
  , arrowRightSig

  -- ** Sense taps (only ON press)
  , arrowUpTap
  , arrowDownTap
  , arrowLeftTap
  , arrowRightTap

  -- ** Sense on/off taps (1 for ON and 0 for OFF)
  , arrowUpToggle
  , arrowDownToggle
  , arrowLeftToggle
  , arrowRightToggle
) 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((D -> Unit) -> Evt D -> Tick
forall a b. (a -> b) -> Evt a -> Evt b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> SE a
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 a b. (a -> b) -> Evt a -> Evt b
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 a b. (a -> b) -> [a] -> [b]
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 a b. (a -> b) -> Evt a -> Evt b
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 a b. (a -> b) -> SE a -> SE b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
--

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

upNum, downNum, leftNum, rightNum :: D

upNum :: D
upNum    = D
114
downNum :: D
downNum  = D
115
leftNum :: D
leftNum  = D
116
rightNum :: D
rightNum = D
117

arrowUpSig :: LkChn -> SE Sig
arrowUpSig :: LkChn -> SE Sig
arrowUpSig = D -> LkChn -> SE Sig
arrowSig D
upNum

arrowDownSig :: LkChn -> SE Sig
arrowDownSig :: LkChn -> SE Sig
arrowDownSig = D -> LkChn -> SE Sig
arrowSig D
downNum

arrowLeftSig :: LkChn -> SE Sig
arrowLeftSig :: LkChn -> SE Sig
arrowLeftSig = D -> LkChn -> SE Sig
arrowSig D
leftNum

arrowRightSig :: LkChn -> SE Sig
arrowRightSig :: LkChn -> SE Sig
arrowRightSig = D -> LkChn -> SE Sig
arrowSig D
rightNum

arrowSig :: D -> LkChn -> SE Sig
arrowSig :: D -> LkChn -> SE Sig
arrowSig D
idx (LkChn Int
chn) =
  D -> D -> D -> SE Sig
umidiCtrl (Int -> D
int Int
chn) D
idx D
0

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

arrowUpTap :: LkChn -> SE Tick
arrowUpTap :: LkChn -> SE Tick
arrowUpTap = D -> LkChn -> SE Tick
toArrowTap D
upNum

arrowDownTap :: LkChn -> SE Tick
arrowDownTap :: LkChn -> SE Tick
arrowDownTap = D -> LkChn -> SE Tick
toArrowTap D
downNum

arrowLeftTap :: LkChn -> SE Tick
arrowLeftTap :: LkChn -> SE Tick
arrowLeftTap = D -> LkChn -> SE Tick
toArrowTap D
leftNum

arrowRightTap :: LkChn -> SE Tick
arrowRightTap :: LkChn -> SE Tick
arrowRightTap = D -> LkChn -> SE Tick
toArrowTap D
rightNum

toArrowTap :: D -> LkChn -> SE Tick
toArrowTap :: D -> LkChn -> SE Tick
toArrowTap D
idx LkChn
chn =
  (Sig -> Tick) -> SE Sig -> SE Tick
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((D -> Unit) -> Evt D -> Tick
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit -> D -> Unit
forall a b. a -> b -> a
const Unit
unit) (Evt D -> Tick) -> (Sig -> Evt D) -> Sig -> Tick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> BoolSig) -> Evt D -> Evt D
forall a. (a -> BoolSig) -> Evt a -> Evt a
filterE ((Sig -> Sig -> BoolSig
forall bool. (bool ~ BooleanOf Sig) => Sig -> Sig -> bool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (Sig -> BoolSig) -> (D -> Sig) -> D -> BoolSig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig) (Evt D -> Evt D) -> (Sig -> Evt D) -> Sig -> Evt D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Evt D
snaps) (SE Sig -> SE Tick) -> SE Sig -> SE Tick
forall a b. (a -> b) -> a -> b
$ D -> LkChn -> SE Sig
arrowSig D
idx LkChn
chn

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

arrowUpToggle :: LkChn -> SE (Evt D)
arrowUpToggle :: LkChn -> SE (Evt D)
arrowUpToggle = D -> LkChn -> SE (Evt D)
toArrowToggle D
upNum

arrowDownToggle :: LkChn -> SE (Evt D)
arrowDownToggle :: LkChn -> SE (Evt D)
arrowDownToggle = D -> LkChn -> SE (Evt D)
toArrowToggle D
downNum

arrowLeftToggle :: LkChn -> SE (Evt D)
arrowLeftToggle :: LkChn -> SE (Evt D)
arrowLeftToggle = D -> LkChn -> SE (Evt D)
toArrowToggle D
leftNum

arrowRightToggle :: LkChn -> SE (Evt D)
arrowRightToggle :: LkChn -> SE (Evt D)
arrowRightToggle = D -> LkChn -> SE (Evt D)
toArrowToggle D
rightNum

toArrowToggle :: D -> LkChn -> SE (Evt D)
toArrowToggle :: D -> LkChn -> SE (Evt D)
toArrowToggle D
idx LkChn
chn = (Sig -> Evt D) -> SE Sig -> SE (Evt D)
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sig -> Evt D
snaps (SE Sig -> SE (Evt D)) -> SE Sig -> SE (Evt D)
forall a b. (a -> b) -> a -> b
$ D -> LkChn -> SE Sig
arrowSig D
idx LkChn
chn