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

-- | A generic way to play a sample by name.
module Synth.Sampler.Patch.Sample where
import qualified Control.Monad.Except as Except
import qualified Data.Text as Text

import qualified Cmd.Instrument.ImInst as ImInst
import qualified Derive.Call as Call
import qualified Derive.Call.Module as Module
import qualified Derive.Derive as Derive
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Sig as Sig

import qualified Perform.Im.Patch as Im.Patch
import qualified Synth.Sampler.Patch as Patch
import qualified Synth.Sampler.Patch.Lib.Util as Util
import qualified Synth.Sampler.Sample as Sample
import qualified Synth.Shared.Control as Control
import qualified Synth.Shared.Note as Note

import           Global


patches :: [Patch.Patch]
patches :: [Patch]
patches = (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ (Error -> Patch
Patch.patch Error
patchName)
    { _dir :: FilePath
Patch._dir = FilePath
dir
    , _convert :: Note -> ConvertM Sample
Patch._convert = Note -> ConvertM Sample
convert
    , _karyaPatch :: Patch
Patch._karyaPatch =
        Lens Patch Code
ImInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a b. (a -> b) -> a -> b
$
        Patch -> Patch
ImInst.make_patch forall a b. (a -> b) -> a -> b
$ Patch
Im.Patch.patch
            { patch_controls :: Map Control Error
Im.Patch.patch_controls = Map Control Error
Control.supportDyn }
    }
    where
    code :: Code
code = [(Symbol, Generator Note)] -> Code
ImInst.note_generators [(Symbol
"s", Generator Note
c_sample)]
    dir :: FilePath
dir = Error -> FilePath
untxt Error
patchName

patchName :: Text
patchName :: Error
patchName = Error
"sample"

-- TODO start offset, pitch adjust
-- time stretch?  I need rubberband in sampler though.
c_sample :: Derive.Generator Derive.Note
c_sample :: Generator Note
c_sample = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.instrument CallName
"sample" forall a. Monoid a => a
mempty Doc
doc forall a b. (a -> b) -> a -> b
$
    forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call ((,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => ArgName -> Doc -> Parser a
Sig.required ArgName
"name" Doc
"name of sample"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Typecheck a => ArgName -> Doc -> Parser a
Sig.required ArgName
"dir" Doc
"directory of sample"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> deflt -> Doc -> Parser a
Sig.defaulted ArgName
"ext" (Error
"flac" :: Text) Doc
"extension of sample"
    ) forall a b. (a -> b) -> a -> b
$ \(Error
sample, Error
dir, Error
ext) PassedArgs Note
args -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Error -> Bool
Text.null Error
sample) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Error -> Deriver a
Derive.throw Error
"no sample"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Error -> Bool
Text.null Error
dir) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Error -> Deriver a
Derive.throw Error
"no sample dir"
        forall val a. ToVal val => Error -> val -> Deriver a -> Deriver a
Derive.with_val Error
EnvKey.element (Error
dir forall a. Semigroup a => a -> a -> a
<> Error
"/" forall a. Semigroup a => a -> a -> a
<> Error
sample forall a. Semigroup a => a -> a -> a
<> Error
"." forall a. Semigroup a => a -> a -> a
<> Error
ext) forall a b. (a -> b) -> a -> b
$
            forall d. PassedArgs d -> Deriver (Stream Note)
Call.placed_note PassedArgs Note
args
    where
    doc :: Doc
doc = Doc
"Play a single sample."

convert :: Note.Note -> Patch.ConvertM Sample.Sample
convert :: Note -> ConvertM Sample
convert Note
note = do
    Error
filename <- if Note -> Error
Note.element Note
note forall a. Eq a => a -> a -> Bool
== Error
""
        then forall e (m :: * -> *) a. MonadError e m => e -> m a
Except.throwError Error
"no element" else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Note -> Error
Note.element Note
note
    let dynVal :: Y
dynVal = Control -> Note -> Y
Note.initial0 Control
Control.dynamic Note
note
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (FilePath -> Sample
Sample.make (Error -> FilePath
untxt Error
filename))
        { envelope :: Signal
Sample.envelope = Y -> RealTime -> Note -> Signal
Util.sustainRelease Y
dynVal RealTime
0.15 Note
note }