-- 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.Log as Log
import qualified Util.Seq as Seq
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 (Config -> FilePath) -> IO Config -> IO FilePath
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 (Patch -> Text
forall ptr cptr. PatchT ptr cptr -> Text
InstrumentC._name Patch
patch)
    IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
Directory.doesDirectoryExist FilePath
out) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True FilePath
out
        let element :: Text
element = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Text
forall a. [a] -> Maybe a
Seq.head ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
"") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Control) -> Text) -> [(Text, Control)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Control) -> Text
forall a b. (a, b) -> a
fst ([(Text, Control)] -> [Text]) -> [(Text, Control)] -> [Text]
forall a b. (a -> b) -> a -> b
$
                Map (Text, Control) ((), ControlConfig) -> [(Text, Control)]
forall k a. Map k a -> [k]
Map.keys (Map (Text, Control) ((), ControlConfig) -> [(Text, Control)])
-> Map (Text, Control) ((), ControlConfig) -> [(Text, Control)]
forall a b. (a -> b) -> a -> b
$ Patch -> Map (Text, Control) ((), ControlConfig)
forall ptr cptr.
PatchT ptr cptr -> Map (Text, Control) (cptr, ControlConfig)
InstrumentC._controls Patch
patch
        [(NoteNumber, Note)] -> ((NoteNumber, Note) -> IO ()) -> IO ()
forall a b. [a] -> (a -> IO b) -> IO ()
Thread.forCpu_ (Text -> [(NoteNumber, Note)]
standardNotes Text
element) (((NoteNumber, Note) -> IO ()) -> IO ())
-> ((NoteNumber, Note) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(NoteNumber
nn, Note
note) -> do
            IO () -> IO ()
Log.with_stdio_lock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                Text -> IO ()
Text.IO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Patch -> Text
forall ptr cptr. PatchT ptr cptr -> Text
InstrumentC._name Patch
patch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NoteNumber -> Text
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 = NoteNumber -> FilePath
forall a. Pretty a => a -> FilePath
prettys NoteNumber
nn FilePath -> FilePath -> FilePath
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 = ResourceT IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
Resource.runResourceT (ResourceT IO () -> IO ()) -> ResourceT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Format
-> FilePath -> AudioIO SamplingRate Channels -> ResourceT IO ()
forall (rate :: Nat) (chan :: Nat).
(KnownNat rate, KnownNat chan) =>
Format -> FilePath -> AudioIO rate chan -> ResourceT IO ()
Audio.File.write Format
AUtil.outputFormat FilePath
fname (AudioIO SamplingRate Channels -> ResourceT IO ())
-> AudioIO SamplingRate Channels -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$
    (Payload -> IO ())
-> Patch
-> Config
-> Maybe State
-> (State -> IO ())
-> [Note]
-> RealTime
-> AudioIO SamplingRate Channels
Render.renderPatch Payload -> IO ()
emitMessage Patch
patch Config
Render.defaultConfig Maybe State
forall a. Maybe a
Nothing
        State -> IO ()
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
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    notifyState :: b -> IO ()
notifyState = IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
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 =
    [(NoteNumber, FilePath)] -> Map NoteNumber FilePath
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 = ((NoteNumber, Note) -> NoteNumber)
-> [(NoteNumber, Note)] -> [NoteNumber]
forall a b. (a -> b) -> [a] -> [b]
map (NoteNumber, Note) -> NoteNumber
forall a b. (a, b) -> a
fst ([(NoteNumber, Note)] -> [NoteNumber])
-> [(NoteNumber, Note)] -> [NoteNumber]
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 = [NoteNumber] -> [Note] -> [(NoteNumber, Note)]
forall a b. [a] -> [b] -> [(a, b)]
zip [NoteNumber]
nns ((NoteNumber -> Note) -> [NoteNumber] -> [Note]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> NoteNumber -> Note
makeNote Text
element) [NoteNumber]
nns)
    where nns :: [NoteNumber]
nns = NoteNumber -> NoteNumber -> NoteNumber -> [NoteNumber]
forall a. (Num a, Ord a) => a -> a -> a -> [a]
Seq.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 (Y -> Signal
forall {k} (kind :: k). Y -> Signal kind
Signal.constant Y
0.75) (Note -> Note) -> Note -> Note
forall a b. (a -> b) -> a -> b
$
    (NoteNumber -> Note -> Note
Note.withPitch NoteNumber
nn (Note -> Note) -> Note -> Note
forall a b. (a -> b) -> a -> b
$ RealTime -> RealTime -> Note
Note.testNote RealTime
0 RealTime
1) { element :: Text
Note.element = Text
element }