-- 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

{-# LANGUAGE CPP #-}
{- | A non-realtime play.  The idea is to manually step note-by-note.

    This gets the performance for the current block and creates a series of
    MIDI states at each event start which you can then scrub through.

    It uses the starts of the notes in the performance, with a bit of eta
    to account for start randomization.
-}
module Cmd.StepPlay (
    cmd_set_or_advance, cmd_set, cmd_here, cmd_clear, cmd_advance, cmd_rewind

#ifdef TESTING
    , selnum, make_states
#endif
) where
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Vector as Vector

import qualified Util.Lists as Lists
import qualified App.Config as Config
import qualified Cmd.Cmd as Cmd
import qualified Cmd.PlayUtil as PlayUtil
import qualified Cmd.Selection as Selection
import qualified Cmd.TimeStep as TimeStep

import qualified Derive.LEvent as LEvent
import qualified Derive.Score as Score
import qualified Derive.Stack as Stack

import qualified Midi.Midi as Midi
import qualified Midi.State
import qualified Perform.RealTime as RealTime
import qualified Perform.Transport as Transport
import qualified Ui.Sel as Sel
import qualified Ui.Ui as Ui

import           Global
import           Types


selnum :: Sel.Num
selnum :: Num
selnum = Num
Config.step_play_selnum

cmd_set_or_advance :: Cmd.M m => Bool -> m ()
cmd_set_or_advance :: forall (m :: * -> *). M m => Bool -> m ()
cmd_set_or_advance Bool
play_selected_tracks =
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (forall a. Maybe a -> Bool
Maybe.isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m (Maybe StepState)
get)
        forall (m :: * -> *). M m => m ()
cmd_advance (forall (m :: * -> *). M m => Bool -> m ()
cmd_set Bool
play_selected_tracks)

-- | Place the play step position at the 'Cmd.state_play_step' before the
-- insert point and prepare the performance.
cmd_set :: Cmd.M m => Bool -> m ()
cmd_set :: forall (m :: * -> *). M m => Bool -> m ()
cmd_set = forall (m :: * -> *). M m => Bool -> Bool -> m ()
set Bool
True

cmd_here :: Cmd.M m => Bool -> m ()
cmd_here :: forall (m :: * -> *). M m => Bool -> m ()
cmd_here = forall (m :: * -> *). M m => Bool -> Bool -> m ()
set Bool
False

-- | Prepare the step play performance and emit MIDI for the initial position.
set :: Cmd.M m => Bool -- ^ Rewind from the selection pos by the play step.
    -> Bool -- ^ Filter events to include only the ones on the selected
    -- tracks.
    -> m ()
set :: forall (m :: * -> *). M m => Bool -> Bool -> m ()
set Bool
step_back Bool
play_selected_tracks = do
    (BlockId
block_id, Num
tracknum, TrackId
_, TrackTime
sel_pos) <- forall (m :: * -> *). M m => m (BlockId, Num, TrackId, TrackTime)
Selection.get_insert
    ViewId
view_id <- forall (m :: * -> *). M m => m ViewId
Cmd.get_focused_view
    Num
tracks <- forall (m :: * -> *). M m => BlockId -> m Num
Ui.track_count BlockId
block_id
    [Num]
play_tracks <- if Bool
play_selected_tracks
        then Num -> Selection -> [Num]
Sel.tracknums Num
tracks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m Selection
Selection.get
        else forall (m :: * -> *) a. Monad m => a -> m a
return []
    forall (m :: * -> *). M m => ViewId -> BlockId -> [Num] -> m ()
initialize ViewId
view_id BlockId
block_id [Num]
play_tracks
    TrackTime
start <- if Bool
step_back
        then do
            TimeStep
step <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (PlayState -> TimeStep
Cmd.state_play_step forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> PlayState
Cmd.state_play)
            forall a. a -> Maybe a -> a
fromMaybe TrackTime
sel_pos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall (m :: * -> *).
M m =>
TimeStep -> BlockId -> Num -> TrackTime -> m (Maybe TrackTime)
TimeStep.rewind TimeStep
step BlockId
block_id Num
tracknum TrackTime
sel_pos
        else forall (m :: * -> *) a. Monad m => a -> m a
return TrackTime
sel_pos
    forall (m :: * -> *). M m => BlockId -> TrackTime -> m ()
move_to BlockId
block_id TrackTime
start

make_states :: [RealTime] -> [Midi.WriteMessage] -> [Midi.State.State]
make_states :: [RealTime] -> [WriteMessage] -> [State]
make_states [RealTime]
ts [WriteMessage]
msgs = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL (State, [WriteMessage])
-> RealTime -> ((State, [WriteMessage]), State)
go (State
Midi.State.empty, [WriteMessage]
msgs) [RealTime]
ts
    where
    go :: (State, [WriteMessage])
-> RealTime -> ((State, [WriteMessage]), State)
go (State
prev_state, [WriteMessage]
msgs) RealTime
t = ((State
state, [WriteMessage]
post), State
state)
        where
        ([WriteMessage]
pre, [WriteMessage]
post) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((forall a. Ord a => a -> a -> Bool
>RealTime
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriteMessage -> RealTime
Midi.wmsg_ts) [WriteMessage]
msgs
        state :: State
state = [Message] -> State -> State
Midi.State.play (forall a b. (a -> b) -> [a] -> [b]
map WriteMessage -> Message
Midi.State.convert [WriteMessage]
pre) State
prev_state

-- ** initialize

-- | Puts MIDI states at every step point along the block.  Then set will zip
-- forward to a certain one and diff it with empty to start the process.
--
-- This may be inefficient if the user only wants to play the previous few
-- notes, but it makes rewinding without a limit simple.  Otherwise I have
-- to detect when the selection has moved before the starting point and
-- reinitialize from there.  I'll do that only if this simpler approach has
-- problems.
--
-- This places step points by looking for event edges, within an eta value.
-- Previously, I placed points based on score positions of event starts and
-- ends, but that doesn't work when the events don't line up with the score.
-- This happens with tuplets, or even if events are a bit randomized.
initialize :: Cmd.M m => ViewId -> BlockId -> [TrackNum] -> m ()
initialize :: forall (m :: * -> *). M m => ViewId -> BlockId -> [Num] -> m ()
initialize ViewId
view_id BlockId
block_id [Num]
play_tracks = do
    Set TrackId
play_track_ids <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (forall (m :: * -> *). M m => BlockId -> Num -> m (Maybe TrackId)
Ui.event_track_at BlockId
block_id) [Num]
play_tracks
    Performance
perf <- forall (m :: * -> *). M m => BlockId -> m Performance
Cmd.get_performance BlockId
block_id
    let events :: Vector Event
events = Set TrackId -> Vector Event -> Vector Event
filter_tracks Set TrackId
play_track_ids forall a b. (a -> b) -> a -> b
$ Performance -> Vector Event
Cmd.perf_events Performance
perf
        reals :: [RealTime]
reals = RealTime -> Vector Event -> [RealTime]
group_edges RealTime
eta Vector Event
events
        scores :: [Maybe TrackTime]
scores = BlockId -> InverseTempoFunction -> [RealTime] -> [Maybe TrackTime]
real_to_score BlockId
block_id (Performance -> InverseTempoFunction
Cmd.perf_inv_tempo Performance
perf) [RealTime]
reals
        steps :: [(TrackTime, RealTime)]
steps = [(TrackTime
s, RealTime
r) | (Just TrackTime
s, RealTime
r) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe TrackTime]
scores [RealTime]
reals]
    [WriteMessage]
msgs <- forall d. [LEvent d] -> [d]
LEvent.events_of forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => [Event] -> m MidiEvents
PlayUtil.perform_raw (forall a. Vector a -> [a]
Vector.toList Vector Event
events)
    forall (m :: * -> *). M m => (PlayState -> PlayState) -> m ()
Cmd.modify_play_state forall a b. (a -> b) -> a -> b
$ \PlayState
st -> PlayState
st
        { state_step :: Maybe StepState
Cmd.state_step = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Cmd.StepState
            { step_view_id :: ViewId
Cmd.step_view_id = ViewId
view_id
            , step_tracknums :: [Num]
Cmd.step_tracknums = [Num]
play_tracks
            , step_before :: [(TrackTime, State)]
Cmd.step_before = []
            , step_after :: [(TrackTime, State)]
Cmd.step_after =
                forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(TrackTime, RealTime)]
steps)
                    ([RealTime] -> [WriteMessage] -> [State]
make_states (forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Num a => a -> a -> a
+RealTime
eta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(TrackTime, RealTime)]
steps) [WriteMessage]
msgs)
            }
        }
    where eta :: RealTime
