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

module Perform.Sc.Note (
    Note(..), ControlId(..), PatchName
    , Notes, PlayNotes(..)
    , gate_id
) where
import qualified Data.ByteString as ByteString
import qualified Data.Int as Int
import qualified GHC.Generics as Generics

import qualified Util.Pretty as Pretty
import qualified Derive.LEvent as LEvent
import qualified Perform.Midi.MSignal as MSignal

import           Global
import           Types


data Note = Note {
    Note -> PatchName
patch :: !PatchName
    , Note -> RealTime
start :: !RealTime
    -- | The duration is encoded in the gate_id control.
    , Note -> Map ControlId Signal
controls :: !(Map ControlId MSignal.Signal)
    } deriving (Note -> Note -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq, Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
Show, forall x. Rep Note x -> Note
forall x. Note -> Rep Note x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Note x -> Note
$cfrom :: forall x. Note -> Rep Note x
Generics.Generic)

instance Pretty.Pretty Note where format :: Note -> Doc
format = forall a. (PrettyG (Rep a), Generic a) => a -> Doc
Pretty.formatG

newtype ControlId = ControlId Int.Int32
    deriving (ControlId -> ControlId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControlId -> ControlId -> Bool
$c/= :: ControlId -> ControlId -> Bool
== :: ControlId -> ControlId -> Bool
$c== :: ControlId -> ControlId -> Bool
Eq, Eq ControlId
ControlId -> ControlId -> Bool
ControlId -> ControlId -> Ordering
ControlId -> ControlId -> ControlId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ControlId -> ControlId -> ControlId
$cmin :: ControlId -> ControlId -> ControlId
max :: ControlId -> ControlId -> ControlId
$cmax :: ControlId -> ControlId -> ControlId
>= :: ControlId -> ControlId -> Bool
$c>= :: ControlId -> ControlId -> Bool
> :: ControlId -> ControlId -> Bool
$c> :: ControlId -> ControlId -> Bool
<= :: ControlId -> ControlId -> Bool
$c<= :: ControlId -> ControlId -> Bool
< :: ControlId -> ControlId -> Bool
$c< :: ControlId -> ControlId -> Bool
compare :: ControlId -> ControlId -> Ordering
$ccompare :: ControlId -> ControlId -> Ordering
Ord, Int -> ControlId -> ShowS
[ControlId] -> ShowS
ControlId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlId] -> ShowS
$cshowList :: [ControlId] -> ShowS
show :: ControlId -> String
$cshow :: ControlId -> String
showsPrec :: Int -> ControlId -> ShowS
$cshowsPrec :: Int -> ControlId -> ShowS
Show, [ControlId] -> Doc
ControlId -> Text
ControlId -> Doc
forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a
formatList :: [ControlId] -> Doc
$cformatList :: [ControlId] -> Doc
format :: ControlId -> Doc
$cformat :: ControlId -> Doc
pretty :: ControlId -> Text
$cpretty :: ControlId -> Text
Pretty)

type PatchName = ByteString.ByteString


type Notes = [LEvent.LEvent Note]

-- | Store notes with shift (backwards in time) and stretch.
--
-- For MIDI, I apply the transformation directly to the msgs because they are
-- already in their low level form so the transform will stream.  But SC Notes
-- are at a higher level and converted to low level OSC only in Sc.Play... not
-- for any really good reason, but I guess it seemed simpler to not expose the
-- "perform" step, and keep it inside Sc.Play.
data PlayNotes = PlayNotes {
    PlayNotes -> RealTime
shift :: RealTime
    , PlayNotes -> RealTime
stretch :: RealTime
    , PlayNotes -> Notes
notes :: Notes
    } deriving (Int -> PlayNotes -> ShowS
[PlayNotes] -> ShowS
PlayNotes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlayNotes] -> ShowS
$cshowList :: [PlayNotes] -> ShowS
show :: PlayNotes -> String
$cshow :: PlayNotes -> String
showsPrec :: Int -> PlayNotes -> ShowS
$cshowsPrec :: Int -> PlayNotes -> ShowS
Show)

-- | Gate is converted from note duration, so it gets treated specially.  I
-- also require them all to be the same ControlId, so I can stop all sounding
-- notes by setting the gate control on the default group.
gate_id :: ControlId
gate_id :: ControlId
gate_id = Int32 -> ControlId
ControlId Int32
0