-- Copyright 2014 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Cmds to interpret hardware controllers.  This basically means magic MIDI
-- msgs from a keyboard or something which is intended to do something other
-- than play a note.
module Cmd.Controller where
import qualified Midi.Midi as Midi
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Edit as Edit
import qualified Cmd.Msg as Msg
import qualified Cmd.Play as Play
import qualified Cmd.Selection as Selection
import qualified Cmd.TimeStep as TimeStep


-- | Buttons you might find on the transport section of a controller keyboard.
-- Since everyone's setup is different, this is expected to be configured in
-- "Local.Config".
data TransportConfig = TransportConfig {
    TransportConfig -> MatchMidi
config_repeat :: MatchMidi
    , TransportConfig -> MatchMidi
config_backward :: MatchMidi
    , TransportConfig -> MatchMidi
config_forward :: MatchMidi
    , TransportConfig -> MatchMidi
config_stop :: MatchMidi
    , TransportConfig -> MatchMidi
config_play :: MatchMidi
    , TransportConfig -> MatchMidi
config_record :: MatchMidi
    }

type MatchMidi = Midi.Message -> Bool

note_on :: Midi.Key -> MatchMidi
note_on :: Key -> MatchMidi
note_on Key
key (Midi.ChannelMessage Channel
_ (Midi.NoteOn Key
k Channel
_)) = Key
key forall a. Eq a => a -> a -> Bool
== Key
k
note_on Key
_ Message
_ = Bool
False

transport :: TransportConfig -> Msg.Msg -> Cmd.CmdT IO Cmd.Status
transport :: TransportConfig -> Msg -> CmdT IO Status
transport TransportConfig
config Msg
msg = do
    Message
msg <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall a b. (a -> b) -> a -> b
$ Msg -> Maybe Message
Msg.midi Msg
msg
    if  | TransportConfig -> MatchMidi
config_repeat TransportConfig
config Message
msg -> forall {a}. CmdT IO a -> CmdT IO Status
done forall (m :: * -> *). M m => m ()
Edit.toggle_note_duration
        | TransportConfig -> MatchMidi
config_backward TransportConfig
config Message
msg ->
            forall {a}. CmdT IO a -> CmdT IO Status
done forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Rewind Move
Selection.Replace
        | TransportConfig -> MatchMidi
config_forward TransportConfig
config Message
msg ->
            forall {a}. CmdT IO a -> CmdT IO Status
done forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => Direction -> Move -> m ()
Selection.step Direction
TimeStep.Advance Move
Selection.Replace
        | TransportConfig -> MatchMidi
config_stop TransportConfig
config Message
msg -> forall {a}. CmdT IO a -> CmdT IO Status
done forall a b. (a -> b) -> a -> b
$ CmdT IO Bool
Play.cmd_context_stop
        -- TODO configure what this is
        -- I could have a "default play" cmd
        | TransportConfig -> MatchMidi
config_play TransportConfig
config Message
msg -> PlayArgs -> Status
Cmd.Play forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m PlayArgs
Play.local_top
        | TransportConfig -> MatchMidi
config_record TransportConfig
config Message
msg -> forall {a}. CmdT IO a -> CmdT IO Status
done forall (m :: * -> *). M m => m ()
Edit.cmd_toggle_val_edit
        | Bool
otherwise -> forall (m :: * -> *) a. M m => m a
Cmd.abort
    where done :: CmdT IO a -> CmdT IO Status
done = (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cmd.Done)