vivid 0.4.2.4 → 0.5.0.0

raw patch · 31 files changed

+900/−452 lines, 31 filesdep +cerealPVP ok

version bump matches the API change (PVP)

Dependencies added: cereal

API changes (from Hackage documentation)

Files

• Vivid.hs +5/−2
• Vivid/Actions.hs +16/−13
• Vivid/Actions/Class.hs +4/−4
• Vivid/Actions/IO.hs +56/−50
• Vivid/Actions/NRT.hs +99/−35
• Vivid/Actions/Scheduled.hs +32/−25
• Vivid/Envelopes.hs +1/−1
• Vivid/GlobalState.hs +155/−0
• Vivid/NoGlobalState.hs +5/−0
• Vivid/NoPlugins.hs +2/−80
• Vivid/NoPluginsNoGlobalState.hs +83/−0
• Vivid/OSC/Bundles.hs +5/−2
• Vivid/SCServer.hs +6/−7
• Vivid/SCServer/Connection.hs +140/−85
• Vivid/SCServer/State.hs +44/−35
• Vivid/SCServer/Types.hs +4/−3
• Vivid/SynthDef.hs +49/−20
• Vivid/SynthDef/ToSig.hs +22/−8
• Vivid/SynthDef/Types.hs +6/−4
• Vivid/UGens.hs +1/−1
• Vivid/UGens/Analysis.hs +2/−0
• Vivid/UGens/Args.hs +38/−14
• Vivid/UGens/Buffer.hs +35/−13
• Vivid/UGens/Envelopes.hs +4/−2
• Vivid/UGens/FFT.hs +40/−23
• Vivid/UGens/Filters/Linear.hs +22/−12
• Vivid/UGens/Generators/Deterministic.hs +9/−5
• Vivid/UGens/Info.hs +5/−3
• Vivid/UGens/Maths.hs +2/−2
• Vivid/UGens/Reverbs.hs +1/−0
• vivid.cabal +7/−3