eta = Double -> RealTime
RealTime.seconds Double
0.01

real_to_score :: BlockId -> Transport.InverseTempoFunction -> [RealTime]
    -> [Maybe ScoreTime]
real_to_score :: BlockId -> InverseTempoFunction -> [RealTime] -> [Maybe TrackTime]
real_to_score BlockId
block_id InverseTempoFunction
inv = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \RealTime
t ->
    case forall a. [a] -> Maybe a
Lists.head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==BlockId
block_id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (InverseTempoFunction
inv Stop
Transport.StopAtEnd RealTime
t) of
        -- If this block is being played multiple times then just pick the
        -- first one and the first track.  That's basically what the playback
        -- monitor does anyway.
        Just (BlockId
_, (TrackId
_, TrackTime
score) : [(TrackId, TrackTime)]
_) -> forall a. a -> Maybe a
Just TrackTime
score
        Maybe (BlockId, [(TrackId, TrackTime)])
_ -> forall a. Maybe a
Nothing

filter_tracks :: Set TrackId -> Vector.Vector Score.Event
    -> Vector.Vector Score.Event
filter_tracks :: Set TrackId -> Vector Event -> Vector Event
filter_tracks Set TrackId
track_ids
    | forall a. Set a -> Bool
Set.null Set TrackId
track_ids = forall a. a -> a
id
    | Bool
