diff --git a/Vivid/Actions.hs b/Vivid/Actions.hs --- a/Vivid/Actions.hs +++ b/Vivid/Actions.hs @@ -192,8 +192,7 @@ set :: (VividAction m, Subset (InnerVars params) sdArgs, VarList params) => Synth sdArgs -> params -> m () set (Synth nodeId) params = do let (as, _) = makeTypedVarList params - -- HERE: - callOSC $ SCCmd.n_set nodeId [ (k, Right v) | (k, v) <- as ] + callOSC $ SCCmd.n_set nodeId (map (\(k,v)->(k, Right v)) as) -- | Create a real live music-playing synth from a boring, dead SynthDef. -- @@ -256,13 +255,12 @@ makeSynth :: (VividAction m, VarList params, IsNode node) => ByteString -> params -> SCCmd.AddAction -> node -> m NodeId makeSynth theSynthName params addAction (getNodeId -> targetNodeId) = do nodeId <- newNodeId - callOSC $ SCCmd.s_new theSynthName nodeId addAction targetNodeId paramList + callOSC $ SCCmd.s_new theSynthName nodeId addAction targetNodeId (map (\(k,v)->(k,Right v)) paramList) pure nodeId where - -- HERE: - paramList :: [(ByteString, Either Int32 Float)] + paramList :: [(ByteString, Float)] paramList = - [ (UTF8.fromString k, Right v) | (k, v) <- (fst $ makeTypedVarList params) ] + [ (UTF8.fromString k, v) | (k, v) <- (fst $ makeTypedVarList params) ] -- Can dedupe all these!: diff --git a/Vivid/Actions/IO.hs b/Vivid/Actions/IO.hs --- a/Vivid/Actions/IO.hs +++ b/Vivid/Actions/IO.hs @@ -41,7 +41,7 @@ ) where import Vivid.Actions.Class -import Vivid.OSC (OSC(..), OSCDatum(..), encodeOSC, Timestamp(..), utcToTimestamp) +import Vivid.OSC (OSC(..), OSCDatum(..), encodeOSC, Timestamp(..), timestampFromUTC) -- import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SC.Server.Commands as SCCmd import Vivid.SCServer.State (BufferId(..), NodeId(..), SyncId(..), getNextAvailable, scServerState, SCServerState(..)) @@ -88,7 +88,7 @@ wait t = threadDelay $ round (realToFrac (t * 10^(6::Int)) :: Double) getTime :: IO Timestamp - getTime = utcToTimestamp <$> getCurrentTime + getTime = timestampFromUTC <$> getCurrentTime newBufferId :: IO BufferId newBufferId = do diff --git a/Vivid/Actions/NRT.hs b/Vivid/Actions/NRT.hs --- a/Vivid/Actions/NRT.hs +++ b/Vivid/Actions/NRT.hs @@ -7,15 +7,17 @@ -- then make a new synth with the new definition -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE + BangPatterns + , FlexibleInstances + , InstanceSigs + , LambdaCase + , TypeSynonymInstances -{-# LANGUAGE NoIncoherentInstances #-} -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE NoUndecidableInstances #-} + , NoIncoherentInstances + , NoMonomorphismRestriction + , NoUndecidableInstances + #-} module Vivid.Actions.NRT ( NRT -- (..) -- ^ May not be exported in the future @@ -41,11 +43,12 @@ import Control.Applicative -- import Control.Arrow (first, second) +import Control.Exception import Control.Monad import Control.Monad.IO.Class (liftIO) import Control.Monad.State (get, modify, execStateT, StateT) import Data.ByteString (ByteString) -import qualified Data.ByteString as BS (writeFile) +import qualified Data.ByteString as BS (writeFile, hPut) import qualified Data.ByteString.UTF8 as UTF8 import Data.Char (toLower) import Data.Hashable (hash) @@ -53,8 +56,10 @@ import Data.Map (Map) import Data.Monoid import qualified Data.Set as Set +import System.Directory (canonicalizePath, getTemporaryDirectory, removeFile) import System.Exit import System.FilePath (takeExtension) +import System.IO (openBinaryTempFile, hClose) import System.Process (system) import Prelude @@ -146,7 +151,7 @@ -- The file type is detected from its extension. -- The extensions supported at the moment are .aif, .aiff, and .wav -- --- (Mac OS X users will need to make sure 'scsynth' is in their $PATH) +-- (macOS users will need to make sure 'scsynth' is in their $PATH) -- -- (And I apologize, but I really don't know what Windows users will need to do) -- @@ -160,10 +165,11 @@ contents <- encodeOSCBundles <$> runNRT nrtActions -- ${SHELL} + -- Does this work on Windows?: system "/bin/sh -c 'which scsynth > /dev/null'" >>= \case ExitSuccess -> return () ExitFailure _ -> error "No 'scsynth' found! Be sure to put it in your $PATH" - let tempFile = "/tmp/vivid_nrt_" <> (show . hash) contents <> ".osc" + let !fileType = case Map.lookup (map toLower $ takeExtension fPath) extensionMap of Just x -> x @@ -174,12 +180,21 @@ (".aif", "AIFF") , (".aiff", "AIFF") , (".wav", "WAV") - -- todo: these formats seem not to work: + -- todo: these formats seem not to work. + -- Try it on more-recent versions of SC: -- ".flac" -> "FLAC" -- ".ogg" -> "vorbis" ] - BS.writeFile tempFile contents + tempDir <- canonicalizePath =<< getTemporaryDirectory + tempFile <- bracket + (openBinaryTempFile tempDir "vivid_nrt_.osc") + (\(_, tempFileHandle) -> + hClose tempFileHandle) + (\(tempFile, tempFileHandle) -> do + BS.hPut tempFileHandle $ contents + pure tempFile) + ExitSuccess <- system $ mconcat [ -- ${SHELL} "/bin/sh -c " @@ -192,7 +207,11 @@ , show $ _nrtArgs_sampleRate nrtArgs," ", fileType, " int16 " , " \"" ] - return () + + -- TODO: I'm a little skittish about turning this on: + -- removeFile tempFile + + pure () data NRTArgs diff --git a/Vivid/Envelopes.hs b/Vivid/Envelopes.hs --- a/Vivid/Envelopes.hs +++ b/Vivid/Envelopes.hs @@ -3,15 +3,18 @@ {-# OPTIONS_HADDOCK show-extensions #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE + DataKinds + , ExistentialQuantification + , KindSignatures + , LambdaCase -{-# LANGUAGE NoIncoherentInstances #-} -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE NoUndecidableInstances #-} + , NoIncoherentInstances + , NoMonomorphismRestriction + , NoUndecidableInstances -{-# LANGUAGE FlexibleContexts #-} + , FlexibleContexts + #-} module Vivid.Envelopes ( EnvLiterally(..) @@ -129,24 +132,33 @@ curveNumber = shapeNumber envCurveNumber :: EnvCurve -> Float -envCurveNumber Curve_Step = 0 -envCurveNumber Curve_Linear = 1 -envCurveNumber Curve_Lin = 1 -envCurveNumber Curve_Exponential = 2 -envCurveNumber Curve_Exp = 2 -envCurveNumber Curve_Sine = 3 -envCurveNumber Curve_Sin = 3 -envCurveNumber Curve_Welch = 4 -envCurveNumber Curve_Wel = 4 -envCurveNumber Curve_Squared = 6 -envCurveNumber Curve_Sqr = 6 -envCurveNumber Curve_Cubed = 7 -envCurveNumber Curve_Cub = 7 -envCurveNumber (Curve_Curve _) = 5 +envCurveNumber = \case + Curve_Step -> 0 + Curve_Linear -> 1 + Curve_Lin -> 1 + + Curve_Exponential -> 2 + Curve_Exp -> 2 + + Curve_Sine -> 3 + Curve_Sin -> 3 + + Curve_Welch -> 4 + Curve_Wel -> 4 + + Curve_Squared -> 6 + Curve_Sqr -> 6 + + Curve_Cubed -> 7 + Curve_Cub -> 7 + + Curve_Curve _ -> 5 + envCurveFloatNumber :: EnvCurve -> Float -envCurveFloatNumber (Curve_Curve f) = f -envCurveFloatNumber _ = 0 +envCurveFloatNumber = \case + Curve_Curve f -> f + _ -> 0 env :: Float -> [(Float, Float)] -> EnvCurve -> EnvLiterally a diff --git a/Vivid/OSC/Bundles.hs b/Vivid/OSC/Bundles.hs --- a/Vivid/OSC/Bundles.hs +++ b/Vivid/OSC/Bundles.hs @@ -9,13 +9,23 @@ ) where import Vivid.OSC -import Vivid.OSC.Old (encodedOSC_addLength) +-- import Vivid.OSC.Old (encodedOSC_addLength) import qualified Vivid.SC.Server.Commands as SCCmd import Vivid.SC.Server.Types (NodeId(..)) import Data.ByteString (ByteString) import qualified Data.List as L import Data.Monoid + +-- TEMP: +import Data.Word +import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString as BS +import Data.Binary (encode) +encodedOSC_addLength :: ByteString -> ByteString +encodedOSC_addLength bs = + BSL.toStrict (encode (toEnum (BS.length bs) :: Word32)) <> bs + -- | Encode OSC bundles, specifically for NRT synthesis. -- (It's more than just \"mconcat . map 'encodeOSCBundle'\"). diff --git a/Vivid/SCServer.hs b/Vivid/SCServer.hs --- a/Vivid/SCServer.hs +++ b/Vivid/SCServer.hs @@ -30,6 +30,7 @@ , NodeId(..) , Synth(..) , Group(..) + , ParGroup(..) , defaultGroup -- * Buffers @@ -39,6 +40,7 @@ , makeBufferFromFile , newBuffer , newBufferFromFile + , newBufferFromFileBetween , saveBuffer , writeBuffer , writeBufferWith @@ -64,7 +66,7 @@ import Vivid.OSC import Vivid.OSC.Bundles (initTreeCommand) import qualified Vivid.SC.Server.Commands as SCCmd -import Vivid.SC.Server.Types (Group(..)) +import Vivid.SC.Server.Types (Group(..), ParGroup(..)) import qualified Vivid.SC.Server.Commands as SCCmd import Vivid.Actions.Class @@ -113,16 +115,19 @@ -- | Make a buffer and fill it with sound data from a file -- --- The file path should be absolute (not relative), and if you're connecting to --- a non-localhost server don't expect it to be able to read files from your --- hard drive! +-- The file path should be absolute (not relative), and if you're connecting +-- to a non-localhost server don't expect it to be able to read files from +-- your local hard drive! -- --- Note that like "makeBuffer" this is synchronous +-- Note that like 'makeBuffer' this is synchronous newBufferFromFile :: (VividAction m) => FilePath -> m BufferId -newBufferFromFile fPath = do +newBufferFromFile = newBufferFromFileBetween 0 Nothing + +newBufferFromFileBetween :: VividAction m => Int32 -> Maybe Int32 -> FilePath -> m BufferId +newBufferFromFileBetween startTime endTimeMay fPath = do bufId <- newBufferId oscWSync $ \syncId -> callOSC $ - SCCmd.b_allocRead bufId fPath 0 Nothing (Just $ SCCmd.sync syncId) + SCCmd.b_allocRead bufId fPath startTime endTimeMay (Just $ SCCmd.sync syncId) return bufId makeBufferFromFile :: (VividAction m) => FilePath -> m BufferId diff --git a/Vivid/SCServer/Connection.hs b/Vivid/SCServer/Connection.hs --- a/Vivid/SCServer/Connection.hs +++ b/Vivid/SCServer/Connection.hs @@ -73,6 +73,7 @@ -- For example though, if you're running code that uses Vivid in ghci, and -- you ":r", you'll want to disconnect first -- there are processes running -- which can step on the toes of your new instance +-- (TODO: this isn't fully true - I ":r" all the time - what do I mean here?) -- -- Also if you want to change the params of your connection (e.g. to connect -- to a different server), you'll want to disconnect from the other @@ -140,6 +141,7 @@ -- already exist: connectToSCServer :: SCConnectConfig -> IO (Socket, ThreadId) connectToSCServer scConnectConfig = withSocketsDo $ do + let !_ = scServerState let hostName = _scConnectConfig_hostName scConnectConfig port = _scConnectConfig_port scConnectConfig connType = case _scConnectConfig_connProtocol scConnectConfig of @@ -162,7 +164,9 @@ connect s (addrAddress serverAddr) -- accept s - listener <- forkIO $ startMailbox (_scConnectConfig_serverMessageFunction scConnectConfig) s + atomically $ writeTVar (_scServerState_serverMessageFunction scServerState) $ + _scConnectConfig_serverMessageFunction scConnectConfig + listener <- forkIO $ startMailbox s let firstSyncID = toEnum $ numberOfSyncIdsToDrop - 2 _ <- send s $ encodeOSCBundle $ OSCBundle (Timestamp 0) [ Right $ SCCmd.dumpOSC DumpOSC_Parsed @@ -185,17 +189,26 @@ _ <- readMVar =<< getMailboxForSyncId syncId return () -startMailbox :: (OSC -> IO ()) -> Socket -> IO () -startMailbox otherMessageFunction s = forever $ recv {- From -} s 65536 >>= \(msg{- , _ -}) -> - case decodeOSC msg of - Right (OSC "/synced" [OSC_I theSyncId]) -> do - syncBox <- getMailboxForSyncId (SyncId theSyncId) - tryPutMVar syncBox () >>= \case - True -> return () - False -> - putStrLn $ "That's weird: we got the same syncId twice: " ++ show theSyncId - Right x -> otherMessageFunction x - Left e -> putStrLn $ "ERROR DECODING OSC: " ++ show (msg, e) +-- TODO: what's "mailbox" here? Is it like an Erlang mailbox, to receive and +-- dispatch all messages? +startMailbox :: Socket -> IO () +startMailbox s = do + let !_ = scServerState + forever $ recv {- From -} s 65536 >>= \(msg{- , _ -}) -> + case decodeOSC msg of + Right (OSC "/synced" [OSC_I theSyncId]) -> do + syncBox <- getMailboxForSyncId (SyncId theSyncId) + tryPutMVar syncBox () >>= \case + True -> return () + False -> + putStrLn $ + "That's weird!: we got the same syncId twice: " + ++ show theSyncId + Right x -> do + otherMessageFunction <- readTVarIO $ + _scServerState_serverMessageFunction scServerState + otherMessageFunction x + Left e -> putStrLn $ "ERROR DECODING OSC: " ++ show (msg, e) -- | Print all messages other than \"/done\"s defaultMessageFunction :: OSC -> IO () diff --git a/Vivid/SCServer/State.hs b/Vivid/SCServer/State.hs --- a/Vivid/SCServer/State.hs +++ b/Vivid/SCServer/State.hs @@ -87,19 +87,22 @@ numberOfSyncIdsToDrop = 10000 makeEmptySCServerState :: IO SCServerState -makeEmptySCServerState = atomically $ do - sockConnectStarted <- newTVar False - sockIORef <- newEmptyTMVar -- newTVar Nothing -- newIORef Nothing - listenerIORef <- newEmptyTMVar -- newTVar Nothing -- newIORef Nothing +-- We don't do this with 'atomically' because you can't put 'atomically' in +-- 'unsafePerformIO' (or, apparently you can with the "!_ =" hack I was +-- doing, but let's do the recommended way): +makeEmptySCServerState = do -- atomically $ do + sockConnectStarted <- newTVarIO False + sockIORef <- newEmptyTMVarIO -- newTVar Nothing -- newIORef Nothing + listenerIORef <- newEmptyTMVarIO -- newTVar Nothing -- newIORef Nothing - availBufIds <- newTVar $ drop 512 $ map BufferId [0..] + availBufIds <- newTVarIO $ drop 512 $ map BufferId [0..] -- these'll be allocated when we connect (and get a clientId): - availNodeIds <- newTVar $ map (NodeId . ((1 `shiftL` 26) .|.)) [1000..] - maxBufIds <- newTVar 1024 - syncIds <- newTVar $ drop numberOfSyncIdsToDrop $ map SyncId [0..] - syncMailboxes <- newTVar $ Map.empty - serverMessageFunction <- newTVar $ \_ -> return () - definedSDs <- newTVar $ Set.empty + availNodeIds <- newTVarIO $ map (NodeId . ((1 `shiftL` 26) .|.)) [1000..] + maxBufIds <- newTVarIO 1024 + syncIds <- newTVarIO $ drop numberOfSyncIdsToDrop $ map SyncId [0..] + syncMailboxes <- newTVarIO $ Map.empty + serverMessageFunction <- newTVarIO $ \_ -> return () + definedSDs <- newTVarIO $ Set.empty return $ SCServerState { _scServerState_socketConnectStarted = sockConnectStarted diff --git a/Vivid/SynthDef.hs b/Vivid/SynthDef.hs --- a/Vivid/SynthDef.hs +++ b/Vivid/SynthDef.hs @@ -263,7 +263,10 @@ getFreshUGenGraphId :: SDBody' args Int getFreshUGenGraphId = do - (i:ds, synthDef, argList) <- get + (ids, synthDef, argList) <- get + let (i:ds) = case ids of + [] -> error "You got to the end of an infinite list!" + _ -> ids put (ds, synthDef, argList) return i diff --git a/Vivid/SynthDef/ToSig.hs b/Vivid/SynthDef/ToSig.hs --- a/Vivid/SynthDef/ToSig.hs +++ b/Vivid/SynthDef/ToSig.hs @@ -50,10 +50,7 @@ instance ToSig Double args where toSig = pure . Constant . realToFrac --- HERE: instance ToSig Float args where - toSig = pure . Constant -instance ToSig Int args where toSig = pure . Constant . realToFrac #else diff --git a/Vivid/SynthDef/TypesafeArgs.hs b/Vivid/SynthDef/TypesafeArgs.hs --- a/Vivid/SynthDef/TypesafeArgs.hs +++ b/Vivid/SynthDef/TypesafeArgs.hs @@ -2,27 +2,36 @@ {-# LANGUAGE NoIncoherentInstances #-} -- {-# LANGUAGE ConstraintKinds -} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -- {-# LANGUAGE GADTSyntax, NoMonoLocalBinds #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PolyKinds #-} -- {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-} -{-# LANGUAGE TypeOperators #-} --- Needed for a nested type family instance: -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE + DataKinds + , ExistentialQuantification + , FlexibleContexts + , FlexibleInstances + , FunctionalDependencies + , InstanceSigs + , LambdaCase + , MultiParamTypeClasses + , PolyKinds + , ScopedTypeVariables + , StandaloneDeriving + , TypeFamilies, NoMonoLocalBinds + , TypeOperators + , UndecidableInstances + , ViewPatterns + + , DefaultSignatures + , FlexibleContexts + , StandaloneDeriving + , TypeOperators + #-} + {-# LANGUAGE NoMonomorphismRestriction #-} +-- UndecidableInstances is needed for a nested type family instance ^ + module Vivid.SynthDef.TypesafeArgs ( -- * Type Set Operations @@ -64,6 +73,7 @@ import Control.Arrow (first, second) import GHC.Exts +import GHC.Generics import GHC.TypeLits import qualified Data.Map as Map import Data.Proxy @@ -151,7 +161,9 @@ -- >> SetEqual '["bye","hi","bye","bye"] '["bye","hi","hi"] :: Bool -- >> = 'True type family SetEqual (a :: [x]) (b :: [x]) :: Bool where - SetEqual a b = SubsetBoolToBool (IsSubsetOf a b) && SubsetBoolToBool (IsSubsetOf b a) + SetEqual a b = + SubsetBoolToBool (IsSubsetOf a b) + && SubsetBoolToBool (IsSubsetOf b a) data Variable (a :: Symbol) = @@ -190,7 +202,7 @@ "(VarSet::VarSet "++show (getSymbolVals argSet)++")" addVarToSet :: Variable sym -> VarSet syms -> VarSet (sym ': syms) -addVarToSet _ _ = VarSet +addVarToSet V VarSet = VarSet emptyVarSet :: VarSet '[] emptyVarSet = VarSet @@ -295,6 +307,11 @@ type InnerVars from :: [Symbol] makeTypedVarList :: from -> TypedVarList (InnerVars from) +{- + default makeTypedVarList :: (Generic from) => from -> TypedVarList (InnerVars from) + makeTypedVarList = undefined +-} + infixl `AddParams` class TagList from where @@ -676,8 +693,8 @@ (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e, KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j, KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o - ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s,KnownSymbol t - ,KnownSymbol u,KnownSymbol v,KnownSymbol w,KnownSymbol x,KnownSymbol y + ,KnownSymbol p, KnownSymbol q, KnownSymbol r, KnownSymbol s, KnownSymbol t + ,KnownSymbol u, KnownSymbol v, KnownSymbol w, KnownSymbol x, KnownSymbol y ) => VarList (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v,I w,I x,I y) @@ -689,11 +706,11 @@ instance - (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e, - KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j, - KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o - ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s,KnownSymbol t - ,KnownSymbol u,KnownSymbol v,KnownSymbol w,KnownSymbol x,KnownSymbol y + (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e + ,KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j + ,KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o + ,KnownSymbol p, KnownSymbol q, KnownSymbol r, KnownSymbol s, KnownSymbol t + ,KnownSymbol u, KnownSymbol v, KnownSymbol w, KnownSymbol x, KnownSymbol y ,KnownSymbol z ) => VarList diff --git a/Vivid/UGens/Analysis.hs b/Vivid/UGens/Analysis.hs --- a/Vivid/UGens/Analysis.hs +++ b/Vivid/UGens/Analysis.hs @@ -10,7 +10,7 @@ ampComp --- , ampCompA ---- , amplitude + , amplitude --- , detectSilence --- , loudness --- , peak @@ -63,8 +63,13 @@ --- ampCompA :: --- ampCompA = ---- amplitude :: ---- amplitude = + +amplitude :: Args '["in"] '["attackSecs", "releaseSecs"] a => a -> SDBody a Signal +amplitude = makeUGen + "Amplitude" AR + (Vs::Vs '["in", "attackSecs", "releaseSecs"]) + (attackSecs_ (0.01::Float), releaseSecs_ (0.01::Float)) + --- detectSilence :: --- detectSilence = --- loudness :: diff --git a/Vivid/UGens/Args.hs b/Vivid/UGens/Args.hs --- a/Vivid/UGens/Args.hs +++ b/Vivid/UGens/Args.hs @@ -168,6 +168,9 @@ damp_ :: ToSig s as => s -> UA "damp" as damp_ = UA . toSig +damping_ :: ToSig s as => s -> UA "damping" as +damping_ = UA . toSig + db_ :: ToSig s as => s -> UA "db" as db_ = UA . toSig @@ -221,6 +224,11 @@ downSample_ :: ToSig s as => s -> UA "downSample" as downSample_ = UA . toSig +dryLevel_, drylevel_ :: ToSig s as => s -> UA "dryLevel" as +dryLevel_ = UA . toSig + +drylevel_ = dryLevel_ + dsthi_ :: ToSig s as => s -> UA "dsthi" as dsthi_ = UA . toSig @@ -234,6 +242,11 @@ duration_ :: ToSig s as => s -> UA "duration" as duration_ = UA . toSig +earlyRefLevel_, earlyreflevel_ :: ToSig s as => s -> UA "earlyRefLevel" as +earlyRefLevel_ = UA . toSig + +earlyreflevel_ = earlyRefLevel_ + end_ :: ToSig s as => s -> UA "end" as end_ = UA . toSig @@ -303,6 +316,11 @@ initFreq_ :: ToSig s as => s -> UA "initFreq" as initFreq_ = UA . toSig +inputBW_, inputbw_ :: ToSig s as => s -> UA "inputBW" as +inputBW_ = UA . toSig + +inputbw_ = inputBW_ + integrate_ :: ToSig s as => s -> UA "integrate" as integrate_ = UA . toSig @@ -373,6 +391,11 @@ maxFreq_ :: ToSig s as => s -> UA "maxFreq" as maxFreq_ = UA . toSig +maxRoomSize_, maxroomsize_ :: ToSig s as => s -> UA "maxRoomSize" as +maxRoomSize_ = UA . toSig + +maxroomsize_ = maxRoomSize_ + -- | Alias of 'max_', for SC compatibility maxVal_ :: ToSig s as => s -> UA "max" as maxVal_ = UA . toSig @@ -477,9 +500,22 @@ resetPos_ :: ToSig s as => s -> UA "resetPos" as resetPos_ = UA . toSig +revTime_, revtime_ :: ToSig s as => s -> UA "revTime" as +revTime_ = UA . toSig + +-- | Alias, for compatibility +revtime_ = revTime_ + room_ :: ToSig s as => s -> UA "room" as room_ = UA . toSig +roomSize_ :: ToSig s as => s -> UA "roomSize" as +roomSize_ = UA . toSig + +-- | Alias, for compatibility +roomsize_ :: ToSig s as => s -> UA "roomSize" as +roomsize_ = roomSize_ + root_ :: ToSig s as => s -> UA "root" as root_ = UA . toSig @@ -507,6 +543,9 @@ slopeBelow_ :: ToSig s as => s -> UA "slopeBelow" as slopeBelow_ = UA . toSig +spread_ :: ToSig s as => s -> UA "spread" as +spread_ = UA . toSig + spring_ :: ToSig s as => s -> UA "spring" as spring_ = UA . toSig @@ -533,6 +572,11 @@ syncFreq_ :: ToSig s as => s -> UA "syncFreq" as syncFreq_ = UA . toSig + +tailLevel_, taillevel_ :: ToSig s as => s -> UA "tailLevel" as +tailLevel_ = UA . toSig + +taillevel_ = tailLevel_ threshold_ :: ToSig s as => s -> UA "threshold" as threshold_ = UA . toSig diff --git a/Vivid/UGens/Buffer.hs b/Vivid/UGens/Buffer.hs --- a/Vivid/UGens/Buffer.hs +++ b/Vivid/UGens/Buffer.hs @@ -88,6 +88,7 @@ ,loop_ ((0)::Float), doneAction_ ((2)::Float)) where -- TODO: maybe don't want to do this. especially cause if you set the rate it doesn't multiply by this + -- alternative is to change 'rate_' to 'bufrate_' and have that 'arg' function do a multiply -- update docs too: -- todo : put bufratescale on all of em if we decide to keep this behavior defaultRate = bufRateScale $ uaArgVal args (V::V "buf") diff --git a/Vivid/UGens/Envelopes.hs b/Vivid/UGens/Envelopes.hs --- a/Vivid/UGens/Envelopes.hs +++ b/Vivid/UGens/Envelopes.hs @@ -1,18 +1,20 @@ -- | **Note:** The argument format for these is a little -- rough, and is likely to change in the future -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE + DataKinds + , LambdaCase + , OverloadedStrings + , ScopedTypeVariables + , TypeFamilies, NoMonoLocalBinds + , ViewPatterns -{-# LANGUAGE FlexibleContexts #-} + , FlexibleContexts -{-# LANGUAGE NoIncoherentInstances #-} -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE NoUndecidableInstances #-} + , NoIncoherentInstances + , NoMonomorphismRestriction + , NoUndecidableInstances + #-} module Vivid.UGens.Envelopes ( -- In UGens.Filters.Linear: diff --git a/Vivid/UGens/Examples.hs b/Vivid/UGens/Examples.hs --- a/Vivid/UGens/Examples.hs +++ b/Vivid/UGens/Examples.hs @@ -1,6 +1,4 @@ {-# LANGUAGE DataKinds #-} --- HERE: -{-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} @@ -12,8 +10,7 @@ import Vivid.SC.SynthDef.Types -- | 'Dbrown' example from the SC help file --- HERE: -dbrown_example :: SDBody' a [Signal] +dbrown_example :: SDBody' args [Signal] dbrown_example = do mx <- mouseX (min_ 1, max_ 40, warp_ 1) imp <- impulse (freq_ mx) ? KR diff --git a/Vivid/UGens/Reverbs.hs b/Vivid/UGens/Reverbs.hs --- a/Vivid/UGens/Reverbs.hs +++ b/Vivid/UGens/Reverbs.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoIncoherentInstances #-} @@ -8,7 +9,7 @@ module Vivid.UGens.Reverbs ( freeVerb --- , freeVerb2 ---- , gVerb + , gVerb ) where import Vivid.SC.SynthDef.Types (CalculationRate(..)) @@ -26,6 +27,18 @@ --- freeVerb2 :: --- freeVerb2 = --- | there are known issues with this! look in scide: ---- gVerb :: ---- gVerb = +-- | Note this is specifically a two-channel UGen +-- +-- There are known issues with this! (From SC:) +-- +-- - \"There is a large CPU spike when the synth is instantiated while all the delay lines are zeroed out.\" +-- - \"Quick changes in roomsize result in zipper noise.\" +-- - \"Changing the roomsize does not work properly! Still trying to look for the bug... (-josh)\" +-- +-- Since: vivid-0.4.1 +gVerb :: Args '["in"] '["roomSize", "revTime", "damping", "inputBW", "spread", "dryLevel", "earlyRefLevel", "tailLevel", "maxRoomSize"] a => a -> SDBody a [Signal] +gVerb = makePolyUGen 2 + "GVerb" AR + (Vs::Vs '["in", "roomSize", "revTime", "damping", "inputBW", "spread", "dryLevel", "earlyRefLevel", "tailLevel", "maxRoomSize"]) + (roomSize_ (10::Float), revTime_ (3::Float), damping_ (0.5::Float), inputBW_ (0.5::Float), spread_ (15::Float), dryLevel_ (1::Float), earlyRefLevel_ (0.7::Float), tailLevel_ (0.5::Float), maxRoomSize_ (300::Float)) + diff --git a/vivid.cabal b/vivid.cabal --- a/vivid.cabal +++ b/vivid.cabal @@ -1,5 +1,7 @@ +-- TODO: get the readme change from the github merge + name: vivid -version: 0.3.0.2 +version: 0.4.2.0 synopsis: Sound synthesis with SuperCollider description: Music and sound synthesis with SuperCollider. @@ -12,11 +14,7 @@ . > import Vivid > - > theSound = sd (0 ::I "note") $ do - > wobble <- sinOsc (freq_ 5) ? KR ~* 10 ~+ 10 - > s <- 0.1 ~* sinOsc (freq_ $ midiCPS (V::V "note") ~+ wobble) - > out 0 [s,s] - > + > playSong :: VividAction m => m () > playSong = do > fork $ do > s0 <- synth theSound (36 ::I "note") @@ -29,6 +27,13 @@ > wait (1/4) > free s1 > + > theSound :: SynthDef '["note"] + > theSound = sd (0 ::I "note") $ do + > wobble <- sinOsc (freq_ 5) ? KR ~* 10 ~+ 10 + > s <- 0.1 ~* sinOsc (freq_ $ midiCPS (V::V "note") ~+ wobble) + > out 0 [s,s] + > + > main :: IO () > main = do > putStrLn "Simplest:" > playSong @@ -40,7 +45,7 @@ > putStrLn "Written to a file, non-realtime synthesis:" > putStrLn "(Need to quit the running server for NRT)" > quitSCServer - > writeNRT "/tmp/song.wav" playSong + > writeNRT "song.wav" playSong author: Tom Murphy maintainer: Tom Murphy category: Audio, Music, Sound @@ -117,6 +122,9 @@ -- Auto bounds from 'cabal init': base > 3 && < 5 + -- TEMP: + , binary + -- Lower bound: -- Just a guess -- 0.5.0.2 is >5 years old -- I don't have a reason to think it needs a lower bound @@ -125,9 +133,6 @@ -- 0.9 doesn't exist yet -- Try: "> 0.5.0.2 && < 0.9" - -- todo: maybe remove?: - -- , binary - -- Lower bound: -- Just a guess -- 0.9.1.8 is >5 years old -- I don't have a reason to think it needs a lower bound @@ -145,8 +150,6 @@ -- 0.6 doesn't exist yet -- Try: "> 0.4.0.0 && < 0.6" - -- , cereal - , containers , directory @@ -261,8 +264,8 @@ , utf8-string -- Pinned to vivid's version: - , vivid-osc == 0.3.* - , vivid-supercollider == 0.3.* + , vivid-osc >= 0.4 && < 0.6 + , vivid-supercollider == 0.4.* -- TODO: constraint solver iterations only for the GHC that needs it ghc-options: