module System.MIDI.Launchpad.Apps.FXControl where
import Data.List
import Control.Monad
import System.MIDI
import Data.Array.Unboxed
import Data.Array.IArray
import System.MIDI.Launchpad.Control
import System.MIDI.Launchpad.AppFramework
data Cfg = Cfg
{ ccFrom :: !Int
, onOffFrom :: !Int
}
deriving Show
defaultCfg :: Cfg
defaultCfg = Cfg
{ ccFrom = 100
, onOffFrom = 100
}
data Mode = FX deriving (Eq,Ord,Show)
data Trigger = Switch | Gate deriving (Eq,Ord,Show)
data State = State
{ _onOff :: !(UArray Int Bool)
, _isPressed :: !(UArray Int Bool)
, _triggerMode :: !(Array Int Trigger)
, _params :: !(UArray Int Int)
, _playing :: !Bool
}
deriving (Eq,Ord,Show)
fxControl :: Cfg -> PureApp Cfg Mode State
fxControl cfg = PureApp
{ pAppConfig = cfg
, pAppIniState = (FX,initialState)
, pAppRender = render
, pAppButton = button
, pAppStartStop = startStop
, pAppSync = sync
}
initialState :: State
initialState = State
{ _onOff = listArray (0,7) (repeat False)
, _isPressed = listArray (0,7) (repeat False)
, _triggerMode = listArray (0,7) (replicate 4 Switch ++ replicate 4 Gate)
, _params = listArray (0,7) (repeat 4)
, _playing = False
}
startStop :: Cfg -> Bool -> State -> State
startStop _ playing state = state { _playing = playing }
button :: Cfg -> ButtonPress -> (Mode,State) -> ((Mode,State),[MidiMessage'])
button (Cfg ccfrom notefrom) press (mode,state) =
case but of
Dir d -> case d of
U -> ((mode, trigger' Switch),[])
D -> ((mode, trigger' Gate ),[])
_ -> ((mode,state),[])
Side k -> case (trigger!k) of
Switch -> if not down
then ( ( mode , state' k ) , [] )
else ( ( mode , (state' k) { _onOff = onOff // [(k,new)] } ) , [ noteOnOff k new ] )
where old = onOff ! k
new = not old
Gate -> ( ( mode , (state' k) { _onOff = onOff // [(k,down)] } ) , [ noteOnOff k down ] )
Pad x y -> if down
then ( ( mode, state { _params = params // [(x, 7y)] } ) , [CC (ccNumber x) ((7y)*16)] )
else ((mode,state),[])
_ -> ((mode,state),[])
where
state' k = state { _isPressed = isPressed // [(k,down)] }
trigger' Gate = state { _triggerMode = trigger // [ (k,Gate ) | (k,True) <- pressedList ]
, _onOff = onOff // [ (k,True ) | (k,True) <- pressedList ]
}
trigger' Switch = state { _triggerMode = trigger // [ (k,Switch) | (k,True) <- pressedList ]
, _onOff = onOff // [ (k,True ) | (k,True) <- pressedList, trigger!k == Gate ]
}
noteOnOff k b = if b
then NoteOn (notefrom+k) 127
else NoteOn (notefrom+k) 127
ccNumber x = ccfrom + x
onOff = _onOff state
params = _params state
trigger = _triggerMode state
isPressed = _isPressed state
pressedList = assocs isPressed
(but,down) = case press of
Press b -> (b,True )
Release b -> (b,False)
sync :: Cfg -> Mode -> State -> Int -> (State,[MidiMessage'])
sync _ mode state counter = (state,[])
render :: Cfg -> Mode -> State -> Maybe Int -> [(Button,Color)]
render _ mode state msync = stuff where
onOff = _onOff state
params = _params state
trigger = _triggerMode state
isPressed = _isPressed state
stuff = par ++ side
par = [ (Pad x y, color) | x<-[0..7], let p = params!x, p>0, y<-[7p..7]
, let color = green ]
side = [ (Side y, color) | y<-[0..7], let b = onOff!y, let color = trigColor y b ]
trigColor y b = case trigger!y of
Switch -> if b then amber else None
Gate -> if b then red else None