otherwise = forall a. (a -> Bool) -> Vector a -> Vector a
Vector.filter (Set TrackId -> Event -> Bool
from_track Set TrackId
track_ids)

group_edges :: RealTime -> Vector.Vector Score.Event -> [RealTime]
group_edges :: RealTime -> Vector Event -> [RealTime]
group_edges RealTime
eta = [RealTime] -> [RealTime]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> [RealTime]
edges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
Vector.toList
    where
    edges :: [Event] -> [RealTime]
edges [Event]
events = forall a. Ord a => [a] -> [a] -> [a]
Lists.merge (forall a b. (a -> b) -> [a] -> [b]
map Event -> RealTime
Score.event_start [Event]
events)
        -- The starts should be in order, but the ends have no such guarantee.
        (forall a. Ord a => [a] -> [a]
List.sort (forall a b. (a -> b) -> [a] -> [b]
map Event -> RealTime
Score.event_end [Event]
events))
    group :: [RealTime] -> [RealTime]
group [] = []
    group (RealTime
t : [RealTime]
ts) = RealTime
t forall a. a -> [a] -> [a]
: [RealTime] -> [RealTime]
group (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
<= RealTime
t forall a. Num a => a -> a -> a
+ RealTime
eta) [RealTime]
ts)

-- | True if the event was from one of these tracks.
from_track :: Set TrackId -> Score.Event -> Bool
from_track :: Set TrackId -> Event -> Bool
from_track Set TrackId
track_ids Event
event = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TrackId
track_ids) forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Frame -> Maybe TrackId
track_of forall a b. (a -> b) -> a -> b
$ Stack -> [Frame]
Stack.innermost (Event -> Stack
Score.event_stack Event
event)
    where
    track_of :: Frame -> Maybe TrackId
