module Synth.Faust.PatchDb (synth, warnings) where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified System.IO.Unsafe as Unsafe
import qualified Util.Doc as Doc
import qualified Util.Maps as Maps
import qualified Util.Seq as Seq
import qualified Cmd.Instrument.ImInst as ImInst
import qualified Derive.Instrument.DUtil as DUtil
import qualified Derive.ScoreT as ScoreT
import qualified Instrument.InstT as InstT
import qualified Perform.Im.Patch as Patch
import qualified Perform.Pitch as Pitch
import qualified Synth.Faust.Code as Code
import qualified Synth.Faust.InstrumentC as InstrumentC
import qualified Synth.Faust.Preview as Preview
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Control as Control
import qualified Synth.Shared.Thru as Thru
import qualified Synth.Shared.Signal as Signal
import Global
synth :: ImInst.Synth
synth :: Synth
synth = Error -> Error -> [(Error, Patch)] -> Synth
ImInst.synth Error
Config.faustName Error
"音 faust synthesizer" [(Error, Patch)]
patches
patches :: [(InstT.Name, ImInst.Patch)]
warnings :: [Text]
([Error]
warnings, [(Error, Patch)]
patches) = IO ([Error], [(Error, Patch)]) -> ([Error], [(Error, Patch)])
forall a. IO a -> a
Unsafe.unsafePerformIO (IO ([Error], [(Error, Patch)]) -> ([Error], [(Error, Patch)]))
-> IO ([Error], [(Error, Patch)]) -> ([Error], [(Error, Patch)])
forall a b. (a -> b) -> a -> b
$ do
FilePath
imDir <- Config -> FilePath
Config.imDir (Config -> FilePath) -> IO Config -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Config
Config.getConfig
Map Error (Either Error Patch)
pmap <- IO (Map Error (Either Error Patch))
InstrumentC.getPatches
let errors :: [Error]
errors =
[ Error
"faust/" Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Error
name Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Error
": " Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Error
err
| (Error
name, Left Error
err) <- Map Error (Either Error Patch) -> [(Error, Either Error Patch)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Error (Either Error Patch)
pmap
] [Error] -> [Error] -> [Error]
forall a. [a] -> [a] -> [a]
++
[ Error
"faust: patch code with no patch: " Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Error
name
| (Error
name, Seq.Second Code
_) <- Map Error (Either Error Patch)
-> Map Error Code -> [(Error, Paired (Either Error Patch) Code)]
forall k v1 v2.
Ord k =>
Map k v1 -> Map k v2 -> [(k, Paired v1 v2)]
Maps.pairs Map Error (Either Error Patch)
pmap Map Error Code
patchCode
]
([Error], [(Error, Patch)]) -> IO ([Error], [(Error, Patch)])
forall (m :: * -> *) a. Monad m => a -> m a
return (([Error], [(Error, Patch)]) -> IO ([Error], [(Error, Patch)]))
-> ([Error], [(Error, Patch)]) -> IO ([Error], [(Error, Patch)])
forall a b. (a -> b) -> a -> b
$ ([Error]
errors,)
[ (Error
name, FilePath -> Patch -> Patch
makePatch FilePath
imDir Patch
patch)
| (Error
name, Right Patch
patch) <- Map Error (Either Error Patch) -> [(Error, Either Error Patch)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Error (Either Error Patch)
pmap
]
patchCode :: Map Text ImInst.Code
patchCode :: Map Error Code
patchCode = [(Error, Code)] -> Map Error Code
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Error
"tambura8", Code
tambura), (Error
"tambura4", Code
tambura)
]
where
tambura :: Code
tambura = [Call Note] -> Code
ImInst.note_calls
[ Symbol -> Transformer Note -> Call Note
forall d. Symbol -> Transformer d -> Call d
ImInst.transformer Symbol
"terminate" (Control -> RealTime -> Transformer Note
Code.note_terminate Control
"decay" RealTime
0.01)
]
makePatch :: FilePath -> InstrumentC.Patch -> ImInst.Patch
makePatch :: FilePath -> Patch -> Patch
makePatch FilePath
imDir Patch
patch =
Lens Patch Doc
ImInst.doc Lens Patch Doc -> Doc -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= Error -> Doc
Doc.Doc (Patch -> Error
forall ptr cptr. PatchT ptr cptr -> Error
InstrumentC._doc Patch
patch) (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
Bool -> [Control] -> Patch -> Patch
code Bool
constantPitch [Control]
constantControls (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
Patch -> Patch
ImInst.make_patch (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ Patch
Patch.patch
{ patch_controls :: Map Control Error
Patch.patch_controls = (ControlConfig -> Error
forall a. Pretty a => a -> Error
pretty (ControlConfig -> Error)
-> Map Control ControlConfig -> Map Control Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Control ControlConfig
controls) Map Control Error -> Map Control Error -> Map Control Error
forall a. Semigroup a => a -> a -> a
<> Map Control Error
standardControls
, patch_elements :: Set Error
Patch.patch_elements = [Error] -> Set Error
forall a. Ord a => [a] -> Set a
Set.fromList ([Error] -> Set Error) -> [Error] -> Set Error
forall a b. (a -> b) -> a -> b
$ (Error -> Bool) -> [Error] -> [Error]
forall a. (a -> Bool) -> [a] -> [a]
filter (Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
/=Error
"") ([Error] -> [Error]) -> [Error] -> [Error]
forall a b. (a -> b) -> a -> b
$ ((Error, Control) -> Error) -> [(Error, Control)] -> [Error]
forall a b. (a -> b) -> [a] -> [b]
map (Error, Control) -> Error
forall a b. (a, b) -> a
fst ([(Error, Control)] -> [Error]) -> [(Error, Control)] -> [Error]
forall a b. (a -> b) -> a -> b
$
Map (Error, Control) ((), ControlConfig) -> [(Error, Control)]
forall k a. Map k a -> [k]
Map.keys (Map (Error, Control) ((), ControlConfig) -> [(Error, Control)])
-> Map (Error, Control) ((), ControlConfig) -> [(Error, Control)]
forall a b. (a -> b) -> a -> b
$ Patch -> Map (Error, Control) ((), ControlConfig)
forall ptr cptr.
PatchT ptr cptr -> Map (Error, Control) (cptr, ControlConfig)
InstrumentC._controls Patch
patch
}
where
constantControls :: [Control]
constantControls = ((Control, ControlConfig) -> Control)
-> [(Control, ControlConfig)] -> [Control]
forall a b. (a -> b) -> [a] -> [b]
map (Control, ControlConfig) -> Control
forall a b. (a, b) -> a
fst ([(Control, ControlConfig)] -> [Control])
-> [(Control, ControlConfig)] -> [Control]
forall a b. (a -> b) -> a -> b
$ ((Control, ControlConfig) -> Bool)
-> [(Control, ControlConfig)] -> [(Control, ControlConfig)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ControlConfig -> Bool
InstrumentC._constant (ControlConfig -> Bool)
-> ((Control, ControlConfig) -> ControlConfig)
-> (Control, ControlConfig)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Control, ControlConfig) -> ControlConfig
forall a b. (a, b) -> b
snd) ([(Control, ControlConfig)] -> [(Control, ControlConfig)])
-> [(Control, ControlConfig)] -> [(Control, ControlConfig)]
forall a b. (a -> b) -> a -> b
$
((Control, ControlConfig) -> Bool)
-> [(Control, ControlConfig)] -> [(Control, ControlConfig)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Control -> Control -> Bool
forall a. Eq a => a -> a -> Bool
/=Control
Control.pitch) (Control -> Bool)
-> ((Control, ControlConfig) -> Control)
-> (Control, ControlConfig)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Control, ControlConfig) -> Control
forall a b. (a, b) -> a
fst) ([(Control, ControlConfig)] -> [(Control, ControlConfig)])
-> [(Control, ControlConfig)] -> [(Control, ControlConfig)]
forall a b. (a -> b) -> a -> b
$ Map Control ControlConfig -> [(Control, ControlConfig)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Control ControlConfig
controls
constantPitch :: Bool
constantPitch = Bool -> (ControlConfig -> Bool) -> Maybe ControlConfig -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ControlConfig -> Bool
InstrumentC._constant (Maybe ControlConfig -> Bool) -> Maybe ControlConfig -> Bool
forall a b. (a -> b) -> a -> b
$
Control -> Map Control ControlConfig -> Maybe ControlConfig
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
Control.pitch Map Control ControlConfig
controls
controls :: Map Control ControlConfig
controls = Patch -> Map Control ControlConfig
forall ptr cptr. PatchT ptr cptr -> Map Control ControlConfig
InstrumentC.imControls Patch
patch
code :: Bool -> [Control] -> Patch -> Patch
code Bool
constantPitch [Control]
constantControls = (Lens Patch Code
ImInst.code #=) (Code -> Patch -> Patch) -> Code -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ [Code] -> Code
forall a. Monoid a => [a] -> a
mconcat
[ if Bool
constantPitch Bool -> Bool -> Bool
|| Bool -> Bool
not ([Control] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Control]
constantControls)
then Generator Note -> Code
ImInst.null_call (Generator Note -> Code) -> Generator Note -> Code
forall a b. (a -> b) -> a -> b
$
Bool -> Set Control -> Generator Note
DUtil.constant_controls Bool
constantPitch
([Control] -> Set Control
forall a. Ord a => [a] -> Set a
Set.fromList ((Control -> Control) -> [Control] -> [Control]
forall a b. (a -> b) -> [a] -> [b]
map Control -> Control
control [Control]
constantControls))
else Code
forall a. Monoid a => a
mempty
, Map NoteNumber FilePath -> Code
thruCode Map NoteNumber FilePath
pitchToSample
, case Patch -> Maybe Error
forall ptr cptr. PatchT ptr cptr -> Maybe Error
InstrumentC._elementFrom Patch
patch of
Maybe Error
Nothing -> Code
forall a. Monoid a => a
mempty
Just Error
elementFrom -> InstrumentPostproc -> Code
ImInst.postproc (InstrumentPostproc -> Code) -> InstrumentPostproc -> Code
forall a b. (a -> b) -> a -> b
$
Error -> InstrumentPostproc
DUtil.element_from_id Error
elementFrom
, Code -> Error -> Map Error Code -> Code
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Code
forall a. Monoid a => a
mempty (Patch -> Error
forall ptr cptr. PatchT ptr cptr -> Error
InstrumentC._name Patch
patch) Map Error Code
patchCode
]
pitchToSample :: Map NoteNumber FilePath
pitchToSample = FilePath -> Error -> Map NoteNumber FilePath
Preview.pitchToSample FilePath
imDir (Patch -> Error
forall ptr cptr. PatchT ptr cptr -> Error
InstrumentC._name Patch
patch)
control :: Control.Control -> ScoreT.Control
control :: Control -> Control
control (Control.Control Error
c) = Error -> Control
ScoreT.Control Error
c
standardControls :: Map Control.Control Text
standardControls :: Map Control Error
standardControls = [(Control, Error)] -> Map Control Error
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Control
Control.volume, Error
"Low level volume, in dB.")
]
Map Control Error -> Map Control Error -> Map Control Error
forall a. Semigroup a => a -> a -> a
<> Map Control Error
Control.supportDyn
thruCode :: Map Pitch.NoteNumber FilePath -> ImInst.Code
thruCode :: Map NoteNumber FilePath -> Code
thruCode = ThruFunction -> Code
ImInst.thru (ThruFunction -> Code)
-> (Map NoteNumber FilePath -> ThruFunction)
-> Map NoteNumber FilePath
-> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NoteNumber FilePath -> ThruFunction
thruFunction
thruFunction :: Map Pitch.NoteNumber FilePath -> Thru.ThruFunction
thruFunction :: Map NoteNumber FilePath -> ThruFunction
thruFunction Map NoteNumber FilePath
pitchToSample = ([Play] -> Message) -> Either Error [Play] -> Either Error Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Play] -> Message
Thru.Plays (Either Error [Play] -> Either Error Message)
-> ([Note] -> Either Error [Play]) -> ThruFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Note -> Either Error Play) -> [Note] -> Either Error [Play]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Note -> Either Error Play
forall {a}. IsString a => Note -> Either a Play
note
where
note :: Note -> Either a Play
note (Thru.Note { _pitch :: Note -> NoteNumber
_pitch = NoteNumber
pitch }) =
case NoteNumber
-> Map NoteNumber FilePath -> Maybe (NoteNumber, FilePath)
forall k v. (Ord k, Num k) => k -> Map k v -> Maybe (k, v)
Maps.lookupClosest NoteNumber
pitch Map NoteNumber FilePath
pitchToSample of
Maybe (NoteNumber, FilePath)
Nothing -> a -> Either a Play
forall a b. a -> Either a b
Left a
"no samples"
Just (NoteNumber
sampleNn, FilePath
sample) -> Play -> Either a Play
forall a b. b -> Either a b
Right (Play -> Either a Play) -> Play -> Either a Play
forall a b. (a -> b) -> a -> b
$ Thru.Play
{ _sample :: FilePath
_sample = FilePath
sample
, _offset :: Frames
_offset = Frames
0
, _ratio :: Y
_ratio = NoteNumber -> NoteNumber -> Y
pitchToRatio NoteNumber
sampleNn NoteNumber
pitch
, _volume :: Y
_volume = Y
1
}
pitchToRatio :: Pitch.NoteNumber -> Pitch.NoteNumber -> Signal.Y
pitchToRatio :: NoteNumber -> NoteNumber -> Y
pitchToRatio NoteNumber
sampleNn NoteNumber
nn = NoteNumber -> Y
Pitch.nn_to_hz NoteNumber
sampleNn Y -> Y -> Y
forall a. Fractional a => a -> a -> a
/ NoteNumber -> Y
Pitch.nn_to_hz NoteNumber
nn