-- 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", forall a. Pretty a => a -> Doc
Pretty.format Either Text TrackId
source)
        , (Text
"events", forall a. Pretty a => a -> Doc
Pretty.format (forall a b. a -> b -> a
const () 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:" forall a. Semigroup a => a -> a -> a
<> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id 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
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 -> 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 " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt ScoreTime
start forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt ScoreTime
dur
            forall a. Semigroup a => a -> a -> a
<> Text
" (" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty a
note forall a. Semigroup a => a -> a -> a
<> Text
")"

end :: EventT a -> ScoreTime
end :: forall a. EventT a -> ScoreTime
end EventT a
event = forall a. EventT a -> ScoreTime
_start EventT a
event forall a. Num a => a -> a -> a
+ 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 forall a. Eq a => a -> a -> Bool
== ScoreTime
0 = ScoreTime
pos forall a. Eq a => a -> a -> Bool
== ScoreTime
start
    | Bool
otherwise = ScoreTime
start forall a. Ord a => a -> a -> Bool
<= ScoreTime
pos Bool -> Bool -> Bool
&& ScoreTime
pos forall a. Ord a => a -> a -> Bool
< ScoreTime
start 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) =
    forall a. ScoreTime -> ScoreTime -> a -> EventT a
EventT ((ScoreTime
start forall a. Num a => a -> a -> a
- ScoreTime
shift) forall a. Num a => a -> a -> a
* ScoreTime
factor forall a. Num a => a -> a -> a
+ ScoreTime
shift) (ScoreTime
dur 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 = 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) = forall a. ScoreTime -> ScoreTime -> a -> EventT a
EventT (ScoreTime
start forall a. Num a => a -> a -> a
+ ScoreTime
shift) ScoreTime
dur a
note