track_of (Stack.Track TrackId
tid) = forall a. a -> Maybe a
Just TrackId
tid
    track_of Frame
_ = forall a. Maybe a
Nothing

-- * movement

cmd_clear :: Cmd.M m => m ()
cmd_clear :: forall (m :: * -> *). M m => m ()
cmd_clear = do
    [ViewId]
view_ids <- forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Map ViewId View
Ui.state_views forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m State
Ui.get
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ViewId]
view_ids forall a b. (a -> b) -> a -> b
$ \ViewId
view_id -> forall (m :: * -> *).
M m =>
ViewId -> Num -> Maybe Selection -> m ()
Selection.set_selnum ViewId
view_id Num
selnum forall a. Maybe a
Nothing
    forall (m :: * -> *). M m => (PlayState -> PlayState) -> m ()
Cmd.modify_play_state forall a b. (a -> b) -> a -> b
$ \PlayState
st -> PlayState
st { state_step :: Maybe StepState
Cmd.state_step = forall a. Maybe a
Nothing }
    forall (m :: * -> *). M m => m ()
Cmd.all_notes_off

cmd_advance :: Cmd.M m => m ()
cmd_advance :: forall (m :: * -> *). M m => m ()
cmd_advance = forall (m :: * -> *). M m => Bool -> m ()
move Bool
True

cmd_rewind :: Cmd.M m => m ()
cmd_rewind :: forall (m :: * -> *). M m => m ()
cmd_rewind = forall (m :: * -> *). M m => Bool -> m ()
move Bool
False

move :: Cmd.M m => Bool -> m ()
move :: forall (m :: * -> *). M m => Bool -> m ()
move Bool
forward = do
    StepState
step_state <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m (Maybe StepState)
get
    let msg :: Text
msg = Text
"can't " forall a. Semigroup a => a -> a -> a
<> (if Bool
forward then Text
"advance" else Text
"rewind")
            forall a. Semigroup a => a -> a -> a
<> Text
" for step play"
    (ViewId
view_id, State
prev_state, TrackTime
pos, State
state) <- forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Cmd.require Text
msg
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
M m =>
StepState -> Bool -> m (Maybe (ViewId, State, TrackTime, State))
zip_state StepState
step_state Bool
forward
    BlockId
block_id <- forall (m :: * -> *). M m => ViewId -> m BlockId
Ui.block_id_of ViewId
view_id
    -- If I want to get accurate playback positions, I need to call
    -- find_play_pos on the RealTime.  However, converting ScoreTime ->
    -- RealTime -> ScoreTime loses information since they are different types,
    -- and the inaccuracy messes up time step.  In any case, I don't support
    -- discontiguous play selections yet, so I don't need to get this right.
    [ViewId]
view_ids <- forall k a. Map k a -> [k]
Map.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m (Map ViewId View)
Ui.views_of BlockId
block_id
    forall (m :: * -> *). M m => [ViewId] -> TrackTime -> [Num] -> m ()
set_selections [ViewId]
view_ids TrackTime
pos (StepState -> [Num]
Cmd.step_tracknums StepState
step_state)
    let msgs :: [Message]
msgs = State -> State -> [Message]
Midi.State.diff State
prev_state State
state
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). M m => WriteDevice -> Message -> m ()
Cmd.midi) [Message]
msgs

-- | Move to the midi state at the given time and play it.  If there is no
-- exact match for the time, pick the previous one.
move_to :: Cmd.M m => BlockId -> ScoreTime -> m ()
move_to :: forall (m :: * -> *). M m => BlockId -> TrackTime -> m ()
move_to BlockId
block_id TrackTime
pos = do
    StepState
