{-# Language ScopedTypeVariables, InstanceSigs, FlexibleInstances, UndecidableInstances, NumericUnderscores, CPP #-}
-- | Rendering of Csound files and playing the music in real time.
--
-- How are we going to get the sound out of Haskell code?
-- Instruments are ready and we have written all the scores for them.
-- Now, it's time to use the rendering functions. We can render haskell expressions
-- to Csound code. A rendering function takes a value that represents a sound (it's a tuple of signals)
-- and produces a string with Csound code. It can take a value that represents
-- the flags for the csound compiler and global settings ('Csound.Options').
-- Then we can save this string to file and convert it to sound with csound compiler
--
-- > csound -o music.wav music.csd
--
-- Or we can play it in real time with -odac flag. It sends the sound directly to
-- soundcard. It's useful when we are using midi or tweek the parameters in real time
-- with sliders or knobs.
--
-- > csound -odac music.csd
--
-- The main function of this module is 'Csound.IO.renderCsdBy'. Other function are nothing but
-- wrappers that produce the Csound code and make something useful with it (saving to file,
-- playing with specific player or in real time).
module Csound.IO (
-- * Rendering
RenderCsd(..),
CsdArity(..),
renderCsd,
writeCsd, writeCsdBy,
writeSnd, writeSndBy,
-- * Playing the sound
playCsd, playCsdBy,
mplayer, mplayerBy, totem, totemBy,
-- * Live performance
dac, dacBy, vdac, vdacBy,
-- * Render and run
csd, csdBy,
-- * Save user options
saveUserOptions,
-- * Render and run with cabbage
runCabbage, runCabbageBy,
-- * Aliases for type inference
-- | Sometimes the type class @RenderCsd@ is too whide for us.
-- It cn be hard to use in the interpreter without explicit signatures.
-- There are functions to help the type inference.
-- ** For processing inputs
onCard1, onCard2, onCard4, onCard6, onCard8,
-- * Config with command line arguments
-- | With the functions we can add global config parameters to the rendered file.
-- We can supply different parameters with @--omacro@ flag.
--
-- An example:
--
-- > dac $ osc (sig $ readMacrosDouble "FREQ" 440)
--
-- Here we define frequency as a global parameter. It's available by name @"FREQ"@.
-- If we run the program with no flags it would play the default 440 Hz. But we can change that like this:
--
-- > csound tmp.csd --omacro:FREQ=330
--
-- We can update the macro-arguments with flag @--omacro:NAME=VALUE@.
readMacrosString, readMacrosDouble, readMacrosInt
) where
--import Control.Concurrent
import Control.Monad
import Control.Concurrent
import Data.Text qualified as Text
import System.Process (callProcess, ProcessHandle, spawnProcess, terminateProcess, waitForProcess)
import System.Directory
import System.FilePath
import qualified Control.Exception as E
import Data.Proxy
import Data.Default
import Csound.Typed
import Csound.Control.Gui
import Csound.Options(setSilent, setDac, setAdc, setDacBy, setAdcBy, setCabbage)
import Temporal.Class(Harmony(..))
import Data.Text (Text)
import Data.Text.IO qualified as Text
render :: Sigs a => Options -> SE a -> IO Text
render = renderOutBy
render_ :: Options -> SE () -> IO Text
render_ = renderOutBy_
data CsdArity = CsdArity
{ csdArity'inputs :: Int
, csdArity'outputs :: Int
} deriving (Show, Eq)
class RenderCsd a where
renderCsdBy :: Options -> a -> IO Text
csdArity :: Proxy a -> CsdArity
hasInputs :: RenderCsd a => Proxy a -> Bool
hasInputs = ( > 0) . csdArity'inputs . csdArity
hasOutputs :: RenderCsd a => Proxy a -> Bool
hasOutputs = ( > 0) . csdArity'outputs . csdArity
instance {-# OVERLAPPING #-} RenderCsd (SE ()) where
renderCsdBy = render_
csdArity _ = CsdArity 0 0
#if __GLASGOW_HASKELL__ >= 710
instance {-# OVERLAPPABLE #-} forall a. Sigs a => RenderCsd a where
renderCsdBy opt a = render opt (return a)
csdArity _ = CsdArity 0 (tupleArity (Proxy :: Proxy a))
instance {-# OVERLAPPABLE #-} forall a. Sigs a => RenderCsd (SE a) where
renderCsdBy opt a = render opt a
csdArity _ = CsdArity 0 (tupleArity (Proxy :: Proxy a))
instance {-# OVERLAPPABLE #-} forall a. Sigs a => RenderCsd (Source a) where
renderCsdBy opt a = renderCsdBy opt (fromSource a)
csdArity _ = CsdArity 0 (tupleArity (Proxy :: Proxy a))
instance {-# OVERLAPPABLE #-} forall a. Sigs a => RenderCsd (Source (SE a)) where
renderCsdBy opt a = renderCsdBy opt (fromSourceSE a)
csdArity _ = CsdArity 0 (tupleArity (Proxy :: Proxy a))
instance {-# OVERLAPPABLE #-} forall a. Sigs a => RenderCsd (Sco (Mix a)) where
renderCsdBy opt a = renderCsdBy opt (mix a)
csdArity _ = CsdArity 0 (tupleArity (Proxy :: Proxy a))
instance {-# OVERLAPPABLE #-} forall a. Sigs a => RenderCsd [Sco (Mix a)] where
renderCsdBy opt a = renderCsdBy opt (mix $ har a)
csdArity _ = CsdArity 0 (tupleArity $ (Proxy :: Proxy a))
#endif
instance {-# OVERLAPPABLE #-} forall a b. (Sigs a, Sigs b) => RenderCsd (a -> b) where
renderCsdBy opt f = renderEffBy opt (return . f)
csdArity _ = CsdArity (tupleArity (Proxy :: Proxy a)) (tupleArity (Proxy :: Proxy b))
instance {-# OVERLAPPABLE #-} forall a b. (Sigs a, Sigs b) => RenderCsd (a -> SE b) where
renderCsdBy opt f = renderEffBy opt f
csdArity _ = CsdArity (tupleArity (Proxy :: Proxy a)) (tupleArity (Proxy :: Proxy b))
instance {-# OVERLAPPABLE #-} forall a b. (Sigs a, Sigs b) => RenderCsd (a -> Source b) where
renderCsdBy opt f = renderEffBy opt (fromSource . f)
csdArity _ = CsdArity (tupleArity (Proxy :: Proxy a)) (tupleArity (Proxy :: Proxy b))
instance forall a b. (Sigs a, Sigs b) => RenderCsd (a -> Source (SE b)) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
csdArity _ = CsdArity (tupleArity (Proxy :: Proxy a)) (tupleArity (Proxy :: Proxy b))
instance {-# OVERLAPPING #-} forall a. (Sigs a) => RenderCsd (a -> Source (SE Sig2)) where
renderCsdBy opt f = renderEffBy opt (fromSourceSE . f)
csdArity _ = CsdArity (tupleArity (Proxy :: Proxy a)) (tupleArity (Proxy :: Proxy Sig2))
instance {-# OVERLAPPING #-} RenderCsd (Source ()) where
renderCsdBy opt src = renderCsdBy opt $ do
(ui, _) <- src
panel ui
csdArity _ = CsdArity 0 0
instance {-# OVERLAPPING #-} RenderCsd (Source (SE ())) where
renderCsdBy opt src = renderCsdBy opt (joinSource src)
csdArity _ = CsdArity 0 0
-- | Renders Csound file.
renderCsd :: RenderCsd a => a -> IO Text
renderCsd = renderCsdBy def
getTmpFile :: IO FilePath
getTmpFile = (</> "tmp.csd") <$> getTemporaryDirectory
-- | Render Csound file and save it to the give file.
writeCsd :: RenderCsd a => FilePath -> a -> IO ()
writeCsd file a = Text.writeFile file =<< renderCsd a
-- | Render Csound file with options and save it to the give file.
writeCsdBy :: RenderCsd a => Options -> FilePath -> a -> IO ()
writeCsdBy opt file a = Text.writeFile file =<< renderCsdBy opt a
-- | Render Csound file and save result sound to the wav-file.
writeSnd :: RenderCsd a => FilePath -> a -> IO ()
writeSnd = writeSndBy def
-- | Render Csound file with options and save result sound to the wav-file.
writeSndBy :: RenderCsd a => Options -> FilePath -> a -> IO ()
writeSndBy opt file a = do
fileCsd <- getTmpFile
writeCsdBy opt fileCsd a
runWithUserInterrupt (postSetup opt) "csound" $ ["-o", file, fileCsd] ++ logTrace opt
logTrace :: Options -> [String]
logTrace opt
| csdNeedTrace opt = []
| otherwise = ["--logfile=null"]
-- | Renders Csound file, saves it to the given file, renders with csound command and plays it with the given program.
--
-- > playCsd program file csd
--
-- Produces files @file.csd@ (with 'Csound.Render.Mix.renderCsd') and @file.wav@ (with @csound@) and then invokes:
--
-- > program "file.wav"
playCsd :: (RenderCsd a) => (String -> IO ()) -> String -> a -> IO ()
playCsd = playCsdBy def
-- | Works just like 'Csound.Render.Mix.playCsd' but you can supply csound options.
playCsdBy :: (RenderCsd a) => Options -> (String -> IO ()) -> String -> a -> IO ()
playCsdBy opt player file a = do
writeCsdBy opt fileCsd a
runWithUserInterrupt (postSetup opt) "csound" $ ["-o", fileWav, fileCsd] ++ logTrace opt
player fileWav
return ()
where fileCsd = file ++ ".csd"
fileWav = file ++ ".wav"
simplePlayCsdBy :: (RenderCsd a) => Options -> String -> String -> a -> IO ()
simplePlayCsdBy opt player = playCsdBy opt phi
where
phi file = do
runWithUserInterrupt (pure ()) player [file]
-- | Renders csound code to file @tmp.csd@ with flags set to @-odac@, @-iadc@ and @-Ma@
-- (sound output goes to soundcard in real time).
dac :: (RenderCsd a) => a -> IO ()
dac = dacBy def
-- | 'Csound.Base.dac' with options.
dacBy :: forall a. (RenderCsd a) => Options -> a -> IO ()
dacBy opt' a = do
fileCsd <- getTmpFile
writeCsdBy opt fileCsd a
runWithUserInterrupt (postSetup opt') "csound" $ [fileCsd] ++ logTrace opt'
where
opt = mconcat [opt', withDac, withAdc]
withDac
| hasJackConnections opt' = setDacBy "null"
| hasOutputs (Proxy :: Proxy a) = setDac
| otherwise = mempty
withAdc
| hasJackConnections opt' = setAdcBy "null"
| hasInputs (Proxy :: Proxy a) = setAdc
| otherwise = mempty
-- | Output to dac with virtual midi keyboard.
vdac :: (RenderCsd a) => a -> IO ()
vdac = dacBy (setVirtual def)
-- | Output to dac with virtual midi keyboard with specified options.
vdacBy :: (RenderCsd a) => Options -> a -> IO ()
vdacBy opt = dacBy (setVirtual opt)
setVirtual :: Options -> Options
setVirtual a = a { csdFlags = (csdFlags a) { rtmidi = Just VirtualMidi, midiRT = m { midiDevice = Just "0" } } }
where m = midiRT $ csdFlags a
-- | Renders to file @tmp.csd@ in temporary directory and invokes the csound on it.
csd :: (RenderCsd a) => a -> IO ()
csd = csdBy setSilent
-- | Renders to file @tmp.csd@ in temporary directory and invokes the csound on it.
csdBy :: (RenderCsd a) => Options -> a -> IO ()
csdBy options a = do
fileCsd <- getTmpFile
writeCsdBy (setSilent `mappend` options) fileCsd a
runWithUserInterrupt (postSetup options) "csound" $ [fileCsd] ++ logTrace options
postSetup :: Options -> IO ()
postSetup opt = jackConnect opt
jackConnect :: Options -> IO ()
jackConnect opt =
case csdJackConnect opt of
Just [] -> pure ()
Just conns -> void $ forkIO $ do
threadDelay 100_000 -- == sleep 0.1
forM_ conns $ \(port1, port2) -> do
callProcess "jack_connect" $ map Text.unpack [port1, port2]
Nothing -> pure ()
hasJackConnections :: Options -> Bool
hasJackConnections opt
| Just conns <- csdJackConnect opt = not $ null conns
| otherwise = False
----------------------------------------------------------
-- players
-- | Renders to tmp.csd and tmp.wav and plays with mplayer.
mplayer :: (RenderCsd a) => a -> IO ()
mplayer = mplayerBy def
-- | Renders to tmp.csd and tmp.wav and plays with mplayer.
mplayerBy :: (RenderCsd a) => Options -> a -> IO ()
mplayerBy opt = simplePlayCsdBy opt "mplayer" "tmp"
-- | Renders to tmp.csd and tmp.wav and plays with totem player.
totem :: (RenderCsd a) => a -> IO ()
totem = totemBy def
-- | Renders to tmp.csd and tmp.wav and plays with totem player.
totemBy :: (RenderCsd a) => Options -> a -> IO ()
totemBy opt = simplePlayCsdBy opt "totem" "tmp"
----------------------------------------------------------
-- handle user interrupts
runWithUserInterrupt :: IO () -> String -> [String] -> IO ()
runWithUserInterrupt setup cmd args = do
pid <- spawnProcess cmd args
setup
E.catch (waitForProcess pid >> return ()) (onUserInterrupt pid)
where
onUserInterrupt :: ProcessHandle -> E.AsyncException -> IO ()
onUserInterrupt pid x = case x of
E.UserInterrupt -> terminateProcess pid
e -> E.throw e
----------------------------------------------------------
-- | Runs the csound files with cabbage engine.
-- It invokes the Cabbage command line utility and sets all default cabbage flags.
runCabbage :: (RenderCsd a) => a -> IO ()
runCabbage = runCabbageBy def
-- | Runs the csound files with cabbage engine with user defined options.
-- It invokes the Cabbage command line utility and sets all default cabbage flags.
runCabbageBy :: (RenderCsd a) => Options -> a -> IO ()
runCabbageBy opt' a = do
fileCsd <- getTmpFile
writeCsdBy opt fileCsd a
runWithUserInterrupt (pure ()) "Cabbage" [fileCsd]
where opt = opt' `mappend` setCabbage
------------------------------
-- | Alias to process inputs of single input audio-card.
onCard1 :: (Sig -> a) -> (Sig -> a)
onCard1= id
-- | Alias to process inputs of stereo input audio-card.
onCard2 :: (Sig2 -> a) -> (Sig2 -> a)
onCard2= id
-- | Alias to process inputs of audio-card with 4 inputs.
onCard4 :: (Sig4 -> a) -> (Sig4 -> a)
onCard4= id
-- | Alias to process inputs of audio-card with 6 inputs.
onCard6 :: (Sig6 -> a) -> (Sig6 -> a)
onCard6= id
-- | Alias to process inputs of audio-card with 8 inputs.
onCard8 :: (Sig8 -> a) -> (Sig8 -> a)
onCard8= id
#if __GLASGOW_HASKELL__ < 710
-- Sig
setArity n a = CsdArity 0 n
instance RenderCsd Sig where { renderCsdBy opt a = render opt (return a) , csdArity = setArity 1 }
instance RenderCsd (SE Sig) where { renderCsdBy opt a = render opt a } , csdArity = setArity 1 }
instance RenderCsd (Source Sig) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) , csdArity = setArity 1 }
instance RenderCsd (Source (SE Sig)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) , csdArity = setArity 1 }
-- Sig2
instance RenderCsd Sig2 where { renderCsdBy opt a = render opt (return a) , csdArity = setArity 2 }
instance RenderCsd (SE Sig2) where { renderCsdBy opt a = render opt a , csdArity = setArity 2 }
instance RenderCsd (Source Sig2) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) , csdArity = setArity 2 }
instance RenderCsd (Source (SE Sig2)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) , csdArity = setArity 2 }
-- Sig3
instance RenderCsd Sig3 where { renderCsdBy opt a = render opt (return a) , csdArity = setArity 3 }
instance RenderCsd (SE Sig3) where { renderCsdBy opt a = render opt a , csdArity = setArity 3 }
instance RenderCsd (Source Sig3) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) , csdArity = setArity 3 }
instance RenderCsd (Source (SE Sig3)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) , csdArity = setArity 3 }
-- Sig4
instance RenderCsd Sig4 where { renderCsdBy opt a = render opt (return a) , csdArity = setArity 4 }
instance RenderCsd (SE Sig4) where { renderCsdBy opt a = render opt a , csdArity = setArity 4 }
instance RenderCsd (Source Sig4) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) , csdArity = setArity 4 }
instance RenderCsd (Source (SE Sig4)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) , csdArity = setArity 4 }
-- Sig5
instance RenderCsd Sig5 where { renderCsdBy opt a = render opt (return a) , csdArity = setArity 5 }
instance RenderCsd (SE Sig5) where { renderCsdBy opt a = render opt a , csdArity = setArity 5 }
instance RenderCsd (Source Sig5) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) , csdArity = setArity 5 }
instance RenderCsd (Source (SE Sig5)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) , csdArity = setArity 5 }
-- Sig6
instance RenderCsd Sig6 where { renderCsdBy opt a = render opt (return a) , csdArity = setArity 6 }
instance RenderCsd (SE Sig6) where { renderCsdBy opt a = render opt a , csdArity = setArity 6 }
instance RenderCsd (Source Sig6) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) , csdArity = setArity 6 }
instance RenderCsd (Source (SE Sig6)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) , csdArity = setArity 6 }
-- Sig7
instance RenderCsd Sig7 where { renderCsdBy opt a = render opt (return a) , csdArity = setArity 7 }
instance RenderCsd (SE Sig7) where { renderCsdBy opt a = render opt a , csdArity = setArity 7 }
instance RenderCsd (Source Sig7) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) , csdArity = setArity 7 }
instance RenderCsd (Source (SE Sig7)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) , csdArity = setArity 7 }
-- Sig8
instance RenderCsd Sig8 where { renderCsdBy opt a = render opt (return a) , csdArity = setArity 8 }
instance RenderCsd (SE Sig8) where { renderCsdBy opt a = render opt a , csdArity = setArity 8 }
instance RenderCsd (Source Sig8) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) , csdArity = setArity 8 }
instance RenderCsd (Source (SE Sig8)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) , csdArity = setArity 8 }
instance RenderCsd (Sco (Mix Sig)) where { renderCsdBy opt a = renderCsdBy opt $ mix a , csdArity = setArity 1 }
instance RenderCsd (Sco (Mix Sig2)) where { renderCsdBy opt a = renderCsdBy opt $ mix a , csdArity = setArity 2 }
instance RenderCsd (Sco (Mix Sig3)) where { renderCsdBy opt a = renderCsdBy opt $ mix a , csdArity = setArity 3 }
instance RenderCsd (Sco (Mix Sig4)) where { renderCsdBy opt a = renderCsdBy opt $ mix a , csdArity = setArity 4 }
instance RenderCsd (Sco (Mix Sig5)) where { renderCsdBy opt a = renderCsdBy opt $ mix a , csdArity = setArity 5 }
instance RenderCsd [Sco (Mix Sig)] where { renderCsdBy opt a = renderCsdBy opt $ mix $ har a , csdArity = setArity 1 }
instance RenderCsd [Sco (Mix Sig2)] where { renderCsdBy opt a = renderCsdBy opt $ mix $ har a , csdArity = setArity 2 }
instance RenderCsd [Sco (Mix Sig3)] where { renderCsdBy opt a = renderCsdBy opt $ mix $ har a , csdArity = setArity 3 }
instance RenderCsd [Sco (Mix Sig4)] where { renderCsdBy opt a = renderCsdBy opt $ mix $ har a , csdArity = setArity 4 }
instance RenderCsd [Sco (Mix Sig5)] where { renderCsdBy opt a = renderCsdBy opt $ mix $ har a , csdArity = setArity 5 }
#endif