-- Copyright 2018 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 Synth.Sampler.Sample where
import qualified Data.ByteString as ByteString
import qualified Data.Map as Map
import qualified System.FilePath as FilePath
import           System.FilePath ((</>))

import qualified Util.Audio.Audio as Audio
import qualified Util.Pretty as Pretty
import qualified Util.Serialize as Serialize

import qualified Perform.Pitch as Pitch
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Control as Control
import qualified Synth.Shared.Note as Note
import qualified Synth.Shared.Thru as Thru
import qualified Synth.Shared.Signal as Signal

import           Global
import           Synth.Types


-- | Path to a sample, relative to the instrument db root.
type SamplePath = FilePath

-- | Low level representation of a note.  This corresponds to a single sample
-- played.
data Note = Note {
    Note -> Frames
start :: !Audio.Frames
    -- | This is the actual duration of the sample at the given 'ratios', not
    -- the requested 'Note.duration'.
    -- TODO maybe move 'duration' to Sample then.
    , Note -> Frames
duration :: !Audio.Frames
    , Note -> Map Control (Signal ControlSig)
effectControls :: Map Control.Control Signal.Signal
    , Note -> Sample
sample :: Sample
    -- | Hash of (start, duration, effectControls, sample).  Putting it here
    -- means I can memoize its creation but also that changing Note will make
    -- it out of sync.
    , Note -> Hash
hash :: Note.Hash
    } deriving (Int -> Note -> ShowS
[Note] -> ShowS
Note -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> FilePath
$cshow :: Note -> FilePath
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
Show)

end :: Note -> Audio.Frames
end :: Note -> Frames
end Note
note = Note -> Frames
start Note
note forall a. Num a => a -> a -> a
+ Note -> Frames
duration Note
note

note :: Audio.Frames -> Audio.Frames -> Map Control.Control Signal.Signal
    -> Sample -> Note
note :: Frames
-> Frames -> Map Control (Signal ControlSig) -> Sample -> Note
note Frames
start Frames
dur Map Control (Signal ControlSig)
effectControls Sample
sample = Note
    { start :: Frames
start = Frames
start
    , duration :: Frames
duration = Frames
dur
    , effectControls :: Map Control (Signal ControlSig)
effectControls = Map Control (Signal ControlSig)
effectControls
    , sample :: Sample
sample = Sample
sample
    , hash :: Hash
hash = Frames
-> Frames -> Map Control (Signal ControlSig) -> Sample -> Hash
makeHash Frames
start Frames
dur Map Control (Signal ControlSig)
effectControls Sample
sample
    }

makeHash :: Audio.Frames -> Audio.Frames -> Map Control.Control Signal.Signal
    -> Sample -> Note.Hash
makeHash :: Frames
-> Frames -> Map Control (Signal ControlSig) -> Sample -> Hash
makeHash Frames
start Frames
dur Map Control (Signal ControlSig)
effectControls Sample
sample = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Hash
Note.hashBytes [forall a. Serialize a => a -> ByteString
e Frames
start, forall a. Serialize a => a -> ByteString
e Frames
dur, forall a. Serialize a => a -> ByteString
e Map Control (Signal ControlSig)
effectControls, forall a. Serialize a => a -> ByteString
e Sample
sample]
    -- TODO ensure envelope and ratios are clipped to (start, duration)?
    where
    e :: Serialize.Serialize a => a -> ByteString.ByteString
    e :: forall a. Serialize a => a -> ByteString
e = forall a. Serialize a => a -> ByteString
Serialize.encode