step_state <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m (Maybe StepState)
get
    let ([(TrackTime, State)]
before, [(TrackTime, State)]
after) = forall a. ([a], [a]) -> ([a], [a])
zip_backward forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> ([a], [a]) -> ([a], [a])
zip_until ((forall a. Ord a => a -> a -> Bool
>TrackTime
pos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
            (StepState -> [(TrackTime, State)]
Cmd.step_before StepState
step_state, StepState -> [(TrackTime, State)]
Cmd.step_after StepState
step_state)
    (TrackTime
pos, State
mstate) <- forall (m :: * -> *) a. M m => Maybe a -> m a
Cmd.abort_unless forall a b. (a -> b) -> a -> b
$ forall a. ([a], [a]) -> Maybe a
zip_head ([(TrackTime, State)]
before, [(TrackTime, State)]
after)
    forall (m :: * -> *). M m => Maybe StepState -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        StepState
step_state { step_before :: [(TrackTime, State)]
Cmd.step_before = [(TrackTime, State)]
before, step_after :: [(TrackTime, State)]
Cmd.step_after = [(TrackTime, State)]
after }
    [ViewId]
view_ids <- forall k a. Map k a -> [k]
Map.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m (Map ViewId View)
Ui.views_of BlockId
block_id
    forall (m :: * -> *). M m => [ViewId] -> TrackTime -> [Num] -> m ()
set_selections [ViewId]
view_ids TrackTime
pos (StepState -> [Num]
Cmd.step_tracknums StepState
step_state)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). M m => WriteDevice -> Message -> m ()
Cmd.midi) forall a b. (a -> b) -> a -> b
$ State -> State -> [Message]
Midi.State.diff State
Midi.State.empty State
mstate

zip_state :: Cmd.M m => Cmd.StepState -> Bool ->
    m (Maybe (ViewId, Midi.State.State, ScoreTime, Midi.State.State))
zip_state :: forall (m :: * -> *).
M m =>
StepState -> Bool -> m (Maybe (ViewId, State, TrackTime, State))
zip_state StepState
step_state Bool
forward = do
    let zipper :: ([(TrackTime, State)], [(TrackTime, State)])
zipper = (StepState -> [(TrackTime, State)]
Cmd.step_before StepState
step_state, StepState -> [(TrackTime, State)]
Cmd.step_after StepState
step_state)
        ([(TrackTime, State)]
before, [(TrackTime, State)]
after) = if Bool
forward
            then forall a. ([a], [a]) -> ([a], [a])
zip_forward ([(TrackTime, State)], [(TrackTime, State)])
zipper else forall a. ([a], [a]) -> ([a], [a])
zip_backward ([(TrackTime, State)], [(TrackTime, State)])
zipper
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TrackTime, State)]
after) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). M m => Maybe StepState -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            StepState
step_state { step_before :: [(TrackTime, State)]
Cmd.step_before = [(TrackTime, State)]
before, step_after :: [(TrackTime, State)]
Cmd.step_after = [(TrackTime, State)]
after }
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
forward
        then do
            (TrackTime
_, State
prev) <- forall a. [a] -> Maybe a
Lists.head [(TrackTime, State)]
before
            (TrackTime
p, State
next) <- forall a. [a] -> Maybe a
Lists.head [(TrackTime, State)]
after
            forall (m :: * -> *) a. Monad m => a -> m a
return (StepState -> ViewId
Cmd.step_view_id StepState
step_state, State
prev, TrackTime
p, State
next)
        else do
            (TrackTime
p, State
next) <- forall a. [a] -> Maybe a
Lists.head (forall a b. (a, b) -> a
fst ([(TrackTime, State)], [(TrackTime, State)])
zipper)
            (TrackTime
_, State
prev) <- forall a. [a] -> Maybe a
Lists.head (forall a b. (a, b) -> b
snd ([(TrackTime, State)], [(TrackTime, State)])
zipper)
            forall (m :: * -> *) a. Monad m => a -> m a
