diff --git a/csound-expression.cabal b/csound-expression.cabal --- a/csound-expression.cabal +++ b/csound-expression.cabal @@ -1,5 +1,5 @@ Name: csound-expression -Version: 5.4.3.1 +Version: 5.4.4.0 cabal-version: 1.12 License: BSD3 License-file: LICENSE @@ -87,10 +87,10 @@ filepath, transformers >= 0.3, containers, - csound-expression-typed >= 0.2.7, - csound-expression-dynamic >= 0.3.9.1, - temporal-media >= 0.6.3, - csound-expression-opcodes >= 0.0.5.1, + csound-expression-typed >= 0.2.9, + csound-expression-dynamic >= 0.4.0.0, + temporal-media >= 0.6.4, + csound-expression-opcodes >= 0.0.5.4, text default-language: Haskell2010 default-extensions: diff --git a/src/Csound/Air/Envelope.hs b/src/Csound/Air/Envelope.hs --- a/src/Csound/Air/Envelope.hs +++ b/src/Csound/Air/Envelope.hs @@ -319,7 +319,6 @@ d1 = duty / 2 d2 = (1 - duty) / 2 - ------------------------------------------------------------------ genSeq :: ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig diff --git a/src/Csound/Air/Filter.hs b/src/Csound/Air/Filter.hs --- a/src/Csound/Air/Filter.hs +++ b/src/Csound/Air/Filter.hs @@ -63,6 +63,7 @@ -- resonant filters cheb1, cheb2, vcf, cheb1', cheb2', vcf', + mode, -- * Named resonant low pass filters plastic, wobble, trumpy, harsh, @@ -85,6 +86,7 @@ import Csound.SigSpace(bat) import Csound.Typed.Opcode +import Csound.Dynamic -- | Low-pass filter. -- @@ -449,6 +451,21 @@ vcf' :: D -> Sig -> Sig -> Sig -> Sig vcf' npoles = mkReson (clp' npoles) (chp' npoles) + +-- | +-- A filter that simulates a mass-spring-damper system +-- +-- Filters the incoming signal with the specified resonance frequency and +-- quality factor. It can also be seen as a signal generator for high quality +-- factor, with an impulse for the excitation. You can combine several modes +-- to built complex instruments such as bells or guitar tables. +-- +-- > aout mode ain, xfreq, xQ [, iskip] +-- +-- csound doc: +mode :: Sig -> Sig -> Sig -> Sig +mode b1 b2 b3 = Sig $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 + where f a1 a2 a3 = opcs "mode" [(Ar,[Ar,Xr,Xr,Ir])] [a1,a2,a3] -- moog ladder diff --git a/src/Csound/Air/Fx.hs b/src/Csound/Air/Fx.hs --- a/src/Csound/Air/Fx.hs +++ b/src/Csound/Air/Fx.hs @@ -67,7 +67,7 @@ import Data.Default import Csound.Typed -import Csound.Typed.Opcode hiding (gain) +import Csound.Typed.Opcode hiding (gain, tablewa, tablew) import Csound.Tab import Csound.Air.Wave(Lfo, unipolar, oscBy, white, pink) @@ -583,7 +583,7 @@ let segLength = segLengthSeconds * sig getSampleRate andx = phasor (sig $ getSampleRate / ftlen buf) andx1 = delay andx 1 - tabw asig (andx * sig (ftlen buf)) buf + tablew asig (andx * sig (ftlen buf)) buf ksamp <- readRef ksampRef let apos = samphold (andx1 * sig (ftlen buf)) (sig ksamp) diff --git a/src/Csound/Air/Granular/Morpheus.hs b/src/Csound/Air/Granular/Morpheus.hs --- a/src/Csound/Air/Granular/Morpheus.hs +++ b/src/Csound/Air/Granular/Morpheus.hs @@ -20,7 +20,7 @@ import Data.Default import Csound.Typed -import Csound.Typed.Opcode +import Csound.Typed.Opcode hiding (tablew) import Csound.Tab import Csound.Air.Granular(Pointer, csdPartikkel) diff --git a/src/Csound/Base.hs b/src/Csound/Base.hs --- a/src/Csound/Base.hs +++ b/src/Csound/Base.hs @@ -48,9 +48,9 @@ import Csound.Typed.Opcode hiding ( button, display, space, lfo, initc7, ctrl7, - oscInit, oscListen, oscSend, + oscInit, oscSend, lpshold, loopseg, loopxseg, partikkel, syncgrain, granule, sndwarp, sndwarpst, fof2, line, delay, metro, dust, - duserrnd, cuserrnd, urd) + duserrnd, cuserrnd, urd, tablew, tablewa, fmod, count) diff --git a/src/Csound/Control/Midi.hs b/src/Csound/Control/Midi.hs --- a/src/Csound/Control/Midi.hs +++ b/src/Csound/Control/Midi.hs @@ -165,8 +165,6 @@ (amp, cps) <- genHoldAmpCpsSig key2cps (toMidiFun_ channel) return (port amp portTime, port cps portTime) - - genAmpCpsSig :: (Msg -> D) -> ((Msg -> SE Sig) -> SE Sig) -> SE MonoArg genAmpCpsSig key2cps midiFun = do ref <- newGlobalCtrlRef ((0, 0) :: (Sig, Sig)) @@ -337,7 +335,7 @@ -------------------------------------------------------------- --- | Invokes ooverloaded instruments with midi. +-- | Invokes overloaded instruments with midi. -- Example: -- -- > dac $ tryMidi (mul (fades 0.01 0.1) . tri) diff --git a/src/Csound/IO.hs b/src/Csound/IO.hs --- a/src/Csound/IO.hs +++ b/src/Csound/IO.hs @@ -1,4 +1,4 @@ -{-# Language ScopedTypeVariables, InstanceSigs, FlexibleInstances, UndecidableInstances, CPP #-} +{-# 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? @@ -12,7 +12,7 @@ -- > 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 usefull when we are using midi or tweek the parameters in real time +-- soundcard. It's useful when we are using midi or tweek the parameters in real time -- with sliders or knobs. -- -- > csound -odac music.csd @@ -70,9 +70,9 @@ --import Control.Concurrent import Control.Monad - +import Control.Concurrent import Data.Text qualified as Text -import System.Process +import System.Process (callProcess, ProcessHandle, spawnProcess, terminateProcess, waitForProcess) import System.Directory import System.FilePath import qualified Control.Exception as E @@ -84,11 +84,13 @@ 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 String +render :: Sigs a => Options -> SE a -> IO Text render = renderOutBy -render_ :: Options -> SE () -> IO String +render_ :: Options -> SE () -> IO Text render_ = renderOutBy_ data CsdArity = CsdArity @@ -97,7 +99,7 @@ } deriving (Show, Eq) class RenderCsd a where - renderCsdBy :: Options -> a -> IO String + renderCsdBy :: Options -> a -> IO Text csdArity :: Proxy a -> CsdArity hasInputs :: RenderCsd a => Proxy a -> Bool @@ -167,7 +169,7 @@ csdArity _ = CsdArity 0 0 -- | Renders Csound file. -renderCsd :: RenderCsd a => a -> IO String +renderCsd :: RenderCsd a => a -> IO Text renderCsd = renderCsdBy def getTmpFile :: IO FilePath @@ -175,11 +177,11 @@ -- | Render Csound file and save it to the give file. writeCsd :: RenderCsd a => FilePath -> a -> IO () -writeCsd file a = writeFile file =<< renderCsd a +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 = writeFile file =<< renderCsdBy opt a +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 () @@ -190,12 +192,12 @@ writeSndBy opt file a = do fileCsd <- getTmpFile writeCsdBy opt fileCsd a - runWithUserInterrupt (postSetup opt) $ unwords ["csound -o", file, fileCsd, logTrace opt] + runWithUserInterrupt (postSetup opt) "csound" $ ["-o", file, fileCsd] ++ logTrace opt -logTrace :: Options -> String +logTrace :: Options -> [String] logTrace opt - | csdNeedTrace opt = "" - | otherwise = "--logfile=null" + | 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. -- @@ -211,7 +213,7 @@ playCsdBy :: (RenderCsd a) => Options -> (String -> IO ()) -> String -> a -> IO () playCsdBy opt player file a = do writeCsdBy opt fileCsd a - runWithUserInterrupt (postSetup opt) $ unwords ["csound -o", fileWav, fileCsd, logTrace opt] + runWithUserInterrupt (postSetup opt) "csound" $ ["-o", fileWav, fileCsd] ++ logTrace opt player fileWav return () where fileCsd = file ++ ".csd" @@ -219,8 +221,9 @@ simplePlayCsdBy :: (RenderCsd a) => Options -> String -> String -> a -> IO () simplePlayCsdBy opt player = playCsdBy opt phi - where phi file = do - runWithUserInterrupt (pure ()) $ unwords [player, file] + 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). @@ -232,7 +235,8 @@ dacBy opt' a = do fileCsd <- getTmpFile writeCsdBy opt fileCsd a - runWithUserInterrupt (postSetup opt') $ unwords ["csound", fileCsd, logTrace opt'] + runWithUserInterrupt (postSetup opt') "csound" $ [fileCsd] ++ logTrace opt' + where opt = mconcat [opt', withDac, withAdc] @@ -267,22 +271,20 @@ csdBy options a = do fileCsd <- getTmpFile writeCsdBy (setSilent `mappend` options) fileCsd a - runWithUserInterrupt (postSetup options) $ unwords ["csound", fileCsd, logTrace options] + runWithUserInterrupt (postSetup options) "csound" $ [fileCsd] ++ logTrace options postSetup :: Options -> IO () postSetup opt = jackConnect opt jackConnect :: Options -> IO () -jackConnect opt - | Just conns <- csdJackConnect opt = case conns of - [] -> pure () - _ -> void $ runCommand $ Text.unpack $ jackCmd conns - | otherwise = pure () - where - addSleep = ("sleep 0.1; " `mappend` ) - - jackCmd = addSleep . Text.intercalate ";" . fmap jackConn - jackConn (port1, port2) = Text.unwords ["jack_connect", port1, port2] +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 @@ -311,9 +313,10 @@ ---------------------------------------------------------- -- handle user interrupts -runWithUserInterrupt :: IO () -> String -> IO () -runWithUserInterrupt setup cmd = do - pid <- runCommand cmd + +runWithUserInterrupt :: IO () -> String -> [String] -> IO () +runWithUserInterrupt setup cmd args = do + pid <- spawnProcess cmd args setup E.catch (waitForProcess pid >> return ()) (onUserInterrupt pid) where @@ -325,17 +328,17 @@ ---------------------------------------------------------- -- | Runs the csound files with cabbage engine. --- It invokes the Cabbage command line utility and setts all default cabbage flags. +-- 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 setts all default cabbage flags. +-- 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 ()) $ unwords ["Cabbage", fileCsd] + runWithUserInterrupt (pure ()) "Cabbage" [fileCsd] where opt = opt' `mappend` setCabbage ------------------------------ diff --git a/src/Csound/Options.hs b/src/Csound/Options.hs --- a/src/Csound/Options.hs +++ b/src/Csound/Options.hs @@ -11,6 +11,8 @@ setMessageLevel, noMessages, setTrace, setCabbage, setJacko, + setDebugTrace, + setVerbatimFlags, -- * Flags -- | Csound's command line flags. See original documentation for diff --git a/src/Csound/Tab.hs b/src/Csound/Tab.hs --- a/src/Csound/Tab.hs +++ b/src/Csound/Tab.hs @@ -189,6 +189,7 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Csound.Dynamic hiding (int, when1, whens, genId, pn) +import Control.Monad import Data.Default import Csound.Typed @@ -802,8 +803,8 @@ -- -- csound docs: tablewa :: Tab -> Sig -> Sig -> SE Sig -tablewa b1 b2 b3 = fmap (Sig . return) $ SE $ (depT =<<) $ lift $ f <$> unTab b1 <*> unSig b2 <*> unSig b3 - where f a1 a2 a3 = opcs "tablewa" [(Kr,[Kr,Ar,Kr])] [a1,a2,a3] +tablewa b1 b2 b3 = fmap (Sig . return) $ SE $ join $ f <$> (lift . unTab) b1 <*> (lift . unSig) b2 <*> (lift . unSig) b3 + where f a1 a2 a3 = opcsDep "tablewa" [(Kr,[Kr,Ar,Kr])] [a1,a2,a3] -- | Transforms phasor that is defined in seconds to relative phasor that ranges in 0 to 1. @@ -1249,8 +1250,8 @@ -- -- csound doc: tablew :: Sig -> Sig -> Tab -> SE () -tablew b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unTab b3 - where f a1 a2 a3 = opcs "tablew" [(Xr,[Xr,Xr,Ir,Ir,Ir,Ir])] [a1,a2,a3] +tablew b1 b2 b3 = SE $ join $ f <$> (lift . unSig) b1 <*> (lift . unSig) b2 <*> (lift . unTab) b3 + where f a1 a2 a3 = opcsDep_ "tablew" [(Xr,[Xr,Xr,Ir,Ir,Ir,Ir])] [a1,a2,a3] -- | @@ -1273,8 +1274,8 @@ -- -- csound doc: readTab :: Sig -> Tab -> SE Sig -readTab b1 b2 = fmap ( Sig . return) $ SE $ (depT =<<) $ lift $ f <$> unSig b1 <*> unTab b2 - where f a1 a2 = opcs "tab" [(Kr,[Kr,Ir,Ir]),(Ar,[Xr,Ir,Ir])] [a1,a2] +readTab b1 b2 = fmap ( Sig . return) $ SE $ join $ f <$> (lift .unSig) b1 <*> (lift . unTab) b2 + where f a1 a2 = opcsDep "tab" [(Kr,[Kr,Ir,Ir]),(Ar,[Xr,Ir,Ir])] [a1,a2] @@ -1291,8 +1292,8 @@ -- -- csound doc: readTable :: SigOrD a => a -> Tab -> SE a -readTable b1 b2 = fmap (fromGE . return) $ SE $ (depT =<<) $ lift $ f <$> toGE b1 <*> unTab b2 - where f a1 a2 = opcs "table" [(Ar,[Ar,Ir,Ir,Ir,Ir]) +readTable b1 b2 = fmap (fromGE . return) $ SE $ join $ f <$> (lift . toGE) b1 <*> (lift . unTab) b2 + where f a1 a2 = opcsDep "table" [(Ar,[Ar,Ir,Ir,Ir,Ir]) ,(Ir,[Ir,Ir,Ir,Ir,Ir]) ,(Kr,[Kr,Ir,Ir,Ir,Ir])] [a1,a2] @@ -1309,8 +1310,8 @@ -- -- csound doc: readTable3 :: SigOrD a => a -> Tab -> SE a -readTable3 b1 b2 = fmap (fromGE . return) $ SE $ (depT =<<) $ lift $ f <$> toGE b1 <*> unTab b2 - where f a1 a2 = opcs "table3" [(Ar,[Ar,Ir,Ir,Ir,Ir]) +readTable3 b1 b2 = fmap (fromGE . return) $ SE $ join $ f <$> (lift .toGE) b1 <*> (lift . unTab) b2 + where f a1 a2 = opcsDep "table3" [(Ar,[Ar,Ir,Ir,Ir,Ir]) ,(Ir,[Ir,Ir,Ir,Ir,Ir]) ,(Kr,[Kr,Ir,Ir,Ir,Ir])] [a1,a2] @@ -1327,8 +1328,8 @@ -- -- csound doc: readTablei :: SigOrD a => a -> Tab -> SE a -readTablei b1 b2 = fmap (fromGE . return) $ SE $ (depT =<<) $ lift $ f <$> toGE b1 <*> unTab b2 - where f a1 a2 = opcs "tablei" [(Ar,[Ar,Ir,Ir,Ir,Ir]) +readTablei b1 b2 = fmap (fromGE . return) $ SE $ join $ f <$> (lift . toGE) b1 <*> (lift . unTab) b2 + where f a1 a2 = opcsDep "tablei" [(Ar,[Ar,Ir,Ir,Ir,Ir]) ,(Ir,[Ir,Ir,Ir,Ir,Ir]) ,(Kr,[Kr,Ir,Ir,Ir,Ir])] [a1,a2] @@ -1386,8 +1387,8 @@ -- -- the tab should be done with tabDist, randDist or rangeDist cuserrnd :: SigOrD a => a -> a -> Tab -> SE a -cuserrnd b1 b2 b3 = fmap (fromGE . return) $ SE $ (depT =<<) $ lift $ f <$> toGE b1 <*> toGE b2 <*> unTab b3 - where f a1 a2 a3 = opcs "cuserrnd" [(Ar,[Kr,Kr,Kr]) +cuserrnd b1 b2 b3 = fmap (fromGE . return) $ SE $ join $ f <$> (lift . toGE) b1 <*> (lift . toGE) b2 <*> (lift . unTab) b3 + where f a1 a2 a3 = opcsDep "cuserrnd" [(Ar,[Kr,Kr,Kr]) ,(Ir,[Ir,Ir,Ir]) ,(Kr,[Kr,Kr,Kr])] [a1,a2,a3] @@ -1403,8 +1404,8 @@ -- -- the tab should be done with tabDist, randDist or rangeDist duserrnd :: SigOrD a => Tab -> SE a -duserrnd b1 = fmap (fromGE . return) $ SE $ (depT =<<) $ lift $ fmap f $ unTab b1 - where f a1 = opcs "duserrnd" [(Ar,[Kr]) +duserrnd b1 = fmap (fromGE . return) $ SE $ join $ f <$> ((lift . unTab) b1) + where f a1 = opcsDep "duserrnd" [(Ar,[Kr]) ,(Ir,[Ir]) ,(Kr,[Kr])] [a1] @@ -1457,6 +1458,4 @@ mkRelative :: (Functor t, Foldable t, RealFrac b, Integral a) => a -> t b -> t Double mkRelative n as = fmap ((fromIntegral :: (Int -> Double)) . round . (s * )) as where s = fromIntegral n / sum as - -