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

-- | See 'render'.
module Synth.Faust.Preview where
import qualified Control.Monad.Trans.Resource as Resource
import qualified Data.Map as Map
import qualified Data.Text.IO as Text.IO
import qualified System.Directory as Directory
import           System.FilePath ((</>))

import qualified Util.Audio.File as Audio.File
import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Thread as Thread

import qualified Perform.NN as NN
import qualified Perform.Pitch as Pitch
import qualified Synth.Faust.InstrumentC as InstrumentC
import qualified Synth.Faust.Render as Render
import qualified Synth.Lib.AUtil as AUtil
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.Signal as Signal

import           Global


-- | The patch preview cache is in imDir </> cacheDir </> patchName </> nn.wav
cacheDir :: FilePath -> Text -> FilePath
cacheDir :: FilePath -> Text -> FilePath
cacheDir FilePath
imDir Text
patchName = FilePath
imDir FilePath -> FilePath -> FilePath
</> FilePath
"preview" FilePath -> FilePath -> FilePath
</> Text -> FilePath
untxt Text
patchName

{- | Render representative samples for this instrument so they can be played in
    realtime by the thru mechanism.  This will stop if the output directory
    already exists, so it's up to the shakefile to remove the directories if
    the underlying .dsp file has changed.

    In theory this should divide the patch up along its important axes
    (pitch, dynamic, attributes) and render the whole matrix, but for now I
    only have pitch.
-}
render :: InstrumentC.Patch -> IO ()
render :: Patch -> IO ()
render Patch
patch = do
    FilePath
imDir <- Config -> FilePath
Config.imDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Config
Config.getConfig
    let out :: FilePath
out = FilePath -> Text -> FilePath
cacheDir FilePath
imDir (forall ptr cptr. PatchT ptr cptr -> Text
InstrumentC._name Patch
patch)
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
Directory.doesDirectoryExist FilePath
out) forall a b. (a -> b) -> a -> b
$ do
        Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True FilePath
out
        let element :: Text
element = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
Lists.head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Text
"") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
                forall k a. Map k a -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$ forall ptr cptr.
PatchT ptr cptr -> Map (Text, Control) (cptr, ControlConfig)
InstrumentC._controls Patch
patch
        forall a b. [a] -> (a -> IO b) -> IO ()
Thread.forCpu_ (Text -> [(NoteNumber, Note)]
standardNotes Text
element) forall a b. (a -> b) -> a -> b
$ \(NoteNumber
nn, Note
note) -> do
            IO () -> IO ()
Log.with_stdio_lock forall a b. (a -> b) -> a -> b
$
                Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ forall ptr cptr. PatchT ptr cptr -> Text
InstrumentC._name Patch
patch forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty NoteNumber
nn
            FilePath -> Patch -> Note -> IO ()
renderNote (FilePath
out FilePath -> FilePath -> FilePath
</> NoteNumber -> FilePath
noteFilename NoteNumber
nn) Patch
patch Note
note

noteFilename :: Pitch.NoteNumber -> FilePath
noteFilename :: NoteNumber -> FilePath
noteFilename NoteNumber
nn = forall a. Pretty a => a -> FilePath
prettys NoteNumber
nn forall a. Semigroup a => a -> a -> a
<> FilePath
".wav"

renderNote :: FilePath -> InstrumentC.Patch -> Note.Note -> IO ()
renderNote :: FilePath -> Patch -> Note -> IO ()
renderNote FilePath
fname Patch
patch Note
note = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
Resource.runResourceT forall a b. (a -> b) -> a -> b
$
    forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Format -> FilePath -> AudioIO rate chan -> ResourceT IO ()
Audio.File.write Format
AUtil.outputFormat FilePath
fname forall a b. (a -> b) -> a -> b
$
    (Payload -> IO ())
-> Patch
-> Config
-> Maybe State
-> (State -> IO ())
-> [Note]
-> RealTime
-> Audio
Render.renderPatch Payload -> IO ()
emitMessage Patch
patch Config
Render.defaultConfig forall a. Maybe a
Nothing
        forall {b}. b -> IO ()
notifyState [Note
note] RealTime
0
    where
    emitMessage :: Payload -> IO ()
emitMessage (Config.Warn Stack
_ Text
msg) = Text -> IO ()
Text.IO.putStrLn Text
msg
    emitMessage (Config.Failure Text
msg) = Text -> IO ()
Text.IO.putStrLn Text
msg
    emitMessage Payload
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    notifyState :: b -> IO ()
notifyState = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

pitchToSample :: FilePath -> Text -> Map Pitch.NoteNumber FilePath
pitchToSample :: FilePath -> Text -> Map NoteNumber FilePath
pitchToSample FilePath
imDir Text
patchName =
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(NoteNumber
nn, FilePath
dir FilePath -> FilePath -> FilePath
</> NoteNumber -> FilePath
noteFilename NoteNumber
nn) | NoteNumber
nn <- [NoteNumber]
nns]
    where
    dir :: FilePath
dir = FilePath -> Text -> FilePath
cacheDir FilePath
imDir Text
patchName
    nns :: [NoteNumber]
nns = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Text -> [(NoteNumber, Note)]
standardNotes Text
""

-- | Render previews of these notes.
standardNotes :: Note.Element -> [(Pitch.NoteNumber, Note.Note)]
standardNotes :: Text -> [(NoteNumber, Note)]
standardNotes Text
element = forall a b. [a] -> [b] -> [(a, b)]
zip [NoteNumber]
nns (forall a b. (a -> b) -> [a] -> [b]
map (Text -> NoteNumber -> Note
makeNote Text
element) [NoteNumber]
nns)
    where nns :: [NoteNumber]
nns = forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range NoteNumber
NN.c1 NoteNumber
NN.c8 NoteNumber
2

makeNote :: Note.Element -> Pitch.NoteNumber -> Note.Note
makeNote :: Text -> NoteNumber -> Note
makeNote Text
element NoteNumber
nn =
    Control -> Signal -> Note -> Note
Note.withControl Control
Control.dynamic (forall {k} (kind :: k). Y -> Signal kind
Signal.constant Y
0.75) forall a b. (a -> b) -> a -> b
$
    (NoteNumber -> Note -> Note
Note.withPitch NoteNumber
nn forall a b. (a -> b) -> a -> b
$ RealTime -> RealTime -> Note
Note.testNote RealTime
0 RealTime
1) { element :: Text
Note.element = Text
element }