summaryrefslogtreecommitdiff
path: root/src/Csound/Typed/Control
diff options
context:
space:
mode:
Diffstat (limited to 'src/Csound/Typed/Control')
-rw-r--r--src/Csound/Typed/Control/Api.hs30
-rw-r--r--src/Csound/Typed/Control/Evt.hs12
-rw-r--r--src/Csound/Typed/Control/Instr.hs16
-rw-r--r--src/Csound/Typed/Control/Mix.hs15
-rw-r--r--src/Csound/Typed/Control/Ref.hs50
5 files changed, 61 insertions, 62 deletions
diff --git a/src/Csound/Typed/Control/Api.hs b/src/Csound/Typed/Control/Api.hs
index 7cc2979..4110b92 100644
--- a/src/Csound/Typed/Control/Api.hs
+++ b/src/Csound/Typed/Control/Api.hs
@@ -24,7 +24,7 @@ import Csound.Typed.Plugins.TabQueue
-- | Creates an instrument that can be triggered by name with Csound API.
-- The arguments are determined from the structure of the input for the instrument.
--
--- With Csound API we can send messages
+-- With Csound API we can send messages
--
-- > i "name" time duration arg1 arg2 arg3
trigByName_ :: Arg a => String -> (a -> SE ()) -> SE ()
@@ -34,14 +34,14 @@ trigByName_ name instr = geToSe $ saveNamedInstr name =<< (execSE $ instr toArg)
-- The arguments are determined from the structure of the input for the instrument.
-- If we have a tuple of arguments: @(D, D, Tab)@
-- The would be rendered to instrument arguments that strts from @p4@.
--- @p1@ is the name of teh instrument, @p2@ is the start time of the note,
+-- @p1@ is the name of teh instrument, @p2@ is the start time of the note,
-- @p3@ is the duration of the note. Then @p4@ and @p5@ are going to be doubles and @p6@
-- is an integer that denotes a functional table.
trigByName :: (Arg a, Sigs b) => String -> (a -> SE b) -> SE b
trigByName name instr = do
ref <- newClearableGlobalRef 0
trigByName_ name (go ref)
- readRef ref
+ readRef ref
where go ref x = mixRef ref =<< instr x
@@ -57,7 +57,7 @@ trigByNameMidi_ name instr = do
pchExpr <- toGE pch
let instrIdExpr = D.instrIdE instrId + pchExpr / 1000
noteFlagExpr <- toGE noteFlag
- args <- fromTuple (pch, vol, other)
+ args <- fromTuple (pch, vol, other)
return $ do
D.when1 D.Ir (noteFlagExpr ==* 1) $ do
eventi (Event instrIdExpr 0 (-1) args)
@@ -79,7 +79,7 @@ trigByNameMidi_ name instr = do
--
-- The instrument takes a triplet of @(pitchKey, volumeKey, auxilliaryTuple)@.
-- The order does matter. Please don't pass the @volumeKey@ as the first argument.
--- The instrument expects the pitch key to be a first argument.
+-- The instrument expects the pitch key to be a first argument.
-- Under the hood
-- it creates held notes that are indexed by pitch. If you know the Csound it creates
@@ -95,10 +95,10 @@ trigByNameMidi :: (Arg a, Sigs b) => String -> ((D, D, a) -> SE b) -> SE b
trigByNameMidi name instr = do
ref <- newClearableGlobalRef 0
trigByNameMidi_ name (go ref)
- readRef ref
+ readRef ref
where go ref x = mixRef ref =<< instr x
-namedMonoMsg ::String -> SE MonoArg
+namedMonoMsg :: String -> SE MonoArg
namedMonoMsg name = do
refPch <- newGlobalRef 0
refVol <- newGlobalRef 0
@@ -116,18 +116,18 @@ namedMonoMsg name = do
let kgate = ifB onFlag 1 0
kamp = downsamp' volKey
kcps = downsamp' pchKey
- trig = changed [kamp, kcps]
+ trig = changed [kamp, kcps]
return $ MonoArg kamp kcps kgate trig
- where
- onNote = tabQueue2_append
+ where
+ onNote = tabQueue2_append
offNote tab (pch, vol) = tabQueue2_delete tab pch
trigByNameMidiCbk :: String -> ((D, D) -> SE ()) -> ((D, D) -> SE ()) -> SE ()
-trigByNameMidiCbk name noteOn noteOff =
+trigByNameMidiCbk name noteOn noteOff =
trigByName_ name go
where
go :: (D, D, D) -> SE ()
- go (noteFlag, pch, vol) = do
+ go (noteFlag, pch, vol) = do
whenD1 (noteFlag ==* 1) $ noteOn (pch, vol)
whenD1 (noteFlag ==* 0) $ noteOff (pch, vol)
SE turnoff
@@ -140,10 +140,10 @@ port' a b = fromGE $ do
downsamp' :: Sig -> Sig
downsamp' a = fromGE $ do
- a' <- toGE a
+ a' <- toGE a
return $ downsamp a'
--- |
+-- |
-- Fast table opcodes.
--
-- Fast table opcodes. Faster than
@@ -163,7 +163,7 @@ tabw b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unTab
where f a1 a2 a3 = opcs "tabw" [(Xr,[Kr,Kr,Ir,Ir])] [a1,a2,a3]
--- |
+-- |
-- Fast table opcodes.
--
-- Fast table opcodes. Faster than
diff --git a/src/Csound/Typed/Control/Evt.hs b/src/Csound/Typed/Control/Evt.hs
index 29bc107..ad87cc5 100644
--- a/src/Csound/Typed/Control/Evt.hs
+++ b/src/Csound/Typed/Control/Evt.hs
@@ -31,7 +31,7 @@ import Csound.Typed.Control.Ref
import Csound.Typed.Constants(infiniteDur)
import Csound.Typed.InnerOpcodes
-renderEvts :: Evt (Sco a) -> Evt [(D, D, a)]
+renderEvts :: Evt (Sco a) -> Evt [(Sig, Sig, a)]
renderEvts = fmap (fmap unEvt . T.render)
where unEvt e = (T.eventStart e, T.eventDur e, T.eventContent e)
@@ -55,7 +55,7 @@ schedBy instr evts args = flip apInstr args $ do
-------------------------------------------------
-- triggereing the events
-saveEvtInstr :: Arg a => Int -> C.InstrId -> Evt [(D, D, a)] -> GE C.InstrId
+saveEvtInstr :: Arg a => Int -> C.InstrId -> Evt [(Sig, Sig, a)] -> GE C.InstrId
saveEvtInstr arity instrId evts = saveInstr $ do
aliveCountRef <- newRef (10 :: D)
evtMixInstr aliveCountRef
@@ -68,14 +68,14 @@ saveEvtInstr arity instrId evts = saveInstr $ do
aliveCount <- readRef aliveCountRef
fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount
- go :: Arg a => Ref D -> GE C.ChnRef -> Evt [(D, D, a)] -> SE ()
+ go :: Arg a => Ref D -> GE C.ChnRef -> Evt [(Sig, Sig, a)] -> SE ()
go aliveCountRef mchnId events =
runEvt events $ \es -> do
writeRef aliveCountRef $ int $ 2 * length es
chnId <- geToSe mchnId
fromDep_ $ mapM_ (event chnId) es
- event :: Arg a => C.ChnRef -> (D, D, a) -> Dep ()
+ event :: Arg a => C.ChnRef -> (Sig, Sig, a) -> Dep ()
event chnId (start, dur, args) = hideGEinDep $ fmap C.event $
C.Event (primInstrId instrId) <$> toGE start <*> toGE dur <*> (fmap (++ [C.chnRefId chnId]) $ toNote args)
@@ -252,7 +252,7 @@ autoOff dt sigs = fmap toTuple $ fromDep $ hideGEinDep $ phi =<< fromTuple sigs
return $ C.autoOff dtE x
-saveEvtInstr_ :: Arg a => C.InstrId -> Evt [(D, D, a)] -> Dep ()
+saveEvtInstr_ :: Arg a => C.InstrId -> Evt [(Sig, Sig, a)] -> Dep ()
saveEvtInstr_ instrId evts = unSE $ runEvt evts $ \es -> fromDep_ $ mapM_ event es
where event (start, dur, args) = hideGEinDep $ fmap C.event $ C.Event (primInstrId instrId) <$> toGE start <*> toGE dur <*> toNote args
@@ -289,7 +289,7 @@ monoSched evts = evtPort instr evts read
I.writePort p (amp, cps, 0)
return $ MonoArg amp cps (ifB (gate `equalsTo` 0) 0 1) (changed [amp, cps, gate])
-runSco :: Arg a => Evt (Sco a) -> ((D,D,a) -> SE ()) -> SE ()
+runSco :: Arg a => Evt (Sco a) -> ((Sig,Sig,a) -> SE ()) -> SE ()
runSco evts f = runEvt (renderEvts evts) $ mapM_ f
-- | Plays the note until next note comes or something happens on the second event stream.
diff --git a/src/Csound/Typed/Control/Instr.hs b/src/Csound/Typed/Control/Instr.hs
index ac45cff..8623d23 100644
--- a/src/Csound/Typed/Control/Instr.hs
+++ b/src/Csound/Typed/Control/Instr.hs
@@ -1,10 +1,10 @@
-- | Converts to low-level instruments
module Csound.Typed.Control.Instr(
- Arity(..), InsExp, EffExp,
- funArity, constArity,
- insExp, effExp, masterExp, midiExp, unitExp,
+ Arity(..), InsExp, EffExp,
+ funArity, constArity,
+ insExp, effExp, masterExp, midiExp, unitExp,
apInstr, apInstr0
-) where
+) where
import Data.Default
import Csound.Dynamic(InstrId(..))
@@ -24,12 +24,12 @@ funArity instr = Arity (tupleArity a) (tupleArity b)
constArity :: (Tuple a) => SE a -> Arity
constArity a = Arity 0 (outArity a)
-
-insExp :: (Arg a, Tuple b) => (a -> SE b) -> InsExp
+
+insExp :: (Arg a, Tuple b) => (a -> SE b) -> InsExp
insExp instr = execGEinSE $ fmap fromTuple $ instr toArg
effExp :: (Tuple a, Tuple b) => (a -> SE b) -> EffExp
-effExp instr = execGEinSE . fmap fromTuple . instr . toTuple . return
+effExp instr = execGEinSE . fmap fromTuple . instr . toTuple . return
masterExp :: (Tuple a) => SE a -> InsExp
masterExp = execGEinSE . fmap fromTuple
@@ -42,7 +42,7 @@ unitExp = execGEinSE . fmap unUnit
apInstr :: (Arg a, Sigs b) => GE InstrId -> a -> b
apInstr instrIdGE args = res
- where
+ where
res = toTuple $ do
instrId <- instrIdGE
argList <- fromTuple args
diff --git a/src/Csound/Typed/Control/Mix.hs b/src/Csound/Typed/Control/Mix.hs
index fd01dc9..abcc666 100644
--- a/src/Csound/Typed/Control/Mix.hs
+++ b/src/Csound/Typed/Control/Mix.hs
@@ -1,4 +1,4 @@
-{-# Language FlexibleContexts, ScopedTypeVariables #-}
+{-# Language FlexibleContexts, ScopedTypeVariables, CPP #-}
module Csound.Typed.Control.Mix(
Mix,
sco, eff, mix, mixBy, monoSco,
@@ -8,17 +8,12 @@ module Csound.Typed.Control.Mix(
import Data.Boolean
-import Control.Applicative
import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import Control.Monad
-import Data.Traversable
import System.Mem.StableName
import Temporal.Media
import Csound.Dynamic hiding (Instr, Sco, str)
-import qualified Csound.Typed.GlobalState.Elements as C
import Csound.Typed.Types
import Csound.Typed.Types.MixSco
@@ -26,10 +21,14 @@ import Csound.Typed.GlobalState hiding (notes)
import Csound.Typed.Control.Instr
import Csound.Typed.InnerOpcodes
+#if __GLASGOW_HASKELL__ < 710
+import Data.Traversable
+#endif
+
toCsdEventList :: Sco a -> CsdEventList a
toCsdEventList = id
-singleCsdEvent :: (D, D, a) -> Sco a
+singleCsdEvent :: (Sig, Sig, a) -> Sco a
singleCsdEvent (start, duration, content) = del start $ str duration $ temp content
-- | Special type that represents a scores of sound signals.
@@ -37,7 +36,7 @@ singleCsdEvent (start, duration, content) = del start $ str duration $ temp cont
-- in the value of this type.
newtype Mix a = Mix { unMix :: GE M }
-type Sco a = Track D a
+type Sco a = Track Sig a
wrapSco :: Sco a -> (CsdEventList a -> GE M) -> Sco (Mix b)
wrapSco notes getContent = singleCsdEvent (0, csdEventListDur evts, Mix $ getContent evts)
diff --git a/src/Csound/Typed/Control/Ref.hs b/src/Csound/Typed/Control/Ref.hs
index 5ed1668..10f74b8 100644
--- a/src/Csound/Typed/Control/Ref.hs
+++ b/src/Csound/Typed/Control/Ref.hs
@@ -42,18 +42,18 @@ writeRef (Ref vars) a = fromDep_ $ hideGEinDep $ do
readRef :: Tuple a => Ref a -> SE a
readRef (Ref vars) = SE $ fmap (toTuple . return) $ mapM readVar vars
--- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value.
+-- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
newRef :: Tuple a => a -> SE (Ref a)
-newRef t = fmap Ref $ newLocalVars (tupleRates t) (fromTuple t)
-
--- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value.
+newRef t = fmap Ref $ newLocalVars (tupleRates t) (fromTuple t)
+
+-- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
-- It contains control signals (k-rate) and constants for numbers (i-rates).
newCtrlRef :: Tuple a => a -> SE (Ref a)
-newCtrlRef t = fmap Ref $ newLocalVars (fmap toCtrlRate $ tupleRates t) (fromTuple t)
-
-toCtrlRate x = case x of
+newCtrlRef t = fmap Ref $ newLocalVars (fmap toCtrlRate $ tupleRates t) (fromTuple t)
+
+toCtrlRate x = case x of
Ar -> Kr
Kr -> Ir
_ -> x
@@ -79,7 +79,7 @@ mixRef ref asig = modifyRef ref (+ asig)
-- | Modifies the Ref value with given function.
modifyRef :: Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef ref f = do
- v <- readRef ref
+ v <- readRef ref
writeRef ref (f v)
-- | An alias for the function @newRef@. It returns not the reference
@@ -89,16 +89,16 @@ sensorsSE a = do
ref <- newRef a
return $ (readRef ref, writeRef ref)
--- | Allocates a new global mutable value and initializes it with value.
+-- | Allocates a new global mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
newGlobalRef :: Tuple a => a -> SE (Ref a)
-newGlobalRef t = fmap Ref $ newGlobalVars (tupleRates t) (fromTuple t)
+newGlobalRef t = fmap Ref $ newGlobalVars (tupleRates t) (fromTuple t)
--- | Allocates a new global mutable value and initializes it with value.
+-- | Allocates a new global mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
-- It contains control signals (k-rate) and constants for numbers (i-rates).
newGlobalCtrlRef :: Tuple a => a -> SE (Ref a)
-newGlobalCtrlRef t = fmap Ref $ newGlobalVars (fmap toCtrlRate $ tupleRates t) (fromTuple t)
+newGlobalCtrlRef t = fmap Ref $ newGlobalVars (fmap toCtrlRate $ tupleRates t) (fromTuple t)
-- | An alias for the function @newRef@. It returns not the reference
-- to mutable value but a pair of reader and writer functions.
@@ -107,12 +107,12 @@ globalSensorsSE a = do
ref <- newRef a
return $ (readRef ref, writeRef ref)
--- | Allocates a new clearable global mutable value and initializes it with value.
+-- | Allocates a new clearable global mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
-- The variable is set to zero at the end of every iteration.
-- It's useful for accumulation of audio values from several instruments.
newClearableGlobalRef :: Tuple a => a -> SE (Ref a)
-newClearableGlobalRef t = fmap Ref $ newClearableGlobalVars (tupleRates t) (fromTuple t)
+newClearableGlobalRef t = fmap Ref $ newClearableGlobalVars (tupleRates t) (fromTuple t)
-------------------------------------------------------------------------------
-- writable tables
@@ -124,18 +124,18 @@ newClearableGlobalRef t = fmap Ref $ newClearableGlobalVars (tupleRates t) (from
newTab :: D -> SE Tab
newTab size = ftgentmp 0 0 size 7 0 [size, 0]
--- | Creates a new global table.
+-- | Creates a new global table.
-- It's generated only once. It's persisted between instrument calls.
--
-- > newGlobalTab identifier size
newGlobalTab :: Int -> SE Tab
-newGlobalTab size = do
+newGlobalTab size = do
ref <- newGlobalCtrlRef ((fromGE $ saveWriteTab size) :: D)
fmap (fromGE . toGE) $ readRef ref
{-
identifier <- geToSe $ getNextGlobalGenId
- ref <- newGlobalRef (0 :: D)
+ ref <- newGlobalRef (0 :: D)
tabId <- ftgenonce 0 (Csound.Typed.Types.Prim.int identifier) size 7 0 [size, 0]
writeRef ref (fromGE $ toGE tabId)
fmap (fromGE . toGE) $ readRef ref
@@ -145,10 +145,10 @@ newGlobalTab size = do
-- some opcodes that I have to define upfront
--- |
+-- |
-- Generate a function table from within an instrument definition, without duplication of data.
--
--- Enables the creation of function tables entirely inside
+-- Enables the creation of function tables entirely inside
-- instrument definitions, without any duplication of data.
--
-- > ifno ftgenonce ip1, ip2dummy, isize, igen, iarga, iargb, ...
@@ -158,7 +158,7 @@ ftgenonce :: D -> D -> D -> D -> D -> [D] -> SE Tab
ftgenonce b1 b2 b3 b4 b5 b6 = fmap ( Tab . return) $ SE $ (depT =<<) $ lift $ f <$> unD b1 <*> unD b2 <*> unD b3 <*> unD b4 <*> unD b5 <*> mapM unD b6
where f a1 a2 a3 a4 a5 a6 = opcs "ftgenonce" [(Ir,(repeat Ir))] ([a1,a2,a3,a4,a5] ++ a6)
--- |
+-- |
-- Generate a score function table from within the orchestra, which is deleted at the end of the note.
--
-- Generate a score function table from within the orchestra,
@@ -175,7 +175,7 @@ ftgentmp b1 b2 b3 b4 b5 b6 = fmap ( Tab . return) $ SE $ (depT =<<) $ lift $ f <
{-
whileSE :: SE BoolSig -> SE () -> SE ()
-whileSE mcond body = do
+whileSE mcond body = do
ref <- newCtrlRef $ (0 :: Sig)
writeCond ref
whileRefBegin ref
@@ -205,8 +205,8 @@ whileRef initVal cond body = do
writeRef refSt =<< body =<< readRef refSt
writeRef refCond =<< condSig =<< readRef refSt
fromDep_ whileEnd
- where
- condSig :: st -> SE Sig
+ where
+ condSig :: st -> SE Sig
condSig = fmap (\b -> ifB b 1 0) . cond
@@ -218,8 +218,8 @@ whileRefD initVal cond body = do
writeRef refSt =<< body =<< readRef refSt
writeRef refCond =<< condSig =<< readRef refSt
fromDep_ whileEnd
- where
- condSig :: st -> SE D
+ where
+ condSig :: st -> SE D
condSig = fmap (\b -> ifB b 1 0) . cond
whileRefBegin :: SigOrD a => Ref a -> SE ()