@@ -1,7 +1,10 @@ {-# LANGUAGE NoMonomorphismRestriction #-}  module Vivid (-     module Vivid.NoPlugins+     module Vivid.NoPluginsNoGlobalState+   , module Vivid.GlobalState    ) where -import Vivid.NoPlugins+import Vivid.NoPluginsNoGlobalState+import Vivid.GlobalState+

@@ -5,9 +5,12 @@ --        The timing is precise, unlike IO --   - "Vivid.Actions.NRT" : non-realtime. Writes to an audio file -{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE+     DataKinds+   , OverloadedStrings+   , ViewPatterns+   #-}+   -- , Safe  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -50,36 +53,36 @@    , release    , releaseIn    , freeBuf-   , quitSCServer+   , quitSCServerWith    , module Vivid.Actions.Class    -- , module Vivid.Actions.IO    , module Vivid.Actions.NRT    , module Vivid.Actions.Scheduled     , makeSynth++   , MonoOrPoly -- TODO: export?    ) where  import Vivid.OSC import qualified Vivid.SC.Server.Commands as SCCmd import Vivid.SC.Server.Types import Vivid.SC.SynthDef.Types (CalculationRate(..))-import Vivid.SC.Server.Types  import Vivid.Actions.Class import Vivid.Actions.IO () import Vivid.Actions.NRT import Vivid.Actions.Scheduled-import Vivid.SCServer.Connection (closeSCServerConnection)-import Vivid.SCServer (defaultGroup)+import Vivid.SCServer (defaultGroup, SCServerState)+import Vivid.SCServer.Connection (closeSCServerConnection') import Vivid.SCServer.Types import Vivid.SynthDef (getSDHashName, sd {- , SDBody -}) -- SynthDef(..), SDBody, Signal) -- import Vivid.SynthDef.Types (SDName(..)) import Vivid.SynthDef.TypesafeArgs -import Control.Arrow (first) -- , second)+import Control.Monad.Reader (runReaderT) import qualified Data.ByteString.UTF8 as UTF8 import Data.ByteString (ByteString)-import Data.Int import Data.Monoid  -- for "play":@@ -309,10 +312,10 @@ synthAfter = newSynthAfter  -- | Stop the SuperCollider server-quitSCServer :: IO ()-quitSCServer = do-   callOSC $ SCCmd.quit-   closeSCServerConnection+quitSCServerWith :: SCServerState -> IO ()+quitSCServerWith serverState = do+   runReaderT (callOSC SCCmd.quit) serverState+   closeSCServerConnection' serverState  -- | Synchronous freeBuf :: VividAction m => BufferId -> m ()

@@ -5,8 +5,10 @@ --   upcoming versions (as early as the next release) - so don't get used --   to it! -{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE+     KindSignatures+   , Rank2Types+   #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -27,8 +29,6 @@  import Control.Monad.IO.Class (MonadIO) import Data.ByteString (ByteString)-import qualified Data.ByteString.UTF8 as UTF8-import Data.Int  class (Monad m , MonadIO m) => VividAction (m :: * -> *) where 

@@ -25,32 +25,35 @@ --  --   > playScheduledIn 0.01 playTone -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE+     BangPatterns+   , InstanceSigs+   , FlexibleInstances+   , OverloadedStrings+   , TypeSynonymInstances+   , ViewPatterns+   #-}+   -- , Safe  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoUndecidableInstances #-}  module Vivid.Actions.IO (-     defineSDFromFile+     defineSDFromFileWith    ) where  import Vivid.Actions.Class-import Vivid.OSC (OSC(..), OSCDatum(..), encodeOSC, Timestamp(..), timestampFromUTC)--- import Vivid.SC.SynthDef.Types (CalculationRate(..))+import Vivid.OSC (OSC(..), encodeOSC, Timestamp(..), timestampFromUTC) import Vivid.SC.Server.Commands as SCCmd-import Vivid.SCServer.State (BufferId(..), NodeId(..), SyncId(..), getNextAvailable, scServerState, SCServerState(..))-import Vivid.SCServer.Connection ({-getMailboxForSyncId,-} getSCServerSocket, waitForSync_io)+import Vivid.SCServer.State (BufferId(..), NodeId(..), SyncId(..), getNextAvailable', SCServerState(..))+import Vivid.SCServer.Connection ({-getMailboxForSyncId,-} getSCServerSocket', waitForSync_io', sendMaybePad) import Vivid.SynthDef  import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.STM (readTVarIO, atomically, modifyTVar) import Control.Monad+import Control.Monad.Trans.Reader (ReaderT(..), runReaderT) import Data.ByteString (ByteString) import qualified Data.ByteString as BS (writeFile) import Data.Hashable@@ -58,22 +61,18 @@ import Data.Time (getCurrentTime) import System.Directory (getTemporaryDirectory) -import Network.Socket (withSocketsDo) -- We add this everywhere for Windows compat-import Network.Socket.ByteString (send)--instance VividAction IO where-   callOSC :: OSC -> IO ()+instance VividAction (ReaderT SCServerState IO) where+   callOSC :: OSC -> ReaderT SCServerState IO ()    callOSC message = callBS (encodeOSC message) -   callBS :: ByteString -> IO ()-   callBS message = do-      let !_ = scServerState-      sock <- getSCServerSocket-      -- TODO: if TCP, prefix with the length ("## int - the length in bytes of the following message.") from Server-Architecture.schelp-      _ <- withSocketsDo $ send sock message+   callBS :: ByteString -> ReaderT SCServerState IO ()+   callBS bs = ReaderT $ \serverState -> do+      sock <- getSCServerSocket' serverState+      connProtocol <- readTVarIO (_scServerState_connProtocol serverState)+      _ <- sendMaybePad connProtocol sock bs       return () -   sync :: IO ()+   sync :: ReaderT SCServerState IO ()    sync = do       wait (0.01 :: Float) -- Just to make sure you don't "sync" before calling                            --   the command you want to sync (temporary)@@ -81,51 +80,58 @@       callOSC $ SCCmd.sync sid       waitForSync sid -   waitForSync :: SyncId -> IO ()-   waitForSync = waitForSync_io+   waitForSync :: SyncId -> ReaderT SCServerState IO ()+   waitForSync syncId =+      ReaderT $ \serverState ->+         waitForSync_io' serverState syncId -   wait :: Real n => n -> IO ()-   wait t = threadDelay $ round (realToFrac (t * 10^(6::Int)) :: Double)+   wait :: Real n => n -> ReaderT SCServerState IO ()+   wait t = ReaderT $ \_ ->+      threadDelay $ round (realToFrac (t * 10^(6::Int)) :: Double) -   getTime :: IO Timestamp-   getTime = timestampFromUTC <$> getCurrentTime+   getTime :: ReaderT SCServerState IO Timestamp+   getTime = ReaderT $ \_ -> timestampFromUTC <$> getCurrentTime -   newBufferId :: IO BufferId-   newBufferId = do-      maxBufIds <- readTVarIO (_scServerState_maxBufIds scServerState)-      BufferId nn <- getNextAvailable _scServerState_availableBufferIds+   newBufferId :: ReaderT SCServerState IO BufferId+   newBufferId = ReaderT $ \serverState -> do+      maxBufIds <- readTVarIO (_scServerState_maxBufIds serverState)+      BufferId nn <- getNextAvailable' serverState _scServerState_availableBufferIds+      -- TODO: this 'mod' may not help anything:       return . BufferId $ nn `mod` maxBufIds -   newNodeId :: IO NodeId-   newNodeId = getNextAvailable _scServerState_availableNodeIds+   newNodeId :: ReaderT SCServerState IO NodeId+   newNodeId = ReaderT $ \serverState ->+      getNextAvailable' serverState _scServerState_availableNodeIds -   newSyncId :: IO SyncId-   newSyncId =-      getNextAvailable _scServerState_availableSyncIds+   newSyncId :: ReaderT SCServerState IO SyncId+   newSyncId = ReaderT $ \serverState ->+      getNextAvailable' serverState _scServerState_availableSyncIds -   fork :: IO () -> IO ()-   fork action = do-      _ <- forkIO action+   fork :: ReaderT SCServerState IO () -> ReaderT SCServerState IO ()+   fork action = ReaderT $ \serverState -> do+      _ <- forkIO (runReaderT action serverState)       return () -   defineSD :: SynthDef a -> IO ()-   defineSD synthDef@(SynthDef name _ _) = do-      let !_ = scServerState+   defineSD :: SynthDef a -> ReaderT SCServerState IO ()+   defineSD synthDef@(SynthDef name _ _) = ReaderT $ \serverState -> do       hasBeenDefined <- (((name, hash synthDef) `Set.member`) <$>) $-         readTVarIO (_scServerState_definedSDs scServerState)+         readTVarIO (_scServerState_definedSDs serverState)+      -- unless hasBeenDefined $ (`runReaderT` serverState) $ do+      -- unless hasBeenDefined $ (serverState runReaderT ) $ do       unless hasBeenDefined $ do-         oscWSync $ \syncId ->+         (`runReaderT` serverState) $ oscWSync $ \syncId ->             callOSC $                SCCmd.d_recv [sdToLiteral synthDef] (Just $ SCCmd.sync syncId)-         atomically $ modifyTVar (_scServerState_definedSDs scServerState) $+         atomically $ modifyTVar (_scServerState_definedSDs serverState) $             ((name, hash synthDef) `Set.insert`) +-- This could be written as ReaderT SCServerState: -- | Synchronous-defineSDFromFile :: SynthDef a -> IO ()-defineSDFromFile theSD = do+defineSDFromFileWith :: SCServerState -> SynthDef a -> IO ()+defineSDFromFileWith serverState theSD = do    tempDir <- getTemporaryDirectory    let fName = tempDir++"/" ++ show (hash theSD) ++ ".scsyndef"    BS.writeFile fName $ encodeSD theSD-   oscWSync $ \syncId ->+   (`runReaderT` serverState) $ oscWSync $ \syncId ->       callOSC $ SCCmd.d_load fName (Just $ SCCmd.sync syncId) 

@@ -23,6 +23,7 @@      NRT -- (..) -- ^ May not be exported in the future    , writeNRT    , writeNRTScore+   , encodeNRTScore    , runNRT     , writeNRTWith@@ -33,50 +34,64 @@ import qualified Vivid.SC.Server.Commands as SCCmd  import Vivid.Actions.Class-import Vivid.Actions.IO () -- maybe not in the future import Vivid.OSC import Vivid.OSC.Bundles (encodeOSCBundles) import Vivid.SCServer -- import Vivid.SCServer.State-import Vivid.SynthDef (encodeSD, sdToLiteral)+import Vivid.SynthDef (sdToLiteral) import Vivid.SynthDef.Types  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 Control.Monad.State (get, modify, execStateT, StateT, state) import Data.ByteString (ByteString) import qualified Data.ByteString as BS (writeFile, hPut)-import qualified Data.ByteString.UTF8 as UTF8 import Data.Char (toLower)-import Data.Hashable (hash) import qualified Data.Map as Map import Data.Map (Map) import Data.Monoid import qualified Data.Set as Set-import System.Directory (canonicalizePath, getTemporaryDirectory, removeFile)+import System.Directory (canonicalizePath, getTemporaryDirectory) -- , removeFile) import System.Exit import System.FilePath (takeExtension) import System.IO (openBinaryTempFile, hClose) import System.Process (system) import Prelude --- We keep track of the maximum timestamp so that the generated audio file doesn't cut off before a final 'wait' finishes:-type NRT = StateT (Timestamp, Maximum Timestamp, Map Timestamp [Either ByteString OSC]) IO+data NRTState+   = NRTState {+     nrtState_now :: Timestamp+     -- We keep track of the maximum timestamp so that the generated audio file+     --   doesn't cut off before a final 'wait' finishes:+   , nrtState_maxTime :: Maximum Timestamp+   , nrtState_messages :: Map Timestamp [Either ByteString OSC]+   , nrtState_bufferIds :: [BufferId]+   , nrtState_nodeIds :: [NodeId]+   , nrtState_syncIds :: [SyncId]+   } +type NRT = StateT NRTState IO++callMessage :: Either ByteString OSC -> NRT ()+callMessage msg = do+   now <- getTime+   -- Writing it this way so that we can be crystal-clear that it's going on+   --   the end of the list (future: use dlist for efficiency):+   modify $ \ns -> ns {+        nrtState_messages =+           case Map.lookup now $ nrtState_messages ns of+              Nothing ->   Map.insert now [msg]           $ nrtState_messages ns+              Just msgs -> Map.insert now (msgs ++ [msg]) $ nrtState_messages ns+      }+ instance VividAction NRT where    callOSC :: OSC -> NRT ()-   callOSC message = do-      now <- getTime-      modify ((\f (a,b,c)->(a,b,f c)) (Map.insertWith (<>) now [Right message]))+   callOSC = callMessage . Right     callBS :: ByteString -> NRT ()-   callBS message = do-      now <- getTime-      modify $ \(a,b,x) ->-         (a, b, Map.insertWith (<>) now [Left message] x)+   callBS = callMessage . Left     sync :: NRT ()    sync = return ()@@ -85,35 +100,50 @@    waitForSync _ = return ()     wait :: Real n => n -> NRT ()-   wait t = modify $ \(oldT, maxT, c) ->-      let newT = oldT `addSecs` realToFrac t-      in (newT, Maximum newT `max` maxT, c)+   wait t = modify $ \ns ->+      let newT = nrtState_now ns `addSecs` realToFrac t+      in ns {+            nrtState_now = newT+          , nrtState_maxTime = Maximum newT `max` (nrtState_maxTime ns)+          }     getTime :: NRT Timestamp-   getTime = (\(t,_,_) -> t) <$> get+   getTime = nrtState_now <$> get     newBufferId :: NRT BufferId-   newBufferId = liftIO newBufferId+   newBufferId = state $ \ns ->+      let (x:xs) = nrtState_bufferIds ns+      in (x, ns { nrtState_bufferIds = xs})     newNodeId :: NRT NodeId-   newNodeId = liftIO newNodeId+   newNodeId = state $ \ns ->+      let (x:xs) = nrtState_nodeIds ns+      in (x, ns { nrtState_nodeIds = xs})     newSyncId :: NRT SyncId-   newSyncId = liftIO newSyncId+   newSyncId =  state $ \ns ->+      let (x:xs) = nrtState_syncIds ns+      in (x, ns { nrtState_syncIds = xs})     fork :: NRT () -> NRT ()    fork action = do-      (timeOfFork, oldMaxTime, _) <- get+      NRTState{nrtState_now=timeOfFork, nrtState_maxTime = oldMaxTime} <- get       action-      modify $ \(_timeAfterFork_ignore, newMaxTime, c) ->+      modify $ \ns -> ns {+           nrtState_now = timeOfFork            -- this 'max' probably isn't necessary:-         (timeOfFork, newMaxTime `max` oldMaxTime :: Maximum Timestamp, c)+         , nrtState_maxTime = (nrtState_maxTime ns) `max` oldMaxTime :: Maximum Timestamp+         }     defineSD :: SynthDef a -> NRT ()    defineSD synthDef = do-      modify . (\f (a,b,c)->(a,b,f c)) $ Map.insertWith mappendIfNeeded (Timestamp 0) [-           Right $ SCCmd.d_recv [sdToLiteral synthDef] Nothing-         ]+      modify $ \ns -> ns {+           nrtState_messages =+              let cmd = [+                     Right $ SCCmd.d_recv [sdToLiteral synthDef] Nothing+                   ]+              in Map.insertWith mappendIfNeeded (Timestamp 0) cmd (nrtState_messages ns)+         }     where       mappendIfNeeded :: (Ord a) {- , Monoid m)-} => [a] -> [a] -> [a]       mappendIfNeeded maybeSubset maybeSuperset =@@ -121,14 +151,47 @@             then maybeSuperset             else maybeSubset <> maybeSuperset +-- This way we can be positive that it's going to the end of the list:+_addAtTime :: Timestamp -> Either ByteString OSC -> Map Timestamp [Either ByteString OSC] -> Map Timestamp [Either ByteString OSC]+_addAtTime t msg m =+   -- Separating lookup and insert is just being extra careful that the message+   --   goes on the end:+   --   (Why do you want that? - Well, one example is if you read a buffer in+   --   at time 0 and then immediately play it. You want to read it *before*+   --   you play it :) )+   Map.insert t v m+ where+   v :: [Either ByteString OSC]+   v = case Map.lookup t m of+      Nothing -> [msg]+      Just l -> l ++ [msg] -- Could use a dlist here to snoc++ runNRT :: NRT a -> IO [OSCBundle] runNRT action = do-   (_, Maximum maxTSeen, protoBundles_woLast)-      <- execStateT action (Timestamp 0, Maximum (Timestamp 0), Map.empty)-   let protoBundles = Map.insertWith (<>) maxTSeen [] protoBundles_woLast+   result <- execStateT action startingNRTState++   let Maximum maxTSeen = nrtState_maxTime result+       protoBundles_woLast :: Map Timestamp [Either ByteString OSC]+       protoBundles_woLast = nrtState_messages result+       protoBundles = Map.insertWith (<>) maxTSeen [] protoBundles_woLast+    return [ OSCBundle t as | (t, as) <- Map.toAscList protoBundles ] +startingNRTState :: NRTState+startingNRTState = NRTState {+     nrtState_now = Timestamp 0+   , nrtState_maxTime = Maximum (Timestamp 0)+   , nrtState_messages = Map.empty+   , nrtState_bufferIds = map BufferId [0..]+   , nrtState_nodeIds = map NodeId [2..] -- TODO: make sure this is good+   , nrtState_syncIds = map SyncId [0..]+   } +encodeNRTScore :: NRT x -> IO ByteString+encodeNRTScore action =+   encodeOSCBundles <$> runNRT action+ -- | Generate a file of actions that SC can use to do NRT with. --  --   __If you just want the .aiff file, you probably want 'writeNRT' instead.__@@ -139,7 +202,7 @@ --   > scsynth -N /tmp/foo.osc _ /tmp/NRTout.aiff 44100 AIFF int16 writeNRTScore :: FilePath -> NRT a -> IO () writeNRTScore path action =-   (BS.writeFile path . encodeOSCBundles) =<< runNRT action+   BS.writeFile path =<< encodeNRTScore action   -- | Generate an audio file from an NRT action -- this can write songs far faster@@ -180,10 +243,11 @@             (".aif", "AIFF")           , (".aiff", "AIFF")           , (".wav", "WAV")+          , (".flac", "FLAC")+          , (".raw", "raw")             -- todo: these formats seem not to work.             -- Try it on more-recent versions of SC:-          -- ".flac" -> "FLAC"-          -- ".ogg" -> "vorbis"+          -- , (".ogg", "VORBIS")           ]     tempDir <- canonicalizePath =<< getTemporaryDirectory

