-- Copyright 2013 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 modify cmd state.
module Cmd.Repl.LCmd where
import qualified Cmd.Cmd as Cmd
import qualified Cmd.TimeStep as TimeStep
import qualified Midi.Midi as Midi
import qualified Perform.RealTime as RealTime

import           Global
import           Types


-- * config


-- | Temporarily set 'Cmd.config_im_play_direct', see
-- 'App.StaticConfig.im_play_direct' to set it permanently.
im_play_direct :: Cmd.M m => m Bool
im_play_direct :: forall (m :: * -> *). M m => m Bool
im_play_direct = do
    forall (m :: * -> *). M m => (State -> State) -> m ()
Cmd.modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st
        { state_config :: Config
Cmd.state_config = (State -> Config
Cmd.state_config State
st)
            { config_im_play_direct :: Bool
Cmd.config_im_play_direct =
                Bool -> Bool
not (Config -> Bool
Cmd.config_im_play_direct (State -> Config
Cmd.state_config State
st))
            }
        }
    forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets forall a b. (a -> b) -> a -> b
$ Config -> Bool
Cmd.config_im_play_direct forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Config
Cmd.state_config

-- * edit

get_step :: Cmd.CmdL Text
get_step :: CmdL Text
get_step = TimeStep -> Text
TimeStep.show_time_step forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmdL TimeStep
get_time_step

set_step :: Text -> Cmd.CmdL ()
set_step :: Text -> CmdL ()
set_step = TimeStep -> CmdL ()
set_time_step forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) err a.
(Stack, M m) =>
(err -> Text) -> Either err a -> m a
Cmd.require_right forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text TimeStep
TimeStep.parse_time_step

get_time_step :: Cmd.CmdL TimeStep.TimeStep
get_time_step :: CmdL TimeStep
get_time_step = forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (EditState -> TimeStep
Cmd.state_time_step forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit)

set_time_step :: TimeStep.TimeStep -> Cmd.CmdL ()
set_time_step :: TimeStep -> CmdL ()
set_time_step TimeStep
step = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
    EditState
st { state_time_step :: TimeStep
Cmd.state_time_step = TimeStep
step }

set_note_duration :: TimeStep.TimeStep -> Cmd.CmdL ()
set_note_duration :: TimeStep -> CmdL ()
set_note_duration TimeStep
step = forall (m :: * -> *). M m => (EditState -> EditState) -> m ()
Cmd.modify_edit_state forall a b. (a -> b) -> a -> b
$ \EditState
st ->
    EditState
st { state_note_duration :: TimeStep
Cmd.state_note_duration = TimeStep
step }

-- | Set the note duration to the time step.
dur_to_step :: Cmd.CmdL ()
dur_to_step :: CmdL ()
dur_to_step = TimeStep -> CmdL ()
set_note_duration forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmdL TimeStep
get_time_step

dur_to_end :: Cmd.CmdL ()
dur_to_end :: CmdL ()
dur_to_end = TimeStep -> CmdL ()
set_note_duration forall a b. (a -> b) -> a -> b
$ Step -> TimeStep
TimeStep.time_step Step
TimeStep.BlockEdge

-- | Set play step to current step.
set_play_step :: Cmd.CmdL ()
set_play_step :: CmdL ()
set_play_step = do
    TimeStep
step <- forall (m :: * -> *). M m => m TimeStep
Cmd.get_current_step
    forall (m :: * -> *). M m => (PlayState -> PlayState) -> m ()
Cmd.modify_play_state forall a b. (a -> b) -> a -> b
$ \PlayState
st -> PlayState
st { state_play_step :: TimeStep
Cmd.state_play_step = TimeStep
step }

-- * play

set_play_multiplier :: Double -> Cmd.CmdL ()
set_play_multiplier :: Double -> CmdL ()
set_play_multiplier Double
d = forall (m :: * -> *). M m => (PlayState -> PlayState) -> m ()
Cmd.modify_play_state forall a b. (a -> b) -> a -> b
$ \PlayState
st ->
    PlayState
st { state_play_multiplier :: RealTime
Cmd.state_play_multiplier = Double -> RealTime
RealTime.seconds Double
d }

-- * mmc

set_sync :: Text -> Bool -> Cmd.CmdL ()
set_sync :: Text -> Bool -> CmdL ()
set_sync Text
dev Bool
mtc = forall (m :: * -> *). M m => (PlayState -> PlayState) -> m ()
Cmd.modify_play_state forall a b. (a -> b) -> a -> b
$ \PlayState
st -> PlayState
st
    { state_sync :: Maybe SyncConfig
Cmd.state_sync = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Cmd.SyncConfig
        { sync_device :: WriteDevice
Cmd.sync_device = Text -> WriteDevice
Midi.write_device Text
dev
        , sync_device_id :: DeviceId
Cmd.sync_device_id = DeviceId
0x7f -- all devices
        , sync_mtc :: Bool
Cmd.sync_mtc = Bool
mtc
        , sync_frame_rate :: FrameRate
Cmd.sync_frame_rate = FrameRate
Midi.Frame30
        }
    }

unset_sync :: Cmd.CmdL ()
unset_sync :: CmdL ()
unset_sync = forall (m :: * -> *). M m => (PlayState -> PlayState) -> m ()
Cmd.modify_play_state forall a b. (a -> b) -> a -> b
$ \PlayState
st -> PlayState
st { state_sync :: Maybe SyncConfig
Cmd.state_sync = forall a. Maybe a
Nothing }

-- * hooks

add_selection_hook :: ([(ViewId, Maybe Cmd.TrackSelection)] -> Cmd.CmdId ())
    -> Cmd.CmdL ()
add_selection_hook :: ([(ViewId, Maybe TrackSelection)] -> CmdId ()) -> CmdL ()
add_selection_hook [(ViewId, Maybe TrackSelection)] -> CmdId ()
hook = forall (m :: * -> *). M m => (State -> State) -> m ()
Cmd.modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st
    { state_hooks :: Hooks
Cmd.state_hooks = (State -> Hooks
Cmd.state_hooks State
st)
        { hooks_selection :: [[(ViewId, Maybe TrackSelection)] -> CmdId ()]
Cmd.hooks_selection = [(ViewId, Maybe TrackSelection)] -> CmdId ()
hook forall a. a -> [a] -> [a]
: Hooks -> [[(ViewId, Maybe TrackSelection)] -> CmdId ()]
Cmd.hooks_selection (State -> Hooks
Cmd.state_hooks State
st)
        }
    }

-- * undo

get_history :: Cmd.CmdL Cmd.History
get_history :: CmdL History
get_history = forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets State -> History
Cmd.state_history