-- | The actual sample played by a 'Note'.
data Sample = Sample {
    -- | This is initially relative to 'Patch._rootDir', and will have the root
    -- dir prepended before rendering.
    Sample -> FilePath
filename :: !SamplePath
    -- | Sample start offset.
    , Sample -> Frames
offset :: !Audio.Frames
    -- | The sample ends when it runs out of samples, or when envelope ends
    -- on 0.
    , Sample -> Signal ControlSig
envelope :: !Signal.Signal
    , Sample -> Signal ControlSig
pan :: !Signal.Signal
    -- | Sample rate conversion ratio.  This controls the pitch.
    , Sample -> Signal ControlSig
ratios :: !Signal.Signal
    , Sample -> Stretch
stretch :: !Stretch
    } deriving (Int -> Sample -> ShowS
[Sample] -> ShowS
Sample -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Sample] -> ShowS
$cshowList :: [Sample] -> ShowS
show :: Sample -> FilePath
$cshow :: Sample -> FilePath
showsPrec :: Int -> Sample -> ShowS
$cshowsPrec :: Int -> Sample -> ShowS
Show)

data Stretch = Stretch {
    Stretch -> StretchMode
stretchMode :: !StretchMode
    , Stretch -> Double
timeRatio :: !Signal.Y
    , Stretch -> Double
pitchRatio :: !Signal.Y
    } deriving (Int -> Stretch -> ShowS
[Stretch] -> ShowS
Stretch -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Stretch] -> ShowS
$cshowList :: [Stretch] -> ShowS
show :: Stretch -> FilePath
$cshow :: Stretch -> FilePath
showsPrec :: Int -> Stretch -> ShowS
$cshowsPrec :: Int -> Stretch -> ShowS
Show)

-- | This maps to [Rubberband.Option].  It's indirect to avoid a dependency on
-- RubberbandC, and hence the C library.
data StretchMode = StretchDefault | StretchPercussive
    deriving (Int -> StretchMode -> ShowS
[StretchMode] -> ShowS
StretchMode -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StretchMode] -> ShowS
$cshowList :: [StretchMode] -> ShowS
show :: StretchMode -> FilePath
$cshow :: StretchMode -> FilePath
showsPrec :: Int -> StretchMode -> ShowS
$cshowsPrec :: Int -> StretchMode -> ShowS
Show, Int -> StretchMode
StretchMode -> Int
StretchMode -> [StretchMode]
StretchMode -> StretchMode
StretchMode -> StretchMode -> [StretchMode]
StretchMode -> StretchMode -> StretchMode -> [StretchMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StretchMode -> StretchMode -> StretchMode -> [StretchMode]
$cenumFromThenTo :: StretchMode -> StretchMode -> StretchMode -> [StretchMode]
enumFromTo :: StretchMode -> StretchMode -> [StretchMode]
$cenumFromTo :: StretchMode -> StretchMode -> [StretchMode]
enumFromThen :: StretchMode -> StretchMode -> [StretchMode]
$cenumFromThen :: StretchMode -> StretchMode -> [StretchMode]
enumFrom :: StretchMode -> [StretchMode]
$cenumFrom :: StretchMode -> [StretchMode]
fromEnum :: StretchMode -> Int
$cfromEnum :: StretchMode -> Int
toEnum :: Int -> StretchMode
$ctoEnum :: Int -> StretchMode
pred :: StretchMode -> StretchMode
$cpred :: StretchMode -> StretchMode
succ :: StretchMode -> StretchMode
$csucc :: StretchMode -> StretchMode
Enum, StretchMode
forall a. a -> a -> Bounded a
maxBound :: StretchMode
$cmaxBound :: StretchMode
minBound :: StretchMode
$cminBound :: StretchMode
Bounded)

make :: SamplePath -> Sample
make :: FilePath -> Sample
make FilePath
filename = Sample
    { filename :: FilePath
filename = FilePath
filename
    , offset :: Frames
offset = Frames
0
    , envelope :: Signal ControlSig
envelope = forall {k} (kind :: k). Double -> Signal kind
Signal.constant Double
1
    , pan :: Signal ControlSig
pan = forall {k} (kind :: k). Double -> Signal kind
Signal.constant Double
0
    , ratios :: Signal ControlSig
ratios = forall {k} (kind :: k). Double -> Signal kind
Signal.constant Double
1
    , stretch :: Stretch
stretch = Stretch
        { stretchMode :: StretchMode
stretchMode = StretchMode
StretchDefault
        , timeRatio :: Double
timeRatio = Double
1
        , pitchRatio :: Double
pitchRatio = Double
1
        }
    }

