-- Copyright 2019 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 DeriveFunctor #-}
module Derive.Call.SubT where
import qualified Util.Pretty as Pretty
import qualified Derive.Deriver.Monad as Derive
import qualified Ui.Id as Id

import           Global
import           Types


data Track = Track {
    -- | Usually this comes from a sliced track with a TrackId, but sometimes
    -- from 'Derive.ctx_sub_events', or an unnamed track.
    Track -> Either Text TrackId
_source :: !(Either Text TrackId)
    , Track -> [Event]
_events :: ![Event]
    }

instance Pretty Track where
    format :: Track -> Doc
format (Track Either Text TrackId
source [Event]
events) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Track"
        [ (Text
"source", Either Text TrackId -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Either Text TrackId
source)
        , (Text
"events", [()] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format (() -> Event -> ()
forall a b. a -> b -> a
const () (Event -> ()) -> [Event] -> [()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Event]
events))
        ]

show_track :: Track -> Text
show_track :: Track -> Text
show_track (Track Either Text TrackId
source [Event]
_) = Text
"subtrack:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> (TrackId -> Text) -> Either Text TrackId -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Text
forall a. a -> a
id TrackId -> Text
forall a. Ident a => a -> Text
Id.ident_text Either Text TrackId
source

-- | Sliced sub-events are represented as a start, duration, and opaque
-- deriver.  This is a compromise between a plain NoteDeriver, which is fully
-- abstract but also fully opaque, and some kind of note data structure, which
-- is fully concrete (and thus inflexible), but also transparent to
-- modification.
type Event = EventT Derive.NoteDeriver

data EventT a = EventT {
    forall a. EventT a -> ScoreTime
_start :: !ScoreTime
    , forall a. EventT a -> ScoreTime
_duration :: !ScoreTime
    , forall a. EventT a -> a
_note :: !a
    } deriving (Int -> EventT a -> ShowS
[EventT a] -> ShowS
EventT a -> String
(Int -> EventT a -> ShowS)
-> (EventT a -> String) -> ([EventT a] -> ShowS) -> Show (EventT a)
forall a. Show a => Int -> EventT a -> ShowS
forall a. Show a => [EventT a] -> ShowS
forall a. Show a => EventT a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventT a] -> ShowS
$cshowList :: forall a. Show a => [EventT a] -> ShowS
show :: EventT a -> String
$cshow :: forall a. Show a => EventT a -> String
showsPrec :: Int -> EventT a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EventT a -> ShowS
Show, (forall a b. (a -> b) -> EventT a -> EventT b)
-> (forall a b. a -> EventT b -> EventT a) -> Functor EventT
forall a b. a -> EventT b -> EventT a
forall a b. (a -> b) -> EventT a -> EventT b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> EventT b -> EventT a
$c<$ :: forall a b. a -> EventT b -> EventT a
fmap :: forall a b. (a -> b) -> EventT a -> EventT b
$cfmap :: forall a b. (a -> b) -> EventT a -> EventT b
Functor)

instance Pretty a => Pretty (EventT a) where
    pretty :: EventT a -> Text
pretty (EventT ScoreTime
start ScoreTime
dur a
note) =
        Text
"Event " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScoreTime -> Text
forall a. Show a => a -> Text
showt ScoreTime
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScoreTime -> Text
forall a. Show a => a -> Text
showt ScoreTime
dur
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Pretty a => a -> Text
pretty a
note Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

end :: EventT a -> ScoreTime
end :: forall a. EventT a -> ScoreTime
end EventT a
event = EventT a -> ScoreTime
forall a. EventT a -> ScoreTime
_start EventT a
event ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
+ EventT a -> ScoreTime
forall a. EventT a -> ScoreTime
_duration EventT a
event

overlaps :: ScoreTime -> EventT a -> Bool
overlaps :: forall a. ScoreTime -> EventT a -> Bool
overlaps ScoreTime
pos (EventT ScoreTime
start ScoreTime
dur a
_)
    | ScoreTime
dur ScoreTime -> ScoreTime -> Bool
forall a. Eq a => a -> a -> Bool
== ScoreTime
0 = ScoreTime
pos ScoreTime -> ScoreTime -> Bool
forall a. Eq a => a -> a -> Bool
== ScoreTime
start
    | Bool
otherwise = ScoreTime
start ScoreTime -> ScoreTime -> Bool
forall a. Ord a => a -> a -> Bool
<= ScoreTime
pos Bool -> Bool -> Bool
&& ScoreTime
pos ScoreTime -> ScoreTime -> Bool
forall a. Ord a => a -> a -> Bool
< ScoreTime
start ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
+ ScoreTime
dur

place :: ScoreTime -> ScoreTime -> EventT a -> EventT a
place :: forall a. ScoreTime -> ScoreTime -> EventT a -> EventT a
place ScoreTime
shift ScoreTime
factor (EventT ScoreTime
start ScoreTime
dur a
note) =
    ScoreTime -> ScoreTime -> a -> EventT a
forall a. ScoreTime -> ScoreTime -> a -> EventT a
EventT ((ScoreTime
start ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
- ScoreTime
shift) ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
* ScoreTime
factor ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
+ ScoreTime
shift) (ScoreTime
dur ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
* ScoreTime
factor) a
note

stretch :: ScoreTime -> EventT a -> EventT a
stretch :: forall a. ScoreTime -> EventT a -> EventT a
stretch ScoreTime
factor = ScoreTime -> ScoreTime -> EventT a -> EventT a
forall a. ScoreTime -> ScoreTime -> EventT a -> EventT a
place ScoreTime
0 ScoreTime
factor

at :: ScoreTime -> EventT a -> EventT a
at :: forall a. ScoreTime -> EventT a -> EventT a
at ScoreTime
shift (EventT ScoreTime
start ScoreTime
dur a
note) = ScoreTime -> ScoreTime -> a -> EventT a
forall a. ScoreTime -> ScoreTime -> a -> EventT a
EventT (ScoreTime
start ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
+ ScoreTime
shift) ScoreTime
dur a
note