return (StepState -> ViewId
Cmd.step_view_id StepState
step_state, State
prev, TrackTime
p, State
next)

zip_forward :: ([a], [a]) -> ([a], [a])
zip_forward :: forall a. ([a], [a]) -> ([a], [a])
zip_forward ([a]
before, []) = ([a]
before, [])
zip_forward ([a]
before, a
x : [a]
xs) = (a
x forall a. a -> [a] -> [a]
: [a]
before, [a]
xs)

zip_backward :: ([a], [a]) -> ([a], [a])
zip_backward :: forall a. ([a], [a]) -> ([a], [a])
zip_backward ([], [a]
after) = ([], [a]
after)
zip_backward (a
x : [a]
xs, [a]
after) = ([a]
xs, a
x forall a. a -> [a] -> [a]
: [a]
after)

zip_until :: (a -> Bool) -> ([a], [a]) -> ([a], [a])
zip_until :: forall a. (a -> Bool) -> ([a], [a]) -> ([a], [a])
zip_until a -> Bool
f ([a]
before, after :: [a]
after@(a
x:[a]
xs))
    | a -> Bool
f a
x = ([a]
before, [a]
after)
    | Bool
otherwise = forall a. (a -> Bool) -> ([a], [a]) -> ([a], [a])
zip_until a -> Bool
f (a
xforall a. a -> [a] -> [a]
:[a]
before, [a]
xs)
zip_until a -> Bool
_ ([a]
before, []) = ([a]
before, [])

zip_head :: ([a], [a]) -> Maybe a
zip_head :: forall a. ([a], [a]) -> Maybe a
zip_head = forall a. [a] -> Maybe a
Lists.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

set_selections :: Cmd.M m => [ViewId] -> ScoreTime -> [TrackNum] -> m ()
set_selections :: forall (m :: * -> *). M m => [ViewId] -> TrackTime -> [Num] -> m ()
set_selections [ViewId]
view_ids TrackTime
pos [Num]
tracks = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
    [forall (m :: * -> *).
M m =>
ViewId -> Num -> Maybe Selection -> m ()
Selection.set_selnum ViewId
view_id Num
selnum (TrackTime -> Maybe Selection
sel TrackTime
pos) | ViewId
view_id <- [ViewId]
view_ids]
    where
    -- I can't display disjoint selections so assume the tracks are
    -- contiguous.
    sel :: TrackTime -> Maybe Selection
sel TrackTime
pos = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Num]
tracks
        then Sel.Selection
            { start_track :: Num
start_track = Num
0, start_pos :: TrackTime
start_pos = TrackTime
pos
            , cur_track :: Num
cur_track = Num
999, cur_pos :: TrackTime
cur_pos = TrackTime
pos
            , orientation :: Orientation
orientation = Orientation
Sel.Positive
            }
        else Sel.Selection
            { start_track :: Num
start_track = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Num]
tracks, start_pos :: TrackTime
start_pos = TrackTime
pos
            , cur_track :: Num
cur_track = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Num]
tracks, cur_pos :: TrackTime
cur_pos = TrackTime
pos
            , orientation :: Orientation
orientation = Orientation
Sel.Positive
            }

get :: Cmd.M m => m (Maybe Cmd.StepState)
get :: forall (m :: * -> *). M m => m (Maybe StepState)
get = forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (PlayState -> Maybe StepState
Cmd.state_step forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> PlayState
Cmd.state_play)

put :: Cmd.M m => Maybe Cmd.StepState -> m ()
put :: forall (m :: * -> *). M m => Maybe StepState -> m ()
put Maybe StepState
step_state = forall (m :: * -> *). M m => (PlayState -> PlayState) -> m ()
Cmd.modify_play_state forall a b. (a -> b) -> a -> b
$ \PlayState
st ->
    PlayState
st { state_step :: Maybe StepState
Cmd.state_step = Maybe StepState
step_state }