modifyFilename :: (SamplePath -> SamplePath) -> Sample -> Sample
modifyFilename :: ShowS -> Sample -> Sample
modifyFilename ShowS
modify Sample
sample = Sample
sample { filename :: FilePath
filename = ShowS
modify (Sample -> FilePath
filename Sample
sample) }

instance Pretty Note where
    format :: Note -> Doc
format (Note Frames
start Frames
dur Map Control (Signal ControlSig)
effectControls Sample
sample Hash
hash) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Note"
        [ (Text
"start", forall a. Pretty a => a -> Doc
Pretty.format Frames
start)
        , (Text
"duration", forall a. Pretty a => a -> Doc
Pretty.format Frames
dur)
        , (Text
"effectControls", forall a. Pretty a => a -> Doc
Pretty.format Map Control (Signal ControlSig)
effectControls)
        , (Text
"sample", forall a. Pretty a => a -> Doc
Pretty.format Sample
sample)
        , (Text
"hash", forall a. Pretty a => a -> Doc
Pretty.format Hash
hash)
        ]

instance Pretty Sample where
    format :: Sample -> Doc
format (Sample FilePath
filename Frames
offset Signal ControlSig
envelope Signal ControlSig
pan Signal ControlSig
ratios Stretch
stretch) =
        Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Sample"
            [ (Text
"filename", forall a. Pretty a => a -> Doc
Pretty.format FilePath
filename)
            , (Text
"offset", forall a. Pretty a => a -> Doc
Pretty.format Frames
offset)
            , (Text
"envelope", forall a. Pretty a => a -> Doc
Pretty.format Signal ControlSig
envelope)
            , (Text
"pan", forall a. Pretty a => a -> Doc
Pretty.format Signal ControlSig
pan)
            , (Text
"ratios", forall a. Pretty a => a -> Doc
Pretty.format Signal ControlSig
ratios)
            , (Text
"stretch", forall a. Pretty a => a -> Doc
Pretty.format Stretch
stretch)
            ]

instance Pretty Stretch where
    format :: Stretch -> Doc
format (Stretch StretchMode
mode Double
time Double
pitch) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Stretch"
        [ (Text
"stretchMode", Text -> Doc
Pretty.text (forall a. Show a => a -> Text
showt StretchMode
mode))
        , (Text
"timeRatio", forall a. Pretty a => a -> Doc
Pretty.format Double
time)
        , (Text
"pitchRatio", forall a. Pretty a => a -> Doc
Pretty.format Double
pitch)
        ]

-- | Like Pretty Note, but shorter.
prettyNote :: Note -> Text
prettyNote :: Note -> Text
prettyNote Note
note = forall a. Pretty a => a -> Text
pretty
    ( Note -> Frames
start Note
note, Note -> Frames
duration Note
note, Note -> Hash
hash Note
note
    , ShowS
FilePath.takeFileName (Sample -> FilePath
filename (Note -> Sample
sample Note
note))
    )

instance Serialize.Serialize Sample where
    put :: Putter Sample
put (Sample FilePath
a Frames
b Signal ControlSig
c Signal ControlSig
d Signal ControlSig
e Stretch
f) =
        forall a. Serialize a => Putter a
Serialize.put FilePath
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
Serialize.put Frames
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
Serialize.put Signal ControlSig
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
Serialize.put Signal ControlSig
d
        forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
Serialize.put Signal ControlSig
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
Serialize.put Stretch
f
    get :: Get Sample
get = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"no get for Sample"

instance Serialize.Serialize Stretch where
    put :: Putter Stretch
put (Stretch StretchMode
a Double
b Double
c) = forall a. Serialize a => Putter a
Serialize.put StretchMode
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
Serialize.put Double
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
Serialize.put Double
c
    get :: Get Stretch
get = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"no get for Stretch"

instance Serialize.Serialize StretchMode where
    put :: Putter StretchMode
put = forall a. Enum a => a -> PutM ()
Serialize.put_enum_unsafe
    get :: Get StretchMode
get = forall a. (Bounded a, Enum a) => Get a
Serialize.get_enum_unsafe

-- | The duration of a note which plays the entire sample.  This should be
-- longer than any sample, and will be clipped to sample duration.
forever :: RealTime
forever :: RealTime
forever = RealTime
1000

-- * util

-- | This is the resampling ratio, which is inverse to the pitch ratio, which
-- is pretty confusing.  E.g.  When I go up *2, I should be skipping every
-- other sample.  So srate should be *2.  Number of frames is /2.  So the
-- resampling ratio for +12nn is 1/2, while the pitch ratio is 2.
pitchToRatio :: Pitch.NoteNumber -> Pitch.NoteNumber -> Signal.Y
pitchToRatio :: NoteNumber -> NoteNumber -> Double
pitchToRatio NoteNumber
sampleNn NoteNumber
nn = NoteNumber -> Double
Pitch.nn_to_hz NoteNumber
sampleNn forall a. Fractional a => a -> a -> a
/ NoteNumber -> Double
Pitch.nn_to_hz NoteNumber
nn

pitchToRatioSignal :: Pitch.NoteNumber -> Note.Note -> Signal.Signal
pitchToRatioSignal :: NoteNumber -> Note -> Signal ControlSig
pitchToRatioSignal NoteNumber
sampleNn =
    forall {k} (kind :: k).
RealTime -> (Double -> Double) -> Signal kind -> Signal kind
Signal.map_y RealTime
srate (NoteNumber -> NoteNumber -> Double
pitchToRatio NoteNumber
sampleNn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> NoteNumber
Pitch.nn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
Control.pitch forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Map Control (Signal ControlSig)
Note.controls

relativePitchToRatio :: Pitch.NoteNumber -> Signal.Y
relativePitchToRatio :: NoteNumber -> Double
relativePitchToRatio NoteNumber
offset = NoteNumber -> NoteNumber -> Double
pitchToRatio NoteNumber
60 (NoteNumber
60 forall a. Num a => a -> a -> a
+ NoteNumber
offset)
    -- Surely there's a way to do this without the fake pitch?
    -- Yes, invert ratioToPitch, but I should consistently use pitch ratio,
    -- and rename pitchToRatio to pitchToResampleRatio

-- | This is pitch ratio, not resample ratio!
ratioToPitch :: Double -> Pitch.NoteNumber
ratioToPitch :: Double -> NoteNumber
ratioToPitch Double
ratio = forall a. Real a => a -> NoteNumber
Pitch.nn forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a -> a
logBase Double
2 Double
ratio forall a. Num a => a -> a -> a
* Double
12

srate :: RealTime
srate :: RealTime
srate = RealTime
1forall a. Fractional a => a -> a -> a
/RealTime
8

toThru :: FilePath -> Sample -> Thru.Play
toThru :: FilePath -> Sample -> Play
toThru FilePath
sampleDir Sample
sample = Thru.Play
    { _sample :: FilePath
_sample = FilePath
Config.unsafeSamplerRoot FilePath -> ShowS
</> FilePath
sampleDir FilePath -> ShowS
</> Sample -> FilePath
filename Sample
sample
    , _offset :: Int
_offset = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Sample -> Frames
offset Sample
sample
    , _ratio :: Double
_ratio = forall {k} (kind :: k). Signal kind -> RealTime -> Double
Signal.at (Sample -> Signal ControlSig
ratios Sample
sample) RealTime
start
    , _volume :: Double
_volume = forall {k} (kind :: k). Signal kind -> RealTime -> Double
Signal.at (Sample -> Signal ControlSig
envelope Sample
sample) RealTime
start
    }
    where start :: RealTime
start = RealTime
0