@@ -7,10 +7,12 @@ --   sure the clocks agree  -- {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE+     FlexibleInstances+   , InstanceSigs+   , KindSignatures+   , TypeSynonymInstances+   #-} -- {-# LANGUAGE ViewPatterns #-}  {-# LANGUAGE NoIncoherentInstances #-}@@ -19,9 +21,12 @@  module Vivid.Actions.Scheduled (      Scheduled-   , doScheduledIn-   , doScheduledAt-   , doScheduledNow++   , doScheduledInWith++   , doScheduledAtWith++   , doScheduledNowWith    ) where  import Vivid.Actions.Class@@ -33,23 +38,24 @@ import Control.Concurrent import Control.Monad import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Reader (ReaderT, runReaderT, mapReaderT) import Control.Monad.State (evalStateT, put, get, modify, StateT) import Data.ByteString (ByteString) import Prelude -type Scheduled = StateT Timestamp IO+type Scheduled = ReaderT SCServerState (StateT Timestamp IO)   instance VividAction Scheduled where    callOSC :: OSC -> Scheduled ()    callOSC message = do       now <- getTime-      liftIO . callBS . encodeOSCBundle $ OSCBundle now [Right message]+      mapReaderT liftIO . callBS . encodeOSCBundle $ OSCBundle now [Right message]     callBS :: ByteString -> Scheduled ()    callBS message = do       now <- getTime-      liftIO . callBS . encodeOSCBundle $ OSCBundle now [Left message]+      mapReaderT liftIO . callBS . encodeOSCBundle $ OSCBundle now [Left message]     sync :: Scheduled ()    sync = return () -- always right?@@ -64,13 +70,13 @@    getTime = get     newBufferId :: Scheduled BufferId-   newBufferId = liftIO newBufferId+   newBufferId = mapReaderT liftIO (newBufferId :: ReaderT SCServerState IO BufferId)     newNodeId :: Scheduled NodeId-   newNodeId = liftIO newNodeId+   newNodeId = mapReaderT liftIO (newNodeId :: ReaderT SCServerState IO NodeId)     newSyncId :: Scheduled SyncId-   newSyncId = liftIO newSyncId+   newSyncId = mapReaderT liftIO (newSyncId :: ReaderT SCServerState IO SyncId)     fork :: Scheduled () -> Scheduled ()    fork action = do@@ -79,23 +85,24 @@       put timeOfFork     defineSD :: SynthDef a -> Scheduled ()-   defineSD = liftIO . void . forkIO . defineSD+   defineSD = mapReaderT (liftIO . void . forkIO) . defineSD  -- | Schedule an action to happen at the given time-doScheduledAt :: Timestamp -> Scheduled a -> IO a-doScheduledAt startTime action =-   evalStateT action startTime+doScheduledAtWith :: SCServerState -> Timestamp -> Scheduled a -> IO a+doScheduledAtWith serverState startTime action =+   let stateAction = runReaderT action serverState+   in evalStateT stateAction startTime  -- | Schedule an action to happen n seconds from now-doScheduledIn :: Double -> Scheduled a -> IO a-doScheduledIn numSecs action = do-   now <- getTime-   doScheduledAt (addSecs now numSecs) action+doScheduledInWith :: SCServerState -> Double -> Scheduled x -> IO x+doScheduledInWith serverState numSecs action = do+   now <- runReaderT (getTime :: ReaderT SCServerState IO Timestamp) serverState -- Not that the server state matters here+   doScheduledAtWith serverState (addSecs now numSecs) action  -- | Schedule an action to happen right now. Because of server latency this --   could arrive late, so you might want to do something like --   @doScheduledIn 0.01@ instead:-doScheduledNow :: Scheduled a -> IO a-doScheduledNow action = do-   now <- getTime-   doScheduledAt now action+doScheduledNowWith :: SCServerState -> Scheduled x -> IO x+doScheduledNowWith serverState action = do+   now <- runReaderT (getTime :: ReaderT SCServerState IO Timestamp) serverState -- Not that the server state matters here+   doScheduledAtWith serverState now action

@@ -161,7 +161,7 @@    _ -> 0  -env :: Float -> [(Float, Float)] -> EnvCurve -> EnvLiterally a+env :: Float -> [(Float, Float)] -> EnvCurve -> EnvLiterally args env firstPoint pointsAndLengths curve = EnvLiterally {      _envLiterally_initialVal = firstPoint    , _envLiterally_releaseNode = Nothing

@@ -0,0 +1,155 @@+{-# LANGUAGE+     BangPatterns+   , InstanceSigs+   #-}++module Vivid.GlobalState (+     withGlobalSCServerState+   , setClientId+   , setMaxBufferIds+   , waitForSync_io+   , waitForSync_io_noGC+   , startMailbox+   , getMailboxForSyncId+   , connectToSCServer+   , createSCServerConnection+   , closeSCServerConnection+   , getSCServerSocket+   , doScheduledIn+   , doScheduledAt+   , doScheduledNow+   , quitSCServer+   , defineSDFromFile++   -- Not sure we need to export these:+   , getNextAvailables+   , getNextAvailable+   ) where++import Control.Concurrent (ThreadId, forkIO)+import Control.Concurrent.MVar (MVar)+import Control.Concurrent.STM+import Control.Monad.Reader+import Data.ByteString (ByteString)+import Data.Int+import Network.Socket (Socket)++-- We use this only for "the unsafePerformIO hack"+-- (https://wiki.haskell.org/Top_level_mutable_state) so that functions can+-- refer to the state without being passed the state explicitly. This should+-- still be safe:+import System.IO.Unsafe (unsafePerformIO)++import Vivid.Actions (quitSCServerWith)+import Vivid.Actions.Class (VividAction(..))+import Vivid.Actions.IO (defineSDFromFileWith)+import Vivid.Actions.Scheduled+import Vivid.OSC (Timestamp)+import Vivid.SCServer.Connection+import Vivid.SCServer.State+import Vivid.SynthDef.Types (SynthDef)++{-# NOINLINE globalSCServerState #-}+globalSCServerState :: SCServerState+-- See the above note about this use of unsafePerformIO:+globalSCServerState = unsafePerformIO makeEmptySCServerState++withGlobalSCServerState :: (SCServerState -> x) -> x+withGlobalSCServerState action =+   -- This line is meant to prevent 'nested STM' errors.+   -- Would like a more systematic look at the causes.:+   let !_ = globalSCServerState++   in action globalSCServerState+++setClientId :: Int32 -> IO ()+setClientId = withGlobalSCServerState setServerClientId++setMaxBufferIds :: Int32 -> IO ()+setMaxBufferIds = withGlobalSCServerState setServerMaxBufferIds++getNextAvailable :: (SCServerState -> TVar [a]) -> IO a+getNextAvailable = withGlobalSCServerState getNextAvailable'++getNextAvailables :: Int -> (SCServerState -> TVar [a]) -> IO [a]+getNextAvailables = withGlobalSCServerState getNextAvailables'+++closeSCServerConnection :: IO ()+closeSCServerConnection = withGlobalSCServerState closeSCServerConnection'++connectToSCServer :: SCConnectConfig -> IO (Socket, ThreadId)+connectToSCServer = withGlobalSCServerState connectToSCServer'++waitForSync_io :: SyncId -> IO ()+waitForSync_io = withGlobalSCServerState waitForSync_io'++waitForSync_io_noGC :: SyncId -> IO ()+waitForSync_io_noGC = withGlobalSCServerState waitForSync_io_noGC'++startMailbox :: Socket -> IO ()+startMailbox = withGlobalSCServerState startMailbox'++getMailboxForSyncId :: SyncId -> IO (MVar ())+getMailboxForSyncId = withGlobalSCServerState getMailboxForSyncId'++createSCServerConnection :: SCConnectConfig -> IO (Either String Socket)+createSCServerConnection = withGlobalSCServerState createSCServerConnection'++getSCServerSocket :: IO Socket+getSCServerSocket = withGlobalSCServerState getSCServerSocket'++defineSDFromFile :: SynthDef a -> IO ()+defineSDFromFile = withGlobalSCServerState defineSDFromFileWith++doScheduledAt :: Timestamp -> Scheduled a -> IO a+doScheduledAt =+   withGlobalSCServerState doScheduledAtWith++doScheduledIn :: Double -> Scheduled a -> IO a+doScheduledIn =+   withGlobalSCServerState doScheduledInWith++doScheduledNow :: Scheduled a -> IO a+doScheduledNow =+   withGlobalSCServerState doScheduledNowWith++quitSCServer :: IO ()+quitSCServer = withGlobalSCServerState quitSCServerWith++instance VividAction IO where+   callBS :: ByteString -> IO ()+   callBS bs = globalIO $ callBS bs++   sync :: IO ()+   sync = globalIO sync++   waitForSync :: SyncId -> IO ()+   waitForSync syncId = globalIO $ waitForSync syncId++   wait :: Real n => n -> IO ()+   wait n = globalIO $ wait n++   getTime :: IO Timestamp+   getTime = globalIO getTime++   newBufferId :: IO BufferId+   newBufferId = globalIO newBufferId++   newNodeId :: IO NodeId+   newNodeId = globalIO newNodeId++   newSyncId :: IO SyncId+   newSyncId = globalIO newSyncId++   fork :: IO () -> IO ()+   fork = void . forkIO++   defineSD :: SynthDef a -> IO ()+   defineSD synthDef = globalIO $ defineSD synthDef++globalIO :: (ReaderT SCServerState IO x) -> IO x+globalIO action =+   withGlobalSCServerState (runReaderT action)+

@@ -0,0 +1,5 @@+module Vivid.NoGlobalState (+     module Vivid.NoPluginsNoGlobalState+   ) where++import Vivid.NoPluginsNoGlobalState

@@ -1,83 +1,5 @@--- | Exports everything from Vivid (and some helpful reexports) except 'Vivid.UGens.Plugins'--{-# OPTIONS_HADDOCK show-extensions #-}--{-# LANGUAGE DataKinds #-}--{-# LANGUAGE NoRebindableSyntax #-}-{-# LANGUAGE NoIncoherentInstances #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE NoUndecidableInstances #-}- module Vivid.NoPlugins (-   -- * Vivid Reexports-     module Vivid.Actions-   , module Vivid.Envelopes-   , module Vivid.SynthDef-   , module Vivid.UGens--   , module Vivid.SCServer-   , module Vivid.Randomness-   , addSecs-   , Timestamp(..)--   , module Vivid.SynthDef.TypesafeArgs-   , module Vivid.SynthDef.FromUA--   -- * Vivid-supercollider Reexports:-   , module Vivid.SC.SynthDef.Types--   -- * Handy Reexports For Livecoding-   --   So you need to spend as little time importing as possible while livecoding-   , module Control.Applicative-   , module Control.Monad-   , module Data.ByteString-   , module Data.Int-   , (&)-   , module Data.Monoid-   , module System.Random-   , module Control.Monad.Random-   , module Control.Monad.IO.Class---   , bufToI-   , bToI-   , b2i+     module Vivid.NoPluginsNoGlobalState    ) where --- Reexports from vivid-supercollider:-import Vivid.SC.SynthDef.Types--import Vivid.Actions-import Vivid.Envelopes-import Vivid.SCServer-import Vivid.Randomness-import Vivid.SynthDef-import Vivid.SynthDef.FromUA (Args, SDBodyArgs, UA, NoDefaults, none) -- To make type sigs not have qualified names-import Vivid.SynthDef.TypesafeArgs (AddParams)--import Vivid.UGens-import Vivid.OSC (addSecs)--import Control.Applicative-import Control.Monad-import Control.Monad.Random-import Data.ByteString (ByteString)-import Data.Function ((&))-import Data.Int-import Data.Monoid-import System.Random hiding (uniform)--import Control.Monad.IO.Class-import GHC.TypeLits----bufToI :: KnownSymbol a => BufferId -> I a-bufToI (BufferId b) = toI b--bToI :: KnownSymbol a => BufferId -> I a-bToI = bufToI--b2i :: KnownSymbol a => BufferId -> I a-b2i = bufToI+import Vivid.NoPluginsNoGlobalState

@@ -0,0 +1,83 @@+-- | Exports everything from Vivid (and some helpful reexports) except 'Vivid.UGens.Plugins'++{-# OPTIONS_HADDOCK show-extensions #-}++{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoRebindableSyntax #-}+{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.NoPluginsNoGlobalState (+   -- * Vivid Reexports+     module Vivid.Actions+   , module Vivid.Envelopes+   , module Vivid.SynthDef+   , module Vivid.UGens++   , module Vivid.SCServer+   , module Vivid.Randomness+   , addSecs+   , Timestamp(..)++   , module Vivid.SynthDef.TypesafeArgs+   , module Vivid.SynthDef.FromUA++   -- * Vivid-supercollider Reexports:+   , module Vivid.SC.SynthDef.Types++   -- * Handy Reexports For Livecoding+   --   So you need to spend as little time importing as possible while livecoding+   , module Control.Applicative+   , module Control.Monad+   , module Data.ByteString+   , module Data.Int+   , (&)+   , module Data.Monoid+   , module System.Random+   , module Control.Monad.Random+   , module Control.Monad.IO.Class+++   , bufToI+   , bToI+   , b2i+   ) where++-- Reexports from vivid-supercollider:+import Vivid.SC.SynthDef.Types++import Vivid.Actions+import Vivid.Envelopes+import Vivid.SCServer+import Vivid.Randomness+import Vivid.SynthDef+import Vivid.SynthDef.FromUA (Args, SDBodyArgs, UA, NoDefaults, none) -- To make type sigs not have qualified names+import Vivid.SynthDef.TypesafeArgs (AddParams)++import Vivid.UGens+import Vivid.OSC (addSecs)++import Control.Applicative+import Control.Monad+import Control.Monad.Random+import Data.ByteString (ByteString)+import Data.Function ((&))+import Data.Int+import Data.Monoid+import System.Random hiding (uniform)++import Control.Monad.IO.Class+import GHC.TypeLits++++bufToI :: KnownSymbol a => BufferId -> I a+bufToI (BufferId b) = toI b++bToI :: KnownSymbol a => BufferId -> I a+bToI = bufToI++b2i :: KnownSymbol a => BufferId -> I a+b2i = bufToI

@@ -1,7 +1,10 @@ -- | Vivid-specific OSC Bundle encoding -{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE+     LambdaCase+   , OverloadedStrings+   #-}+   -- , Safe  module Vivid.OSC.Bundles (      encodeOSCBundles

@@ -52,8 +52,8 @@     -- * Manual management of SC server connection -   , createSCServerConnection-   , closeSCServerConnection+   , createSCServerConnection'+   , closeSCServerConnection'    , SCConnectConfig(..)    , defaultConnectConfig @@ -67,14 +67,13 @@ import Vivid.OSC.Bundles (initTreeCommand) import qualified Vivid.SC.Server.Commands as SCCmd import Vivid.SC.Server.Types (Group(..), ParGroup(..))-import qualified Vivid.SC.Server.Commands as SCCmd  import Vivid.Actions.Class import Vivid.SCServer.Connection import Vivid.SCServer.State import Vivid.SCServer.Types -import qualified Data.ByteString.UTF8 as UTF8 (fromString)+-- import qualified Data.ByteString.UTF8 as UTF8 (fromString) import Data.Int (Int32) -- BBP hack: import Prelude@@ -153,13 +152,13 @@       SCCmd.b_write          bufId          fPath-         "wav"-         "float"+         "wav" -- TODO!+         "float" -- less important, but TODO          -- Num frames:          Nothing          -- Start frame:          0-         -- Whether to leave the file open (useful for diskOut)+         -- Whether to leave the file open (useful for diskOut):          (_wb_keepOpen args)          -- We make this synchronous because what if you send a          -- "/b_write" then a "/quit"?(!):

@@ -2,6 +2,7 @@      BangPatterns    , LambdaCase    , OverloadedStrings+   , ViewPatterns     , NoIncoherentInstances    , NoMonomorphismRestriction@@ -9,17 +10,33 @@    #-}  module Vivid.SCServer.Connection (-     createSCServerConnection+     createSCServerConnection'+    , defaultConnectConfig    , defaultMessageFunction    , ignoreMessagesFunction+    , SCConnectConfig(..)-   , closeSCServerConnection++   , closeSCServerConnection'+    , ConnProtocol(..)-   , getMailboxForSyncId-   , getSCServerSocket-   , waitForSync_io-   , waitForSync_io_noGC++   , getMailboxForSyncId'++   , getSCServerSocket'++   , waitForSync_io'+   , waitForSync_io_noGC'++   , sendMaybePad++   -- Exported at least for 'Vivid.GlobalState':+   , startMailbox'+   , connectToSCServer'++   -- for tests:+   , splitMessagesFromChunk    ) where  import Vivid.SC.Server.Commands as SCCmd@@ -29,26 +46,30 @@ import Vivid.SCServer.State  import Network.Socket (-     SocketType(Datagram {- , Stream -}), defaultProtocol, socket+     SocketType(Datagram , Stream), defaultProtocol, socket    , AddrInfo(..), getAddrInfo-   -- , AddrInfoFlag(..), defaultHints+   -- , AddrInfoFlag(..),+   , defaultHints    , Socket, HostName, ServiceName, connect, close -- , listen, bind    -- , bindSocket, accept+   , accept, listen                                                                  -- We put this everywhere we do socket actions for Windows compatibility:    , withSocketsDo    ) -import Network.Socket.ByteString (send, recv)+import Network.Socket.ByteString (sendAll, recv)  import Control.Concurrent (forkIO, ThreadId, killThread) import Control.Concurrent.MVar-import Control.Concurrent.STM -- (readTVar, modifyTVar', atomically, writeTVar, {- readTVarIO, -} swapTVar)+import Control.Concurrent.STM import Control.Monad (forever)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS import Data.Int (Int32)--- import Data.IORef import qualified Data.Map as Map import Data.Monoid+import Data.Serialize (encode, decode)  -- | __You usually don't need to call this function__ -- @@ -59,11 +80,11 @@ --   computation is done upfront --  --   The 'HostName' is the ip address or "localhost". The 'ServiceName' is the port-createSCServerConnection :: SCConnectConfig -> IO (Either String Socket)-createSCServerConnection connConfig = do-   let !_ = scServerState-   shouldMakeSock scServerState >>= \case-      True -> makeSock scServerState connConfig >>= \case+createSCServerConnection' :: SCServerState -> SCConnectConfig -> IO (Either String Socket)+createSCServerConnection' serverState connConfig = do+   let !_ = serverState+   shouldMakeSock serverState >>= \case+      True -> makeSock serverState connConfig >>= \case          Just s -> pure $ Right s          Nothing -> pure $ Left "Unable to create socket"       False ->@@ -81,24 +102,18 @@ --   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 --   connection first-closeSCServerConnection :: IO ()-closeSCServerConnection = do-   let !_ = scServerState+closeSCServerConnection' :: SCServerState -> IO ()+closeSCServerConnection' serverState = do+   let !_ = serverState    ish <- atomically $ do-      writeTVar (_scServerState_socketConnectStarted scServerState) False+      writeTVar (_scServerState_socketConnectStarted serverState) False {--      (,) <$> swapTVar (_scServerState_socket scServerState) Nothing-          <*> swapTVar (_scServerState_listener scServerState) Nothing+      (,) <$> swapTVar (_scServerState_socket serverState) Nothing+          <*> swapTVar (_scServerState_listener serverState) Nothing -}-      (,) <$> tryTakeTMVar (_scServerState_socket scServerState)-          <*> tryTakeTMVar (_scServerState_listener scServerState)+      (,) <$> tryTakeTMVar (_scServerState_socket serverState)+          <*> tryTakeTMVar (_scServerState_listener serverState) -{--   ish <- (,) <$> readIORef (_scServerState_socket scServerState)-              <*> readIORef (_scServerState_listener scServerState)-   writeIORef (_scServerState_socket scServerState) Nothing-   writeIORef (_scServerState_listener scServerState) Nothing--}    case ish of       (Just sock, Just listener) -> do          killThread listener@@ -107,12 +122,6 @@       _ -> error "well that's weird"  --data ConnProtocol-   = ConnProtocol_UDP-   -- ConnProtocol_TCP- deriving (Show, Read, Eq, Ord)- data SCConnectConfig    = SCConnectConfig {     _scConnectConfig_hostName :: HostName@@ -122,7 +131,9 @@      --   the same server, each client should have a separate clientId, which      --   keeps the nodeId separate. Sclang's default clientId is 0, and ours      --   is 1, so you can run both at the same time without config.+     --   This number must be between 0 and 31   , _scConnectConfig_connProtocol :: ConnProtocol+  , _scConnectConfig_password :: Maybe ByteString -- TODO: I don't like that e.g. a password could be provided with UDP, which doesn't use them   , _scConnectConfig_serverMessageFunction :: OSC -> IO ()   -- max # of synthdefs -- and clear em out   }@@ -136,71 +147,97 @@      _scConnectConfig_hostName = "127.0.0.1"    , _scConnectConfig_port = "57110"    , _scConnectConfig_clientId = 1-   , _scConnectConfig_connProtocol = ConnProtocol_UDP+   , _scConnectConfig_connProtocol = ConnProtocol_UDP -- ConnProtocol_TCP -- UDP -- TODO: not for release!+   , _scConnectConfig_password = Nothing    , _scConnectConfig_serverMessageFunction = defaultMessageFunction    }  -- Internal -- this is what gets called after we check a socket doesn't -- already exist:-connectToSCServer :: SCConnectConfig -> IO (Socket, ThreadId)-connectToSCServer scConnectConfig = withSocketsDo $ do-   let !_ = scServerState+connectToSCServer' :: SCServerState -> SCConnectConfig -> IO (Socket, ThreadId)+connectToSCServer' serverState scConnectConfig = withSocketsDo $ do+   let !_ = serverState    let hostName = _scConnectConfig_hostName scConnectConfig        port = _scConnectConfig_port scConnectConfig        connType = case _scConnectConfig_connProtocol scConnectConfig of           ConnProtocol_UDP -> Datagram---          ConnProtocol_TCP -> Stream-   (serverAddr:_) <- getAddrInfo Nothing {- (Just (defaultHints {addrFlags = [AI_PASSIVE]})) -} (Just hostName) (Just port)-   s <- socket (addrFamily serverAddr) connType defaultProtocol-   {--   if (connType == Stream)-      then do-         print 0-         bindSocket s (addrAddress serverAddr)-         print 1-         listen s 1-         -- _ <- accept s-         pure ()-   else connect s (addrAddress serverAddr)--}-   setClientId (_scConnectConfig_clientId scConnectConfig)+          ConnProtocol_TCP -> Stream+   (serverAddr:_) <- getAddrInfo (Just (defaultHints { addrSocketType = connType })) {- (Just (defaultHints {addrFlags = [AI_PASSIVE]})) -} (Just hostName) (Just port)+   s <- socket (addrFamily serverAddr) connType (addrProtocol serverAddr) -- defaultProtocol+   setServerClientId serverState (_scConnectConfig_clientId scConnectConfig)    connect s (addrAddress serverAddr)---   accept s -   atomically $ writeTVar (_scServerState_serverMessageFunction scServerState) $-      _scConnectConfig_serverMessageFunction scConnectConfig-   listener <- forkIO $ startMailbox s+   atomically $ do+      writeTVar (_scServerState_serverMessageFunction serverState) $+         _scConnectConfig_serverMessageFunction scConnectConfig+      writeTVar (_scServerState_connProtocol serverState) $+         _scConnectConfig_connProtocol scConnectConfig+++   case _scConnectConfig_password scConnectConfig of+      Nothing -> pure ()+      -- This must be the very first message sent to the server:+      Just password -> sendAll {- MaybePad  (_scConnectConfig_connProtocol scConnectConfig) -} s $ password++   listener <- forkIO $ startMailbox' serverState s+    let firstSyncID = toEnum $ numberOfSyncIdsToDrop - 2-   _ <- send s $ encodeOSCBundle $ OSCBundle (Timestamp 0) [+   _ <- sendMaybePad (_scConnectConfig_connProtocol scConnectConfig) s $+      encodeOSCBundle $ OSCBundle (Timestamp 0) [         Right $ SCCmd.dumpOSC DumpOSC_Parsed       , Right $ initTreeCommand       , Right $ SCCmd.sync (SyncId firstSyncID)       ]-   waitForSync_io (SyncId firstSyncID)++   waitForSync_io' serverState (SyncId firstSyncID)+    pure (s, listener) -waitForSync_io :: SyncId -> IO ()-waitForSync_io syncId = do-   _ <- readMVar =<< getMailboxForSyncId syncId+-- ALWAYS use this instead of 'send':+sendMaybePad :: ConnProtocol -> Socket -> ByteString -> IO ()+sendMaybePad connProtocol socket msg_noPad =+   withSocketsDo $ sendAll socket msg -- TODO: send vs sendAll? Makes a difference?+ where+   msg :: ByteString+   msg = case connProtocol of+      ConnProtocol_UDP -> msg_noPad+      ConnProtocol_TCP -> (encode (toEnum (BS.length msg_noPad) :: Int32))<>msg_noPad++waitForSync_io' :: SCServerState -> SyncId -> IO ()+waitForSync_io' serverState syncId = do+   _ <- readMVar =<< getMailboxForSyncId' serverState syncId    -- We garbage-collect these so the Map stays small -- but it means you can only wait    -- for a sync from one place:-   atomically $ modifyTVar' (_scServerState_syncIdMailboxes scServerState) $+   atomically $ modifyTVar' (_scServerState_syncIdMailboxes serverState) $       Map.delete syncId -waitForSync_io_noGC :: SyncId -> IO ()-waitForSync_io_noGC syncId = do-   _ <- readMVar =<< getMailboxForSyncId syncId+waitForSync_io_noGC' :: SCServerState -> SyncId -> IO ()+waitForSync_io_noGC' serverState syncId = do+   _ <- readMVar =<< getMailboxForSyncId' serverState syncId    pure ()  -- 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{- , _ -}) ->+startMailbox' :: SCServerState -> Socket -> IO ()+startMailbox' serverState s = do+   let !_ = serverState+   connProtocol <- readTVarIO $ _scServerState_connProtocol serverState :: IO ConnProtocol -- note we only read this once at the beginning. If this can change throughout program run, update this code+   forever $ recv {- From -} s 65536 >>= \(msg_maybePad {- , _ -}) -> do+      case connProtocol of+         ConnProtocol_UDP ->+            handleMsg msg_maybePad+         ConnProtocol_TCP -> do+            case splitMessagesFromChunk msg_maybePad of -- From the 'network' docs: "For TCP sockets, a zero length return value means the peer has closed its half side of the connection."+               Right [] -> errorWithoutStackTrace "Connection to the SC server lost. Probably the server has quit or the network is down. You will need to reconnect."+               Left err -> putStrLn err+               Right msgs ->+                  mapM_ handleMsg msgs+ where+   handleMsg :: ByteString -> IO ()+   handleMsg msg = do       case decodeOSC msg of          Right (OSC "/synced" [OSC_I theSyncId]) -> do-            syncBox <- getMailboxForSyncId (SyncId theSyncId)+            syncBox <- getMailboxForSyncId' serverState (SyncId theSyncId)             tryPutMVar syncBox () >>= \case                True -> pure ()                False ->@@ -209,10 +246,30 @@                      ++ show theSyncId          Right x -> do             otherMessageFunction <- readTVarIO $-               _scServerState_serverMessageFunction scServerState+               _scServerState_serverMessageFunction serverState             otherMessageFunction x-         Left e -> putStrLn $ "ERROR DECODING OSC: " ++ show (msg, e)+         Left e -> do+            putStrLn $ "ERROR DECODING OSC: " ++ show (msg, e) +-- There can be more than one message that we recieve as one binary blob:+splitMessagesFromChunk :: ByteString -> Either String [ByteString]+splitMessagesFromChunk b =+   case BS.splitAt 4 b of+      ("", "") -> Right []+      (sizeBS, rest) ->+         case decode sizeBS :: Either String Int32 of+            Left e -> Left $ "ERROR DECODING OSC PAD: "++show b+            Right (fromEnum -> size) ->+               let (thisChunk, nextBS) = BS.splitAt size rest+               in case BS.length thisChunk == size of+                     False -> Left $ "INCORRECT SIZE: "++show b+                     True ->+                        case splitMessagesFromChunk nextBS of+                           Left e -> Left e+                           Right allRest -> Right (thisChunk : allRest)+++ -- | Print all messages other than \"/done\"s defaultMessageFunction :: OSC -> IO () defaultMessageFunction = \case@@ -233,20 +290,18 @@ -- This is a nice example of when STM can be really helpful - -- It's impossible! (right?) to have 2 threads create mailboxes and have em overwrite each -- other -- so we can make a guarantee about recieving a sync that you register for-getMailboxForSyncId :: SyncId -> IO (MVar ())-getMailboxForSyncId syncId = do-   mvarThatIMightWannaUse <- newEmptyMVar-   atomically $ do-      allMailboxes <- readTVar (_scServerState_syncIdMailboxes scServerState)+getMailboxForSyncId' :: SCServerState -> SyncId -> IO (MVar ())+getMailboxForSyncId' serverState syncId = do+   mvarThatIMightWannaUse <- newEmptyMVar -- TODO: make this a TMVar so it doesn't have to sit outside like this?+   m <- atomically $ do+      allMailboxes <- readTVar (_scServerState_syncIdMailboxes serverState)       case Map.lookup syncId allMailboxes of          Just syncBox -> pure syncBox          Nothing -> do-            writeTVar (_scServerState_syncIdMailboxes scServerState)+            writeTVar (_scServerState_syncIdMailboxes serverState)               (Map.insert syncId mvarThatIMightWannaUse allMailboxes)             pure mvarThatIMightWannaUse--getSCServerSocket :: IO Socket-getSCServerSocket = getSCServerSocket' scServerState+   pure m  getSCServerSocket' :: SCServerState -> IO Socket getSCServerSocket' scServerState' = do@@ -270,7 +325,7 @@  makeSock :: SCServerState -> SCConnectConfig -> IO (Maybe Socket) makeSock serverState connConfig = do-   (sock, listener) <- connectToSCServer connConfig+   (sock, listener) <- connectToSCServer' serverState connConfig    atomically $ (do       -- writeTVar (_scServerState_socket serverState) $ Just sock       -- writeTVar (_scServerState_listener serverState) $ Just listener

@@ -1,7 +1,9 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE+     BangPatterns+   , DataKinds+   , KindSignatures+   , LambdaCase+   #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -12,14 +14,21 @@    , NodeId(..)    , SyncId(..) -   , scServerState    , SCServerState(..) -   , setClientId-   , setMaxBufferIds+   , ConnProtocol(..) -   , getNextAvailable+   , setServerClientId++   , setServerMaxBufferIds+    , numberOfSyncIdsToDrop++   , makeEmptySCServerState++   -- We might not need to export these (or the global equivalents) at all:+   , getNextAvailable'+   , getNextAvailables'    ) where  import Vivid.OSC (OSC)@@ -41,19 +50,6 @@ import Data.Set (Set) import Prelude --- We use this only for "the unsafePerformIO hack"--- (https://wiki.haskell.org/Top_level_mutable_state) so that functions can--- refer to the state without being passed the state explicitly. This should--- still be safe:-import System.IO.Unsafe (unsafePerformIO)--{-# NOINLINE scServerState #-}-scServerState :: SCServerState--- Currently you can only be connected to one SC server at a time. Future---   versions plan to remove this.--- See the above note about this use of unsafePerformIO:-scServerState = unsafePerformIO makeEmptySCServerState- data SCServerState    = SCServerState    -- We use 'IORef Maybe's instead of MVars so we can use weak pointer@@ -69,17 +65,26 @@   , _scServerState_syncIdMailboxes :: !(TVar (Map SyncId (MVar ())))   , _scServerState_serverMessageFunction :: !(TVar (OSC -> IO ()))   , _scServerState_definedSDs :: !(TVar (Set (SDName, Int))) -- Int is the hash+  , _scServerState_connProtocol :: TVar ConnProtocol -- This doesn't change after boot, but we could e.g. disconnect and reconnect after boot   } -setClientId :: Int32 -> IO ()-setClientId clientId = do+data ConnProtocol+   = ConnProtocol_UDP+   | ConnProtocol_TCP+ deriving (Show, Read, Eq, Ord)++setServerClientId :: SCServerState -> Int32 -> IO ()+setServerClientId serverState clientId = do    when (clientId < 0 || clientId > 31) $       error "client id must be betw 0 and 31"-   atomically $ writeTVar (_scServerState_availableNodeIds scServerState) $+   atomically $ writeTVar (_scServerState_availableNodeIds serverState) $       -- The client id is the first 5 bits of a positive int:       -- Note the incrementing gets weird once we hit the (.&.) -- should       -- fix if anyone plans to use more than 33 million nodes-      (flip map) [1000..] $ \nodeNum -> NodeId $+      map f [1000..]+ where+   f :: Int32 -> NodeId+   f nodeNum = NodeId $          ((clientId `shiftL` ((finiteBitSize nodeNum-5)-1)) .|.) $             ((maxBound `shiftR` 5) .&. nodeNum) @@ -103,6 +108,7 @@    syncMailboxes <- newTVarIO $ Map.empty    serverMessageFunction <- newTVarIO $ \_ -> return ()    definedSDs <- newTVarIO $ Set.empty+   connProtocolVar <- newTVarIO ConnProtocol_UDP     return $ SCServerState           { _scServerState_socketConnectStarted = sockConnectStarted@@ -115,6 +121,7 @@           , _scServerState_syncIdMailboxes = syncMailboxes           , _scServerState_serverMessageFunction = serverMessageFunction           , _scServerState_definedSDs = definedSDs+          , _scServerState_connProtocol = connProtocolVar           }  -- | If you've started the SC server with a non-default number of buffer ids,@@ -122,21 +129,23 @@ --  --   Note that the buffer ids start at 512, to not clash with any that --   another client (e.g. sclang) has allocated-setMaxBufferIds :: Int32 -> IO ()-setMaxBufferIds newMax = atomically $-   writeTVar (_scServerState_maxBufIds scServerState) newMax+setServerMaxBufferIds :: SCServerState -> Int32 -> IO ()+setServerMaxBufferIds serverState newMax =+   atomically $+      writeTVar (_scServerState_maxBufIds serverState) newMax -getNextAvailable :: (SCServerState -> TVar [a]) -> IO a-getNextAvailable getter =-   getNextAvailables 1 getter >>= \case+getNextAvailable' :: SCServerState -> (SCServerState -> TVar [a]) -> IO a+getNextAvailable' serverState getter =+   getNextAvailables' serverState 1 getter >>= \case       [x] -> return x       _ -> error "i don't even - 938" -getNextAvailables :: Int -> (SCServerState -> TVar [a]) -> IO [a]-getNextAvailables numToGet getter = do-   let !_ = scServerState+getNextAvailables' :: SCServerState -> Int -> (SCServerState -> TVar [a]) -> IO [a]+getNextAvailables' serverState numToGet getter = do+   let !_ = serverState    atomically $ do-      let avail = getter scServerState+      let avail = getter serverState       (ns, rest) <- splitAt numToGet <$> readTVar avail       writeTVar avail rest       return ns+

@@ -1,5 +1,7 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE+     DataKinds+   , KindSignatures+   #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -19,7 +21,6 @@    , IsGroup    ) where -import Data.Int import GHC.TypeLits import Vivid.SC.Server.Types import Vivid.SynthDef.TypesafeArgs

@@ -37,12 +37,14 @@  {-# LANGUAGE NoRebindableSyntax #-} -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE+     BangPatterns+   , DataKinds+   , LambdaCase+   , OverloadedStrings+   , TypeFamilies, NoMonoLocalBinds+   , ViewPatterns+   #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -57,6 +59,7 @@   , addUGen   , addMonoUGen   , addPolyUGen+  , addOrIncrementMaxLocalBufs   , ToSig(..)   , Signal(..)   , encodeSD@@ -105,7 +108,6 @@ import Vivid.SynthDef.FromUA (SDBody)  -- import Control.Applicative-import Control.Arrow (first{-, second-}) import Control.Monad.State (get, put, modify, execState) import Data.ByteString (ByteString) import qualified Data.ByteString.UTF8 as UTF8@@ -294,6 +296,28 @@       }    return $ map (UGOut anId) [0.. toEnum (_ugenNumOuts ugen - 1)] +-- In all (as of this writing) other cases, UGens are 'write only': you can+--   just add them, not edit or remove them. However! SC has a special case+--   where if you create a LocalBuf, you need to have previously a+--   'MaxLocalBufs' which says how many LocalBufs there are in the whole graph.+--   So for that, we update our 'MaxLocalBufs'+addOrIncrementMaxLocalBufs :: SDBody' args Signal+addOrIncrementMaxLocalBufs = do+   (ids, synthDef, argList) <- get+   case Map.toList $ Map.filter isMLB $ _sdUGens synthDef of+      [] -> addMonoUGen $ UGen (UGName_S "MaxLocalBufs") IR [Constant 1] 1+      [(ugIndex,     UGen (UGName_S "MaxLocalBufs") IR [Constant numPreviously]      1)] -> do+         let newUG = UGen (UGName_S "MaxLocalBufs") IR [Constant (numPreviously + 1)] 1+             newSD = synthDef { _sdUGens = Map.insert ugIndex newUG $ _sdUGens synthDef }+         put $ (ids, newSD, argList)+         pure $ UGOut ugIndex 0+      [e] -> error $ "Incorrectly constructed MLB?: "++show e+      es -> error $ "Multiple MLB?: "++show es+ where+   isMLB = \case+      UGen (UGName_S "MaxLocalBufs") _ _ _ -> True+      _ -> False+ -- | Define a Synth Definition sd :: VarList argList => argList -> SDBody' (InnerVars argList) [Signal] -> SynthDef (InnerVars argList) sd params theState =@@ -306,11 +330,15 @@  makeSynthDef :: VarList argList => SDName -> argList -> SDBody' (InnerVars argList) [Signal] -> SynthDef (InnerVars argList) makeSynthDef name params theState =-   let theSD = SynthDef name (map (first UTF8.fromString) paramList) Map.empty-       (paramList, argSet) = makeTypedVarList params-   in (\(_,b,_)->b) $ execState theState $-         ({- id supply: -} [0 :: Int ..], theSD, argSet)+   b+ where+   paramList :: [(String, Float)]+   (paramList, argSet) = makeTypedVarList params +   sdBeforeBody = SynthDef name [ (UTF8.fromString k, v) | (k, v) <- paramList ] Map.empty+   (_,b,_) = execState theState $+      ({- id supply: -} [0 :: Int ..], sdBeforeBody, argSet)+ -- | Set the calculation rate of a UGen --  --   e.g.@@ -341,15 +369,16 @@    return i'  getCalcRate :: Signal -> SDBody' args CalculationRate-getCalcRate (Constant _) = return IR-getCalcRate (Param _) = return KR-getCalcRate (UGOut theUG _) = do-   -- Note: this assumes updates to the ugen graph are only appends-   -- (so don't break that invariant if you build your own graph by hand!):-   (_, ugenGraph, _) <- get-   case Map.lookup theUG (_sdUGens ugenGraph) of-      Just ug -> return $ _ugenCalculationRate ug-      Nothing -> error "that output isn't in the graph!"+getCalcRate = \case+   Constant _ -> pure IR+   Param _ -> pure KR+   UGOut theUG _ -> do+      -- Note: this assumes updates to the ugen graph are only appends+      -- (so don't break that invariant if you build your own graph by hand!):+      (_, ugenGraph, _) <- get+      case Map.lookup theUG (_sdUGens ugenGraph) of+         Just ug -> return $ _ugenCalculationRate ug+         Nothing -> error "that output isn't in the graph!"   -- | Like 'Vivid.SCServer.shrinkSynthArgs' but for 'SynthDef's

@@ -26,8 +26,11 @@ import Vivid.SynthDef.Types  import qualified Data.ByteString.UTF8 as UTF8+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word8, Word16, Word32, Word64) -- import Data.Proxy import GHC.TypeLits+import Numeric.Natural (Natural)  class ToSig s (args :: [Symbol]) where    toSig :: s -> SDBody' args Signal@@ -41,17 +44,28 @@  #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 801 -instance ToSig Integer args where-   toSig = pure . Constant . realToFrac+realSig :: (Real n, Applicative f) => n -> f Signal+realSig = pure . Constant . realToFrac -instance ToSig Int args where-   toSig = pure . Constant . realToFrac+instance ToSig Double       args where toSig = realSig+instance ToSig Float        args where toSig = realSig -instance ToSig Double args where-   toSig = pure . Constant . realToFrac+instance ToSig Rational     args where toSig = realSig -instance ToSig Float args where-   toSig = pure . Constant . realToFrac+instance ToSig Integer      args where toSig = realSig+instance ToSig Natural      args where toSig = realSig++instance ToSig Int          args where toSig = realSig+instance ToSig Int8         args where toSig = realSig+instance ToSig Int16        args where toSig = realSig+instance ToSig Int32        args where toSig = realSig+instance ToSig Int64        args where toSig = realSig++instance ToSig Word         args where toSig = realSig+instance ToSig Word8        args where toSig = realSig+instance ToSig Word16       args where toSig = realSig+instance ToSig Word32       args where toSig = realSig+instance ToSig Word64       args where toSig = realSig  #else 

@@ -3,11 +3,13 @@ {-# OPTIONS_HADDOCK show-extensions #-} -- {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DataKinds #-}+{-# LANGUAGE+     DataKinds+   , KindSignatures+   , OverloadedStrings+   , TypeFamilies, NoMonoLocalBinds+   #-} -- {-# LANGUAGE GADTs, NoMonoLocalBinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}

@@ -29,7 +29,7 @@ {-# LANGUAGE NoUndecidableInstances #-} {-# LANGUAGE NoIncoherentInstances #-} -{-# LANGUAGE ExistentialQuantification #-}+-- {-# LANGUAGE ExistentialQuantification #-}  module Vivid.UGens (      module Vivid.UGens.Args

@@ -72,6 +72,8 @@  --- detectSilence :: --- detectSilence =++ --- loudness :: --- loudness = --- peak ::

@@ -1,21 +1,23 @@ -- | UGen argument labels -- ---   These are named the same as their SC counterparts, usually.+--   These are usually named the same as their sclang counterparts.  {-# OPTIONS_HADDOCK show-extensions #-}  {-# LANGUAGE NoRebindableSyntax #-} -{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PartialTypeSignatures #-}-{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE+     ConstraintKinds+   , DataKinds+   , ExistentialQuantification+   , NoMonomorphismRestriction+   , FlexibleContexts+   , FlexibleInstances+   , KindSignatures+   , PartialTypeSignatures+   , TypeFamilies, NoMonoLocalBinds+   , TypeOperators+   #-}   {-# LANGUAGE NoIncoherentInstances #-}@@ -181,6 +183,13 @@ decayTime_ :: ToSig s as => s -> UA "decaySecs" as decayTime_ = decaySecs_ +decayScale_ :: ToSig s as => s -> UA "decayScale" as+decayScale_ = UA . toSig++-- | SC compatibility+decayscale_ :: ToSig s as => s -> UA "decayScale" as+decayscale_ = decayScale_+ -- | Alias of 'decaySecs_' for SC compatibility decaytime_ :: ToSig s as => s -> UA "decaySecs" as decaytime_ = decaySecs_@@ -286,6 +295,21 @@ freq_ :: ToSig s as => s -> UA "freq" as freq_  = UA . toSig +freqOffset_ :: ToSig s as => s -> UA "freqOffset" as+freqOffset_ = UA . toSig++-- | SC compatibility:+freqoffset_ :: ToSig s as => s -> UA "freqOffset" as+freqoffset_ = freqOffset_+++freqScale_ :: ToSig s as => s -> UA "freqScale" as+freqScale_ = UA . toSig++-- | SC compatibility:+freqscale_ :: ToSig s as => s -> UA "freqScale" as+freqscale_ = freqScale_+ friction_ :: ToSig s as => s -> UA "friction" as friction_ = UA . toSig @@ -647,11 +671,11 @@    , SDBodyArgs optional ~ SDBodyArgs userSupplied    , SDBodyArgs optional ~ args    ) => (UGen -> SDBody' args x) -> Int -> String -> CalculationRate -> Vs tags -> optional -> (userSupplied -> SDBody' args x)-makeMakeUGen addUGenF numOuts sdName calcRate tagList defaultArgs = \userSupplied -> do+makeMakeUGen addUGenF numOuts ugenName calcRate tagList defaultArgs = \userSupplied -> do    theArgList <- Map.fromList <$> fromUAWithDefaults (DefaultArgs defaultArgs) (OverwritingArgs userSupplied)    let signals =-          map (\k -> Map.findWithDefault (error $ "that's weird (likely a ugen with a typo in 'Vs'): "++sdName++":"++k) k theArgList) $ getSymbolVals tagList-   addUGenF $ UGen (UGName_S (UTF8.fromString sdName)) calcRate (signals :: [Signal]) numOuts+          map (\k -> Map.findWithDefault (error $ "that's weird (likely a ugen with a typo in 'Vs'): "++ugenName++":"++k) k theArgList) $ getSymbolVals tagList+   addUGenF $ UGen (UGName_S (UTF8.fromString ugenName)) calcRate (signals :: [Signal]) numOuts  makeMonoUGen, makeUGen :: (      GetSymbolVals (Vs tags)

@@ -1,13 +1,15 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}+{-# LANGUAGE+     DataKinds+   , ExtendedDefaultRules+   , FlexibleContexts+   , LambdaCase+   , OverloadedStrings+   , TypeFamilies, NoMonoLocalBinds -{-# LANGUAGE NoIncoherentInstances #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE NoUndecidableInstances #-}+   , NoIncoherentInstances+   , NoMonomorphismRestriction+   , NoUndecidableInstances+   #-}  module Vivid.UGens.Buffer ( @@ -43,7 +45,10 @@ ---   , multiTap    , phasor    , playBuf+   , playBufPoly+    , recordBuf+   , recordBufPoly ---   , scopeOut ---   , shaper      -- In Vivid.UGens.Generators.Granular@@ -70,13 +75,14 @@ --   and 'frames_' for \"Vivid.UGens.Args.numFrames\" localBuf :: Args '["numChans","numFrames"] '[] a => a -> SDBody a Signal localBuf args = do-   mlb <- addUGen $ UGen (UGName_S "MaxLocalBufs") IR [Constant 1] 1+   mlb <- addOrIncrementMaxLocalBufs    numChannels' <- uaArgVal args (Proxy::Proxy "numChans")    numFrames' <- uaArgVal args (Proxy::Proxy "numFrames")    -- Another example where the args in sclang and scsynth are in different orders:    addUGen $ UGen (UGName_S "LocalBuf") IR [numChannels', numFrames', mlb] 1  +{-# DEPRECATED playBuf "use playBufPoly instead (and use bufRateScale and set doneAction)" #-} -- | Unlike in SC, \"doneAction\\" defaults to 2 --  --   Also, the default rate is the 'bufRateScale' of the buffer@@ -93,6 +99,12 @@           -- todo : put bufratescale on all of em if we decide to keep this behavior    defaultRate = bufRateScale $ uaArgVal args (V::V "buf") +playBufPoly :: (Args '["buf"] '["rate","trigger","startPos","loop","doneAction"] a) => Int -> a -> SDBody a [Signal]+playBufPoly numChans args = ($ args) $ makePolyUGen numChans+   "PlayBuf" AR+   (Vs::Vs '["buf","rate","trigger","startPos","loop","doneAction"])+   (rate_ (1::Float), trigger_ ((1)::Float), startPos_ ((0)::Float)+   ,loop_ ((0)::Float), doneAction_ (0::Float)) -- NOTE doneAction is back to 0...! Good idea? (TODO)  -- | Unlike in SC, "doneAction" defaults to 2 and "loop" defaults to 0 recordBuf :: (Args '["buf","in"] '["offset","recLevel","preLevel","run","loop","trigger","doneAction"] a) => a -> SDBody a Signal@@ -102,6 +114,16 @@    -- this is another example of different order:    (offset_ ((0)::Float), recLevel_ ((1)::Float), preLevel_ ((0)::Float), run_ ((1)::Float), loop_ ((0)::Float), trigger_ ((1)::Float), doneAction_ ((2)::Float)) +-- | Unlike in SC, "doneAction" defaults to 2 and "loop" defaults to 0+recordBufPoly :: (Args '["buf","in"] '["offset","recLevel","preLevel","run","loop","trigger","doneAction"] a) => Int -> a -> SDBody a [Signal]+recordBufPoly numChans = makePolyUGen numChans+   "RecordBuf" AR+   (Vs::Vs '["buf","offset","recLevel","preLevel","run","loop","trigger","doneAction","in"])+   -- this is another example of different order:+   (offset_ ((0)::Float), recLevel_ ((1)::Float), preLevel_ ((0)::Float), run_ ((1)::Float), loop_ ((0)::Float), trigger_ ((1)::Float), doneAction_ ((2)::Float))+++ -- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so! bufChannels :: (Args '["buf"] '[] a) => a -> SDBody a Signal bufChannels = makeUGen@@ -122,7 +144,7 @@ --  --   Note you don't need to use "buf_" when you use this bufFrames :: ToSig s as => s -> SDBody' as Signal-bufFrames = (flip (.)) buf_ $ makeUGen+bufFrames = (. buf_) $ makeUGen    "BufFrames" KR    (Vs::Vs '["buf"])    NoDefaults@@ -144,7 +166,7 @@ --  --   Note you don't need to use "buf_" when you use this bufSampleRate :: ToSig s as => s -> SDBody' as Signal-bufSampleRate = (flip (.)) buf_ $ makeUGen+bufSampleRate = (. buf_) $ makeUGen    "BufSampleRate" KR    (Vs::Vs '["buf"])    NoDefaults@@ -155,7 +177,7 @@ --  --   Note you don't need to use "buf_" when you use this bufSamples :: ToSig s as => s -> SDBody' as Signal-bufSamples = (flip (.)) buf_ $ makeUGen+bufSamples = (. buf_) $ makeUGen    "BufSamples" KR    (Vs::Vs '["buf"])    NoDefaults

@@ -174,15 +174,17 @@ -- | Percussive hit --  --   'doneAction' is currently 2 but may either be 0 or 2 in future versions-percGen :: (Args '[] '["attackSecs", "releaseSecs", "level", "curve", "doneAction"] a) => a -> SDBody a Signal+percGen :: (Args '[] '["attackSecs", "releaseSecs", "level", "curve", "doneAction", "gate", "fadeSecs"] a) => a -> SDBody a Signal percGen userArgs = do    level <- uaArgWDef_onlyConst (1::Float) userArgs (V::V "level")    attackTime <- uaArgWDef_onlyConst (0.01::Float) userArgs (V::V "attackSecs")    releaseTime <- uaArgWDef_onlyConst (1::Float) userArgs (V::V "releaseSecs")    curve <- uaArgWDef_onlyConst (-4::Float) userArgs (V::V "curve")    doneAction <- fromEnum <$> uaArgWDef_onlyConst (2::Float) userArgs (V::V "doneAction")+   gate <- uaArgValWDefault 1 userArgs (V::V "gate")+   timeScale <- uaArgValWDefault 1 userArgs (V::V "fadeSecs") -   envGen (env 0 [(level, attackTime), (0, releaseTime)] (Curve_Curve curve)) (DoneAction_AsNum doneAction)+   envGen_wGate gate timeScale (env 0 [(level, attackTime), (0, releaseTime)] (Curve_Curve curve)) (DoneAction_AsNum doneAction)  where    uaArgWDef_onlyConst defaultVal args argName =       uaArgValWDefault defaultVal args argName >>= \case

@@ -33,7 +33,7 @@     -- * FFT functions ----   , pv_add+   , pv_add    , pv_binScramble    , pv_binShift ---   , pv_binWipe@@ -41,10 +41,10 @@ ---   , pv_chainUGen    , pv_conformalMap    , pv_conj----   , pv_copy----   , pv_copyPhase+   , pv_copy+   , pv_copyPhase    , pv_diffuser----   , pv_div+   , pv_div ---   , pv_hainsworthFoote ---   , pv_jensenAndersen    , pv_localMax@@ -58,9 +58,9 @@    , pv_magShift    , pv_magSmear    , pv_magSquared----   , pv_max----   , pv_min----   , pv_mul+   , pv_max+   , pv_min+   , pv_mul    , pv_phaseShift    , pv_phaseShift270    , pv_phaseShift90@@ -70,6 +70,8 @@ ---   , pv_rectComb2    ) where +import Data.ByteString (ByteString)+ import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.UGens.Args@@ -120,9 +122,9 @@ --- unpackFFT = -- frombin: 0 ---- pv_add :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal---- pv_add bufA bufB =-+pv_add :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal+pv_add =+   twoArgUGen "PV_Add"  pv_binScramble :: (Args '["buf"] '["wipe", "width", "trigger"] a) => a -> SDBody a Signal pv_binScramble = makeUGen@@ -160,20 +162,31 @@    (Vs::Vs '["buf"])    NoDefaults ---- pv_copy :: (ToSig bufA as, ToSig bufB as) => SDBody' as Signal---- pv_copy bufA bufB =+pv_copy :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal+pv_copy =+   twoArgUGen "PV_Copy" ---- pv_copyPhase :: (ToSig bufA as, ToSig bufB as) => SDBody' as Signal---- pv_copyPhase bufA bufB =+pv_copyPhase :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal+pv_copyPhase =+   twoArgUGen "PV_CopyPhase" ++twoArgUGen :: (ToSig s0 as, ToSig s1 as) => ByteString -> s0 -> s1 -> SDBody' as Signal+twoArgUGen ugenName s0 s1 = do+   s0' <- toSig s0+   s1' <-  toSig s1+   addMonoUGen $ UGen (UGName_S ugenName) KR [s0', s1'] 1++ pv_diffuser :: (Args '["buf"] '["trigger"] a) => a -> SDBody a Signal pv_diffuser = makeUGen    "PV_Diffuser" KR    (Vs::Vs '["buf", "trigger"])    (trig_ (0::Float)) ---- pv_div :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal---- pv_div bufA bufB =+pv_div :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal+pv_div =+   twoArgUGen "PV_Div"  --- pv_hainsworthFoote :: --- pv_hainsworthFoote =@@ -241,13 +254,17 @@    (Vs::Vs '["buf"])    NoDefaults ---- pv_max :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal---- pv_max bufA bufB = do-   ------ pv_min :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal---- pv_min bufA bufB =---- pv_mul :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal---- pv_mul bufA bufB =+pv_max :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal+pv_max =+   twoArgUGen "PV_Max"++pv_min :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal+pv_min =+   twoArgUGen "PV_Min"++pv_mul :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal+pv_mul =+   twoArgUGen "PV_Mul"  pv_phaseShift :: (Args '["buf", "shift"] '["integrate"] a) => a -> SDBody a Signal pv_phaseShift = makeUGen

@@ -1,5 +1,8 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE+     DataKinds+   , FlexibleContexts+   , OverloadedStrings+   #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -50,6 +53,7 @@ import Vivid.UGens.Args import Vivid.SynthDef.FromUA +import Control.Monad (forM) import qualified Data.ByteString.UTF8 as UTF8 import Data.Monoid import Data.Proxy@@ -151,18 +155,24 @@ --   Each tuple in the list argument is a triple of frequency, amplitude, and ring time --  --   Can only run in 'AR'-klank :: Args '["in"] '[] a => a -> [(Float, Float, Float)] -> SDBody a Signal+klank :: (Args '["in"] '["freqScale", "freqOffset", "decayScale"] a, ToSig freq (SDBodyArgs a), ToSig amp (SDBodyArgs a), ToSig ring (SDBodyArgs a)) => a -> [(freq, amp, ring)] -> SDBody a Signal klank args resonators = do    in' <- uaArgVal args (Proxy::Proxy "in")-   addMonoUGen $ UGen (UGName_S (UTF8.fromString "Klank")) AR (outs in') 1- where-   outs inThing = [-        inThing-         -- These may be added as parameters in the future:-      , Constant 1 -- freqscale-      , Constant 0 -- freqoffset-      , Constant 1 -- decayscale-      ] <> concat [ map Constant [a,b,c] | (a,b,c) <- resonators ]+   freqscale <-  uaArgValWDefault 1 args (Proxy::Proxy "freqScale")+   freqoffset <- uaArgValWDefault 0 args (Proxy::Proxy "freqOffset")+   decayscale <- uaArgValWDefault 1 args (Proxy::Proxy "decayScale")+   resonators' <- forM resonators $ \(freq, amp, ring) -> do+      f <- toSig freq+      a <- toSig amp+      r <- toSig ring+      pure [f, a, r]+   let outs = [+            in'+          , freqscale+          , freqoffset+          , decayscale+          ] <> concat resonators'+   addMonoUGen $ UGen (UGName_S (UTF8.fromString "Klank")) AR outs 1  {- 3 "Klank" - AR (1 outputs)

@@ -1,9 +1,13 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE+     DataKinds+   , OverloadedStrings+   #-} -{-# LANGUAGE NoIncoherentInstances #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE NoUndecidableInstances #-}+{-# LANGUAGE+     NoIncoherentInstances+   , NoMonomorphismRestriction+   , NoUndecidableInstances+   #-}  module Vivid.UGens.Generators.Deterministic ( ---     blip

@@ -1,5 +1,7 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE+     DataKinds+   , OverloadedStrings+   #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -75,7 +77,7 @@ numRunningSynths =    addUGen $ UGen (UGName_S "NumRunningSynths") IR [] 1 --- } This is CPU-intensive: only use for debugging!+-- | This is CPU-intensive: only use for debugging! --  --   First argument is frequency of polling: the number of times per second to poll -- 

@@ -76,11 +76,11 @@ leastChange = leastOrMostChange "LeastChange"  leastOrMostChange :: (ToSig s0 as, ToSig s1 as) => String -> s0 -> s1 -> SDBody' as Signal-leastOrMostChange sdName s0 s1 = do+leastOrMostChange ugenName s0 s1 = do    s0' <- toSig s0    s1' <- toSig s1    calcRate <- (maximum::Ord a=>[a]->a) <$> sequence (map getCalcRate [s0', s1'])-   addUGen $ UGen (UGName_S . UTF8.fromString $ sdName) calcRate [s0',s1'] 1+   addUGen $ UGen (UGName_S . UTF8.fromString $ ugenName) calcRate [s0',s1'] 1  -- | "Converts a linear range of values to an exponential range of values." -- 

@@ -22,6 +22,7 @@ freeVerb = makeUGen    "FreeVerb" AR    (Vs::Vs '["in", "mix", "room", "damp"])+   -- Strangely in SC it's "0.33" instead of (1/3) (greater precision). If we want exact compatibility we should switch to match that:    (mix_ (1/3::Float), room_ (0.5::Float), damp_ (0.5::Float))  --- freeVerb2 ::

@@ -1,7 +1,5 @@--- TODO: get the readme change from the github merge- name:                vivid-version:             0.4.2.4+version:             0.5.0.0 synopsis:            Sound synthesis with SuperCollider description:            Music and sound synthesis with SuperCollider.@@ -64,7 +62,10 @@     , Vivid.Actions.Scheduled     , Vivid.ByteBeat     , Vivid.Envelopes+    , Vivid.GlobalState+    , Vivid.NoGlobalState     , Vivid.NoPlugins+    , Vivid.NoPluginsNoGlobalState     , Vivid.OSC.Bundles     , Vivid.Randomness     , Vivid.SCServer@@ -141,6 +142,9 @@       --    0.11 doesn't exist yet       -- Try: "> 0.9.1.8 && < 0.11"     , bytestring+++    , cereal        -- Lower bound:       --    Just a guess -- 0.4.0.0 is >5 years old