vivid 0.2.0.5 → 0.3.0.0

raw patch · 53 files changed

+1380/−1414 lines, 53 filesdep +directorydep +utf8-stringdep +vivid-oscdep −binarydep ~MonadRandomdep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: directory, utf8-string, vivid-osc, vivid-supercollider

Dependencies removed: binary

Dependency ranges changed: MonadRandom, bytestring, containers, filepath, hashable, mtl, network, process, random, random-shuffle, split, stm, time, transformers

API changes (from Hackage documentation)

Files

• Vivid/Actions.hs +184/−62
• Vivid/Actions/Class.hs +26/−7
• Vivid/Actions/IO.hs +24/−11
• Vivid/Actions/NRT.hs +70/−26
• Vivid/Actions/Scheduled.hs +1/−1
• Vivid/ByteBeat.hs +7/−0
• Vivid/NoPlugins.hs +24/−0
• Vivid/OSC.hs +0/−262
• Vivid/OSC/Bundles.hs +69/−0
• Vivid/OSC/Util.hs +0/−43
• Vivid/Randomness.hs +8/−0
• Vivid/SCServer.hs +93/−48
• Vivid/SCServer/Connection.hs +13/−8
• Vivid/SCServer/State.hs +1/−1
• Vivid/SCServer/Types.hs +35/−33
• Vivid/SynthDef.hs +15/−14
• Vivid/SynthDef/FromUA.hs +64/−34
• Vivid/SynthDef/Literally.hs +0/−377
• Vivid/SynthDef/ToSig.hs +39/−12
• Vivid/SynthDef/Types.hs +4/−78
• Vivid/SynthDef/TypesafeArgs.hs +7/−6
• Vivid/UGens.hs +2/−2
• Vivid/UGens/Algebraic.hs +6/−1
• Vivid/UGens/Analysis.hs +12/−3
• Vivid/UGens/Args.hs +40/−7
• Vivid/UGens/Buffer.hs +38/−17
• Vivid/UGens/Conversion.hs +5/−3
• Vivid/UGens/Convolution.hs +1/−0
• Vivid/UGens/Delays.hs +9/−3
• Vivid/UGens/Demand.hs +6/−5
• Vivid/UGens/Dynamics.hs +3/−2
• Vivid/UGens/Envelopes.hs +15/−11
• Vivid/UGens/Examples.hs +7/−0
• Vivid/UGens/FFT.hs +27/−17
• Vivid/UGens/Filters.hs +1/−0
• Vivid/UGens/Filters/BEQSuite.hs +3/−4
• Vivid/UGens/Filters/Linear.hs +53/−10
• Vivid/UGens/Filters/Nonlinear.hs +2/−1
• Vivid/UGens/Filters/Pitch.hs +1/−0
• Vivid/UGens/Generators/Chaotic.hs +1/−0
• Vivid/UGens/Generators/Deterministic.hs +11/−5
• Vivid/UGens/Generators/SingleValue.hs +3/−2
• Vivid/UGens/Generators/Stochastic.hs +1/−0
• Vivid/UGens/InOut.hs +54/−30
• Vivid/UGens/Info.hs +16/−3
• Vivid/UGens/Maths.hs +5/−4
• Vivid/UGens/Multichannel.hs +48/−8
• Vivid/UGens/Random.hs +1/−0
• Vivid/UGens/Reverbs.hs +1/−0
• Vivid/UGens/SynthControl.hs +16/−3
• Vivid/UGens/Triggers.hs +27/−7
• Vivid/UGens/UserInteraction.hs +4/−1
• vivid.cabal +277/−242

@@ -22,9 +22,33 @@    , synthG    , synthNamed    , synthNamedG+   , newSynthBefore+   , synthBefore+   , newSynthAfter+   , synthAfter+   , newSynthAtHead+   , synthHead+   , synthOn+   , newSynthAtTail+   , synthTail++   , newGroup+   , newGroupBefore+   , newGroupAfter+   , newGroupAtHead+   , newGroupAtTail+   , newParGroup+   , newParGroupBefore+   , newParGroupAfter+   , newParGroupAtHead+   , newParGroupAtTail+    , set    , play    , free+   , freeSynth+   , release+   , releaseIn    , freeBuf    , quitSCServer    , module Vivid.Actions.Class@@ -33,22 +57,28 @@    , module Vivid.Actions.Scheduled     , makeSynth-   , synthWAction    ) 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.OSC import Vivid.SCServer.Connection (closeSCServerConnection)-import Vivid.SCServer.Types (NodeId(..), Node(..), HasNodeId(..), BufferId(..))+import Vivid.SCServer (defaultGroup)+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 qualified Data.ByteString.Char8 as BS8 (pack, ByteString)+import qualified Data.ByteString.UTF8 as UTF8+import Data.ByteString (ByteString) import Data.Int import Data.Monoid @@ -62,6 +92,14 @@ import Vivid.SynthDef.Types import Vivid.UGens.InOut (out) +-- todo: this segfaults if you have a kr output i think:+-- e.g.:+   -- let foo = kOut_mono 100 =<< (phasor (end_ 999) ? KR)+   -- play $ foo+   -- it has the same output as sclang:+   -- putStrLn $ sdLitPretty $ sdToLiteral $ sd () $ foo >> out 0 []+   -- same as:+   -- synthdefcatcher: SynthDef(\a, {Out.kr(100, Phasor.kr(end: 999))}).send(~hsServ) -- | Given a UGen graph, just start playing it right away. --  --   e.g.@@ -75,7 +113,7 @@ --   > play $ 0.2 ~* lpf (in_ whiteNoise, freq_ 440) --  --   and an "out" will be added, in stereo-play :: (VividAction m, MonoOrPoly s) => SDBody' '[] s -> m (Node '[])+play :: (VividAction m, MonoOrPoly s) => SDBody' '[] s -> m (Synth '[]) play monoOrPolyVersion = do    let polyVersion = getPoly monoOrPolyVersion    let sdUGens :: [(UGenName, CalculationRate)]@@ -90,6 +128,8 @@              else do                 foo <- polyVersion                 out (0::Int) $ foo+   -- TODO: maybe 'defineSD'/'sync' first?:+   -- Or maybe that's the job of 'synth' so do it there    synth sdWithOut ()  class MonoOrPoly s where@@ -107,15 +147,38 @@       s' <- s       return [s', s'] +-- | 'G'radually-typed version of 'freeSynth' or 'free'. Note that this+--   allows you to attempt to free a NodeId of a Group as if it were a+--   synth. Be careful!+freeG :: (VividAction m, SynthOrNodeId n) => n -> m ()+freeG (getNodeId -> nodeId) =+   callOSC $ SCCmd.n_free nodeId++free, freeSynth :: VividAction m => Synth a -> m ()+-- | Shorter name for 'freeSynth'+free = freeSynth -- | Immediately stop a synth playing --  --   This can create a \"clipping\" artifact if the sound goes from a high --   amplitude to 0 in an instant -- you can avoid that with e.g. --   'Vivid.UGens.lag' or with an envelope (especially 'envGate')-free :: (VividAction m, HasNodeId n) => n -> m ()-free (getNodeId -> NodeId nodeId) =-   callOSC $ OSC (BS8.pack "/n_free") [ OSC_I nodeId ]+freeSynth = freeG +-- | Assuming your \"gate\" argument is on an EnvGen or similar, will release the synth+--   over the EnvGen-specified fade time+-- +--   If you'd like to specify a fade time in the moment, check out 'releaseIn'+release :: (Elem "gate" args, VividAction m) => Synth args -> m ()+release s = set s (0 ::I "gate")++-- | Assumes your \"gate\" is on an EnvGen or related+-- +--   Specify a fade time and release+releaseIn :: (Elem "gate" args, VividAction m, Real n) => n -> Synth args -> m ()+releaseIn releaseSecs s =+     -- 'abs' but give positive values yo!:+   set s (toI $ negate $ 1 + abs releaseSecs ::I "gate")+ -- | Set the given parameters of a running synth --  --   e.g.@@ -126,14 +189,11 @@ --  --   Any parameters not referred to will be unaffected, and any you specify that don't exist --   will be (silently) ignored-set :: (VividAction m, Subset (InnerVars params) sdArgs, VarList params) => Node sdArgs -> params -> m ()-set (Node (NodeId nodeId)) params = do+set :: (VividAction m, Subset (InnerVars params) sdArgs, VarList params) => Synth sdArgs -> params -> m ()+set (Synth nodeId) params = do    let (as, _) = makeTypedVarList params-   callOSC $ OSC (BS8.pack "/n_set") $ OSC_I nodeId : paramList as- where-   paramList :: [(String, Float)] -> [OSCDatum]-   paramList ps = concatMap (\(k,v)->[OSC_S k,OSC_F v]) $-      map (first BS8.pack) ps+   -- HERE:+   callOSC $ SCCmd.n_set nodeId [ (k, Right v) | (k, v) <- as ]  -- | Create a real live music-playing synth from a boring, dead SynthDef. -- @@ -157,23 +217,20 @@ --   ...you've got no way to refer to the first synth you've created, and if you --   want to stop it you have to 'cmdPeriod' -- ---   (If you want to interop with SC's language, use 'sdNamed' and 'synthNamed')-synth :: (VividAction m, VarList params, Subset (InnerVars params) args) => SynthDef args -> params -> m (Node args)+--   (If you want to interop with SC's language (or other SC clients),+--   use 'sdNamed' and 'synthNamed')+synth :: (VividAction m, VarList params, Subset (InnerVars params) args) => SynthDef args -> params -> m (Synth args) synth theSD params = do-   Node <$> synthG theSD params--synthWAction :: (VividAction m, VarList params, Subset (InnerVars params) args) => SynthDef args -> params -> Int32 -> m (Node args)-synthWAction theSD params actionNum = do-   Node <$> synthG_wAction theSD params actionNum+   Synth <$> synthG theSD params --- | Make a synth, "G"radually typed -- doesn't check that _ is a subset of _+-- | Make a synth, \"G\"radually typed -- doesn't check that _ is a subset of _ --   Useful e.g. if you want to send a bunch of args, some of which may be discarded --  --   (Personally I'd recommend not using this function) --  --   >>>  let s = undefined :: SynthDef '["ok"] --   >>>  synth s (4::I "ok", 5::I "throwaway")---   >>>     <interactive>:275:7:+--   >>>     <interactive>: --   >>>         Could not deduce (Elem "ignore" '[]) arising from a use of ‘synth’ --   >>>  synthG s (4::I "ok", 5::I "throwaway") --   >>>   (works)@@ -181,58 +238,123 @@ synthG theSD params = do    defineSD theSD -- 'defineSD' only defines it if it hasn't been yet -   let synthName = case theSD of+   makeSynth (synthName theSD) params SCCmd.AddToHead defaultGroup++synthName :: SynthDef a -> ByteString+synthName theSD = case theSD of         SynthDef (SDName_Named n) _ _ -> n         SynthDef SDName_Hash _ _ -> getSDHashName theSD-   makeSynth synthName params 0 +synthNamed :: (VividAction m, VarList params) => String -> params -> m (Synth a)+synthNamed name params = Synth <$>+   makeSynth (UTF8.fromString name) params SCCmd.AddToHead defaultGroup -synthG_wAction :: (VividAction m, VarList params) => SynthDef a -> params -> Int32 -> m NodeId-synthG_wAction theSD params actionNum = do-   defineSD theSD -- 'defineSD' only defines it if it hasn't been yet+synthNamedG :: (VividAction m, VarList params) => String -> params -> m NodeId+synthNamedG name params =+   makeSynth (UTF8.fromString name) params SCCmd.AddToHead defaultGroup -   let synthName = case theSD of-        SynthDef (SDName_Named n) _ _ -> n-        SynthDef SDName_Hash _ _ -> getSDHashName theSD-   makeSynth synthName params actionNum+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+   pure nodeId+ where+  -- HERE:+   paramList :: [(ByteString, Either Int32 Float)]+   paramList =+      [ (UTF8.fromString k, Right v) | (k, v) <- (fst $ makeTypedVarList params) ]  -synthNamed :: (VividAction m, VarList params) => String -> params -> m (Node a)-synthNamed name params = Node <$> makeSynth (BS8.pack name) params 0+-- Can dedupe all these!: -synthNamedG :: (VividAction m, VarList params) => String -> params -> m NodeId-synthNamedG name params = makeSynth (BS8.pack name) params 0+-- TODO: instead of e.g. 'synthBefore', 'parGroupBefore' etc, can just do 'parGroup AddBefore' --- | addAction options, from SC docs:--- ---   - 0: add the new node to the the head of the group specified by the add target ID.---   - 1: add the new node to the the tail of the group specified by the add target ID.---   - 2: add the new node just before the node specified by the add target ID.---   - 3: add the new node just after the node specified by the add target ID.---   - 4: the new node replaces the node specified by the add target ID. The target node is freed.-makeSynth :: (VividAction m, VarList params) => BS8.ByteString -> params -> Int32 -> m NodeId-makeSynth synthName params addAction = do-   nodeId@(NodeId nn) <- newNodeId-   callOSC $ OSC (BS8.pack "/s_new") $ [-        OSC_S $ synthName-      , OSC_I nn-      , OSC_I addAction-       -- the target of the add action:-      , OSC_I 1-      ] <> paramList+-- | Create a synth at the head of the target group (see \"Order of Execution\")+newSynthAtHead+  , synthHead+  , synthOn+  , newSynthAtTail+  , synthTail+  :: (VividAction m, VarList params, Subset (InnerVars params) args, IsGroup group)+  => group -> SynthDef args -> params -> m (Synth args)+newSynthAtHead targetNode theSD params = do+   defineSD theSD+   Synth <$> makeSynth (synthName theSD) params SCCmd.AddToHead targetNode+-- | Alias for 'newSynthAtHead'+synthHead = newSynthAtHead+-- | Alias for 'newSynthAtHead'+synthOn = newSynthAtHead+-- | Create a synth at the tail of the target group (see \"Order of Execution\")+newSynthAtTail targetNode theSD params = do+   defineSD theSD+   Synth <$> makeSynth (synthName theSD) params SCCmd.AddToTail targetNode+-- | Alias for 'newSynthAtTail'+synthTail = newSynthAtTail -   return nodeId- where-   paramList :: [OSCDatum]-   paramList = concatMap (\(k, v) -> [OSC_S k, OSC_F v]) $-      map (first BS8.pack) (fst $ makeTypedVarList params)+-- | Create a synth just before the target node (see \"Order of Execution\")+newSynthBefore+  , synthBefore+  , newSynthAfter+  , synthAfter+  :: (VividAction m, VarList params, Subset (InnerVars params) args, IsNode node)+  => node -> SynthDef args -> params -> m (Synth args)+newSynthBefore targetNode theSD params = do+   defineSD theSD+   Synth <$> makeSynth (synthName theSD) params SCCmd.AddBefore targetNode+-- | Alias for 'newSynthBefore'+synthBefore = newSynthBefore+-- | Create a synth just after the target node (see \"Order of Execution\")+newSynthAfter targetNode theSD params = do+   defineSD theSD+   Synth <$> makeSynth (synthName theSD) params SCCmd.AddAfter targetNode+-- | Alias for 'newSynthAfter'+synthAfter = newSynthAfter  -- | Stop the SuperCollider server quitSCServer :: IO () quitSCServer = do-   callOSC $ OSC "/quit" []+   callOSC $ SCCmd.quit    closeSCServerConnection +-- | Synchronous freeBuf :: VividAction m => BufferId -> m ()-freeBuf (BufferId bufId) =-   callOSC $ OSC "/b_free" [OSC_I bufId]+freeBuf bufId = oscWSync $ \syncId ->+   callOSC $ SCCmd.b_free bufId (Just $ SCCmd.sync syncId)++newGroup :: VividAction m => m Group+newGroup = newGroupAtHead defaultGroup++newParGroup :: VividAction m => m ParGroup+newParGroup = newParGroupAtHead defaultGroup++newGroupBefore, newGroupAfter :: (IsNode node, VividAction m) => node -> m Group+newGroupBefore = makeGroup SCCmd.AddBefore+newGroupAfter = makeGroup SCCmd.AddAfter++newGroupAtHead, newGroupAtTail :: (IsGroup group, VividAction m) => group -> m Group+newGroupAtHead = makeGroup SCCmd.AddToHead+newGroupAtTail = makeGroup SCCmd.AddToTail++newParGroupBefore, newParGroupAfter :: (IsNode node, VividAction m) => node -> m ParGroup+newParGroupBefore = makeParGroup SCCmd.AddBefore+newParGroupAfter = makeParGroup SCCmd.AddAfter++newParGroupAtHead, newParGroupAtTail :: (IsGroup group, VividAction m) => group -> m ParGroup+newParGroupAtHead = makeParGroup SCCmd.AddToHead+newParGroupAtTail = makeParGroup SCCmd.AddToTail++makeGroup :: (IsNode target, VividAction m) => SCCmd.AddAction -> target -> m Group+makeGroup = makeSomeKindaGroup SCCmd.g_new Group++makeParGroup :: (IsNode target, VividAction m) => SCCmd.AddAction -> target -> m ParGroup+makeParGroup = makeSomeKindaGroup SCCmd.p_new ParGroup++type GroupCmd = NodeId -> SCCmd.AddAction -> NodeId -> OSC++makeSomeKindaGroup :: (IsNode target, VividAction m) => (GroupCmd) -> (NodeId -> group) -> SCCmd.AddAction -> target -> m group+makeSomeKindaGroup createCommand constructor addAction (getNodeId -> targetNode) = do+   nodeId <- newNodeId+   callOSC $ createCommand nodeId addAction targetNode+   sync+   pure $ constructor nodeId+

@@ -6,6 +6,7 @@ --   to it!  {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE Rank2Types #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -13,16 +14,21 @@  module Vivid.Actions.Class (      VividAction(..)+   -- , VA    , callOSCAndSync+   , oscWSync    ) where +import Vivid.SC.Server.Types (BufferId, NodeId, SyncId(..))+import qualified Vivid.SC.Server.Commands as SCCmd+ import Vivid.OSC-import Vivid.SCServer.State (BufferId, NodeId, SyncId(..)) import Vivid.SynthDef.Types (SynthDef) -import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS8 (pack) 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 @@ -48,7 +54,7 @@    waitForSync :: SyncId -> m ()     -- | Wait, in seconds-   wait :: RealFrac n => n -> m ()+   wait :: Real n => n -> m ()     getTime :: m Timestamp @@ -70,7 +76,20 @@ callOSCAndSync :: VividAction m => OSC -> m () callOSCAndSync message = do    now <- getTime-   sid@(SyncId syncId) <- newSyncId+   syncId <- newSyncId    callBS $ encodeOSCBundle $-      OSCBundle now [Right message, Right $ OSC (BS8.pack "/sync") [OSC_I syncId]]-   waitForSync sid+      OSCBundle now [Right message, Right $ SCCmd.sync syncId]+   waitForSync syncId++-- | +-- +--   Maybe can dedupe with 'callOSCAndSync'+oscWSync :: VividAction m => (SyncId -> m ()) -> m ()+oscWSync actionFromId = do+   syncId <- newSyncId+   actionFromId syncId+   waitForSync syncId+++-- type VA x = forall m. VividAction m => m x+

@@ -30,16 +30,20 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ViewPatterns #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoUndecidableInstances #-}  module Vivid.Actions.IO (+     defineSDFromFile    ) where  import Vivid.Actions.Class import Vivid.OSC (OSC(..), OSCDatum(..), encodeOSC, Timestamp(..), utcToTimestamp)+-- import Vivid.SC.SynthDef.Types (CalculationRate(..))+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.SynthDef@@ -48,10 +52,11 @@ import Control.Concurrent.STM (readTVarIO, atomically, modifyTVar) import Control.Monad import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.ByteString as BS (writeFile) import Data.Hashable import qualified Data.Set as Set import Data.Time (getCurrentTime)+import System.Directory (getTemporaryDirectory)  import Network.Socket (withSocketsDo) -- We add this everywhere for Windows compat import Network.Socket.ByteString (send)@@ -64,6 +69,7 @@    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       return () @@ -71,15 +77,15 @@    sync = do       wait (0.01 :: Float) -- Just to make sure you don't "sync" before calling                            --   the command you want to sync (temporary)-      sid@(SyncId syncId) <- newSyncId-      callOSC $ OSC "/sync" [OSC_I syncId]+      sid <- newSyncId+      callOSC $ SCCmd.sync sid       waitForSync sid     waitForSync :: SyncId -> IO ()    waitForSync = waitForSync_io -   wait :: (RealFrac n) => n -> IO ()-   wait t = threadDelay $ round (t * 10^(6::Int))+   wait :: Real n => n -> IO ()+   wait t = threadDelay $ round (realToFrac (t * 10^(6::Int)) :: Double)     getTime :: IO Timestamp    getTime = utcToTimestamp <$> getCurrentTime@@ -108,11 +114,18 @@       hasBeenDefined <- (((name, hash synthDef) `Set.member`) <$>) $          readTVarIO (_scServerState_definedSDs scServerState)       unless hasBeenDefined $ do-         syncId@(SyncId syncIdInt) <- newSyncId-         callOSC $ OSC (BS8.pack "/d_recv") [-              OSC_B $ encodeSD synthDef-            , OSC_B . encodeOSC $ OSC "/sync" [OSC_I syncIdInt]-            ]-         waitForSync syncId+         oscWSync $ \syncId ->+            callOSC $+               SCCmd.d_recv [sdToLiteral synthDef] (Just $ SCCmd.sync syncId)          atomically $ modifyTVar (_scServerState_definedSDs scServerState) $             ((name, hash synthDef) `Set.insert`)++-- | Synchronous+defineSDFromFile :: SynthDef a -> IO ()+defineSDFromFile theSD = do+   tempDir <- getTemporaryDirectory+   let fName = tempDir++"/" ++ show (hash theSD) ++ ".scsyndef"+   BS.writeFile fName $ encodeSD theSD+   oscWSync $ \syncId ->+      callOSC $ SCCmd.d_load fName (Just $ SCCmd.sync syncId)+

@@ -28,22 +28,25 @@    , defaultNRTArgs    ) where +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)+import Vivid.SynthDef (encodeSD, sdToLiteral) import Vivid.SynthDef.Types  import Control.Applicative-import Control.Arrow (first, second)+-- import Control.Arrow (first, second) 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.Char8 as BS8 (pack)+import qualified Data.ByteString.UTF8 as UTF8 import Data.Char (toLower) import Data.Hashable (hash) import qualified Data.Map as Map@@ -55,18 +58,20 @@ import System.Process (system) import Prelude -type NRT = StateT (Timestamp, Map Timestamp [Either ByteString OSC]) IO+-- 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  instance VividAction NRT where    callOSC :: OSC -> NRT ()    callOSC message = do       now <- getTime-      modify (second (Map.insertWith (<>) now [Right message]))+      modify ((\f (a,b,c)->(a,b,f c)) (Map.insertWith (<>) now [Right message]))     callBS :: ByteString -> NRT ()    callBS message = do       now <- getTime-      modify (second (Map.insertWith (<>) now [Left message]))+      modify $ \(a,b,x) ->+         (a, b, Map.insertWith (<>) now [Left message] x)     sync :: NRT ()    sync = return ()@@ -74,11 +79,13 @@    waitForSync :: SyncId -> NRT ()    waitForSync _ = return () -   wait :: (RealFrac n) => n -> NRT ()-   wait t = modify (first (`addSecs` realToFrac t))+   wait :: Real n => n -> NRT ()+   wait t = modify $ \(oldT, maxT, c) ->+      let newT = oldT `addSecs` realToFrac t+      in (newT, Maximum newT `max` maxT, c)     getTime :: NRT Timestamp-   getTime = fst <$> get+   getTime = (\(t,_,_) -> t) <$> get     newBufferId :: NRT BufferId    newBufferId = liftIO newBufferId@@ -91,17 +98,16 @@     fork :: NRT () -> NRT ()    fork action = do-      (timeOfFork, _) <- get+      (timeOfFork, oldMaxTime, _) <- get       action-      modify (first (\_ -> timeOfFork))+      modify $ \(_timeAfterFork_ignore, newMaxTime, c) ->+           -- this 'max' probably isn't necessary:+         (timeOfFork, newMaxTime `max` oldMaxTime :: Maximum Timestamp, c)     defineSD :: SynthDef a -> NRT ()    defineSD synthDef = do-      modify . second $ Map.insertWith mappendIfNeeded (Timestamp 0) [-           Right $ OSC (BS8.pack "/d_recv") [-                OSC_B $ encodeSD synthDef-              , OSC_I 0-              ]+      modify . (\f (a,b,c)->(a,b,f c)) $ Map.insertWith mappendIfNeeded (Timestamp 0) [+           Right $ SCCmd.d_recv [sdToLiteral synthDef] Nothing          ]     where       mappendIfNeeded :: (Ord a) {- , Monoid m)-} => [a] -> [a] -> [a]@@ -112,8 +118,10 @@  runNRT :: NRT a -> IO [OSCBundle] runNRT action = do-   (_, protoBundles) <- execStateT action (Timestamp 0, Map.empty)-   return [ OSCBundle t as | (t, as) <- Map.toList protoBundles ]+   (_, Maximum maxTSeen, protoBundles_woLast)+      <- execStateT action (Timestamp 0, Maximum (Timestamp 0), Map.empty)+   let protoBundles = Map.insertWith (<>) maxTSeen [] protoBundles_woLast+   return [ OSCBundle t as | (t, as) <- Map.toAscList protoBundles ]   -- | Generate a file of actions that SC can use to do NRT with.@@ -132,6 +140,9 @@ -- | Generate an audio file from an NRT action -- this can write songs far faster --   than it would take to play them. -- +--   This uses 'defaultNRTArgs' for its sample rate, number of channels, etc.+--   If you want to use args other than the default, use 'writeNRTWith'.+--  --   The file type is detected from its extension. --   The extensions supported at the moment are .aif, .aiff, and .wav -- @@ -153,19 +164,33 @@       ExitSuccess -> return ()       ExitFailure _ -> error "No 'scsynth' found! Be sure to put it in your $PATH"    let tempFile = "/tmp/vivid_nrt_" <> (show . hash) contents <> ".osc"-       !fileType = case map toLower $ takeExtension fPath of-          ".aif" -> "AIFF"-          ".aiff" -> "AIFF"-          ".wav" -> "WAV"-          _ -> error "The only file extensions we currently understand are .wav, .aif, and .aiff"+       !fileType =+          case Map.lookup (map toLower $ takeExtension fPath) extensionMap of+             Just x -> x+             Nothing -> error $+                "The only file extensions we currently understand are: "+                ++ show (Map.keys extensionMap)+       extensionMap = Map.fromList [+            (".aif", "AIFF")+          , (".aiff", "AIFF")+          , (".wav", "WAV")+            -- todo: these formats seem not to work:+          -- ".flac" -> "FLAC"+          -- ".ogg" -> "vorbis"+          ]     BS.writeFile tempFile contents    ExitSuccess <- system $ mconcat [         --  ${SHELL}-        "/bin/sh -c \"scsynth -N "+        "/bin/sh -c "+      , " \"" -- Note these beginning and ending quotes+      , " scsynth"+      , " -o ", show $ _nrtArgs_numChans nrtArgs+      , " -N "       , tempFile       , " _ '", fPath, "' "-      , show $ _nrtArgs_sampleRate nrtArgs," ", fileType, " int16\""+      , show $ _nrtArgs_sampleRate nrtArgs," ", fileType, " int16 "+      , " \""       ]    return () @@ -173,8 +198,27 @@ data NRTArgs    = NRTArgs {     _nrtArgs_sampleRate :: Int+   ,_nrtArgs_numChans :: Int    }  deriving (Show, Read, Eq, Ord)  defaultNRTArgs :: NRTArgs-defaultNRTArgs = NRTArgs 44100+defaultNRTArgs = NRTArgs {+    _nrtArgs_sampleRate = 48000+   ,_nrtArgs_numChans = 2+   }++-- Given an explicit type and tag so we don't accidentally  get the wrong element out of the tuple anywhere:+newtype Maximum a = Maximum a++instance (Eq a, Ord a) => Ord (Maximum a) where+   compare (Maximum a) (Maximum b) = compare a b+   Maximum a <= Maximum b = a <= b+   Maximum a < Maximum b = a < b+   Maximum a > Maximum b = a > b+   Maximum a >= Maximum b = a >= b+   max (Maximum a) (Maximum b) = Maximum $ max a b+   min (Maximum a) (Maximum b) = Maximum $ min a b++instance Eq a => Eq (Maximum a) where+   Maximum a == Maximum b = a == b

@@ -57,7 +57,7 @@    waitForSync :: SyncId -> Scheduled ()    waitForSync _ = return () -- always right? -   wait :: (RealFrac n) => n -> Scheduled ()+   wait :: Real n => n -> Scheduled ()    wait t = modify (`addSecs` realToFrac t)     getTime :: Scheduled Timestamp

@@ -2,6 +2,7 @@ --   names as in "Control.Arrow"  {-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ExtendedDefaultRules #-}  module Vivid.ByteBeat (      (&&&)@@ -15,7 +16,9 @@    , baseThing    ) where + import Vivid.SynthDef+-- import Vivid.SynthDef.ToSig import Vivid.UGens.Algebraic import Vivid.UGens.Args import Vivid.UGens.Generators.Deterministic (impulse)@@ -23,9 +26,13 @@  (&&&), (|||), (>>>), (<<<)    :: (ToSig s0 a, ToSig s1 a) => s0 -> s1 -> SDBody' a Signal+-- | Bitwise @and@ (&&&) = biOp BitAnd+-- | Bitwise @or@ (|||) = biOp BitOr+-- | Bit shift right (>>>) = biOp ShiftRight+-- | Bit shift left (<<<) = biOp ShiftLeft -- Also 'xor' from Vivid.UGens.Algebraic 

@@ -24,19 +24,30 @@    , 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@@ -52,8 +63,21 @@ import Control.Monad import Control.Monad.Random import Data.ByteString (ByteString)+import Data.Function ((&)) import Data.Int import Data.Monoid import System.Random  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,262 +0,0 @@--- | __You probably don't need to use this directly__--- ---   Representation of Open Sound Control data--{-# OPTIONS_HADDOCK show-extensions #-}--{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}--{-# LANGUAGE NoRebindableSyntax #-}-{-# LANGUAGE NoIncoherentInstances #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE NoUndecidableInstances #-}--module Vivid.OSC (-     OSC(..)-   , OSCDatum(..)--   , encodeOSC-   , decodeOSC--   , Timestamp(..)-   , OSCBundle(..)--   , encodeOSCBundle-   , encodeOSCBundles-   -- Someone implement this for me plz!:-   -- , decodeBundle--   , encodeTimestamp-   , utcToTimestamp--   , addSecs-   , diffTimestamps--   , initTreeCommand-   ) where--import Vivid.OSC.Util---- import Control.DeepSeq (NFData, rnf)-import Data.Binary (encode, decode)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS (length, drop, take, elemIndex, replicate, concat)-import qualified Data.ByteString.Char8 as BS8 (unpack, pack)-import qualified Data.ByteString.Lazy as BSL (toStrict, fromStrict, concat, ByteString)-import Data.Int (Int32)-import qualified Data.List as L-import Data.Monoid-import Data.Time (UTCTime(..), fromGregorian, secondsToDiffTime, diffUTCTime)-import Data.Word---- | An OSC message, e.g.--- ---   > OSC "/n_free" [OSC_I 42]-data OSC-   = OSC ByteString [OSCDatum]- deriving (Show, Read, Eq, Ord)--data OSCDatum-   = OSC_I Int32-   | OSC_S ByteString-   | OSC_F Float-   | OSC_D Double -- ^ This isn't a base type in the OSC standard but the response message from "/status" uses it...-{--   | OSC_I8 Int8-   | OSC_I16 Int16--}-   | OSC_B ByteString-   -- OSC_T Timestamp -- ^ From the OSC 1.1 spec- deriving (Show, Read, Eq, Ord)---- | This is stored as the number of seconds since Jan 1 1900. You can get---   it with 'Vivid.Actions.Class.getTime'-newtype Timestamp = Timestamp Double-   deriving (Show, Read, Eq, Ord)--data OSCBundle-   = OSCBundle Timestamp [Either ByteString OSC]- deriving (Show, Read, Eq)---- formerly known as 'someShit':-encodeOSC :: OSC -> ByteString-encodeOSC (OSC url args) = BSL.toStrict $ BSL.concat $ [-    encodeDatum (OSC_S url)-   ,encodeDatum (OSC_S ("," <> BS.concat (map toTypeChar args)))-   ] <> map encodeDatum args-  where-    toTypeChar (OSC_I _) = "i"-    toTypeChar (OSC_S _) = "s"-    toTypeChar (OSC_F _) = "f"-    toTypeChar (OSC_B _) = "b"-    toTypeChar (OSC_D _) = "d"--encodeDatum :: OSCDatum -> BSL.ByteString-encodeDatum (OSC_I i) = encode i-encodeDatum (OSC_S s) = BSL.fromStrict $-   s <> BS.replicate (align (BS.length s + 1) + 1) 0-encodeDatum (OSC_F f) = (encode . floatToWord) f-encodeDatum (OSC_D d) = (encode . doubleToWord) d-encodeDatum (OSC_B b) = mconcat [-    -- 4 bytes which describe the size of the blob:-     encode (fromIntegral (BS.length b) :: Int32)-    -- the blob itself:-   , BSL.fromStrict b-    -- padding:-   , BSL.fromStrict (BS8.pack (replicate  (align (BS.length b)) '\NUL'))-   ]--decodeDatumWithPadding :: Char -> ByteString -> OSCDatum-decodeDatumWithPadding 'i' b =-   OSC_I (decode $ BSL.fromStrict b)-decodeDatumWithPadding 'f' b =-   OSC_F (wordToFloat . decode $ BSL.fromStrict b)-decodeDatumWithPadding 's' b =-   OSC_S  $ BS.take (numBytesWithoutPadding 's' b)  b-decodeDatumWithPadding 'b' b =-   OSC_B $ BS.take (numBytesWithoutPadding 'b' b) $ BS.drop 4 b-decodeDatumWithPadding 'd' b =-   OSC_D (wordToDouble . decode $ BSL.fromStrict b)-decodeDatumWithPadding c b =-   error $ "unknown character " <> show c <> ": " <> show b--numBytesWithoutPadding :: Char -> ByteString -> Int-numBytesWithoutPadding 'i' _ = 4-numBytesWithoutPadding 'f' _ = 4-numBytesWithoutPadding 'd' _ = 8-numBytesWithoutPadding 's' b = case BS.elemIndex 0 $ b of-   Just x -> fromIntegral x-   Nothing -> error $ "weirdness on " <> show b-numBytesWithoutPadding 'b' b = fromIntegral $-   (decode $ BSL.fromStrict $ BS.take 4 b :: Int32)-numBytesWithoutPadding c b =-   error $ "vivid: unknown OSC character " <> show c <> ": " <> show b--numBytesWithPadding :: Char -> ByteString -> Int-numBytesWithPadding 'i' _ = 4-numBytesWithPadding 'f' _ = 4-numBytesWithPadding 'd' _ = 8-numBytesWithPadding 's' b =-   let n = (numBytesWithoutPadding 's' b) + 1-   in n + (align n)-numBytesWithPadding 'b' b =-   let n = numBytesWithoutPadding 'b' b-   in n + align n + 4-numBytesWithPadding c b =-   error $ "vivid: unknown OSC character " <> show c <> ": " <> show b--decodeOSCData :: [Char] -> ByteString -> [OSCDatum]-decodeOSCData [] "" = []-decodeOSCData [] leftover = error $ "leftover bytes: " <> show leftover-decodeOSCData (t:ypes) blob =-   (:) datum-       (decodeOSCData ypes (BS.drop (numBytesWithPadding t blob) blob))- where-   datum = decodeDatumWithPadding t thisBlob-   thisBlob = BS.take (numBytesWithPadding t blob) blob--decodeOSC :: ByteString -> OSC-decodeOSC b =-   let sizeOfURL = numBytesWithoutPadding 's' b-       storageOfURL = numBytesWithPadding 's' b--       url = BS.take sizeOfURL b--       -- typeDesc is like ",issif"-       sizeOfTypeDesc = numBytesWithoutPadding 's' $ BS.drop storageOfURL b-       storageOfTypeDesc = numBytesWithPadding 's' $ BS.drop storageOfURL b-       (',':typeDesc) = BS8.unpack $ BS.take sizeOfTypeDesc $-          BS.drop storageOfURL b--       rest = BS.drop (storageOfURL + storageOfTypeDesc) $ b--   in OSC url $ decodeOSCData typeDesc rest--encodeOSCBundle :: OSCBundle -> ByteString-encodeOSCBundle (OSCBundle time messages) = mconcat [-     "#bundle\NUL"-   , encodeTimestamp time-   , (mconcat . map (addLength . either id encodeOSC)) messages-   ]---- | Encode OSC bundles, specifically for NRT synthesis.---   (It's more than just \"mconcat . map 'encodeOSCBundle'\").--- ---   Note also that the last action is when the song ends - so if you want---   e.g. a note to hold at the end you need to add a "wait"-encodeOSCBundles :: [OSCBundle] -> ByteString-encodeOSCBundles bundles =-   mconcat . map (addLength . encodeOSCBundle) $ withEnd- where-   sortedBundles :: [OSCBundle]-   sortedBundles =-      L.sortBy (\(OSCBundle t0 _) (OSCBundle t1 _) -> compare t0 t1) bundles-   sortedBundlesWithDefinitionsFirst :: [OSCBundle]-   sortedBundlesWithDefinitionsFirst =-      map putDefinitionsFirst joinedByTime-    where-      -- Note we aren't assuming there aren't bundles with the same timestamp.-      -- (Which isnt an issue if we got the bundles with 'runNRT', but it's good-      -- to check):-      joinedByTime :: [OSCBundle]-      joinedByTime =-         (flip map) groupedByTime $ \case-            as@(OSCBundle t _:_) ->-               OSCBundle t (concatMap (\(OSCBundle _ a) -> a) as)-            [] -> error "Should be impossible"-      groupedByTime :: [[OSCBundle]]-      groupedByTime =-         L.groupBy (\(OSCBundle t0 _) (OSCBundle t1 _) -> t1 == t0) sortedBundles--      -- If there are "/d_recv" actions and other actions at the same timestamp, we-      -- put the "/d_recv"s before the other actions:-      putDefinitionsFirst :: OSCBundle -> OSCBundle-      putDefinitionsFirst (OSCBundle t actions) = OSCBundle t $ (\(a,b)->a<>b) $-         (flip L.partition) actions $ \case-            Right (OSC "/d_recv" _) -> True-            _ -> False-   lastTimestamp = (\(OSCBundle t _) ->t) $ last sortedBundles--   withEnd = mconcat [-       [OSCBundle (Timestamp 0) [Right initTreeCommand]]-      ,sortedBundlesWithDefinitionsFirst-      ,[OSCBundle lastTimestamp [Right $ OSC "" []]]-      ]--addLength :: ByteString -> ByteString-addLength bs =-   BSL.toStrict (encode (toEnum (BS.length bs) :: Word32)) <> bs--encodeTimestamp :: Timestamp -> ByteString-encodeTimestamp (Timestamp time) =-   BSL.toStrict $ encode $ (round (time * 2^(32::Int)) :: Word64)--utcToTimestamp :: UTCTime -> Timestamp-utcToTimestamp utcTime =-   let startOfTheCentury =-          UTCTime (fromGregorian 1900 1 1) (secondsToDiffTime 0)-   in Timestamp . realToFrac $ diffUTCTime utcTime startOfTheCentury--addSecs :: Timestamp -> Double -> Timestamp-addSecs (Timestamp t) secs = Timestamp (t + secs)--diffTimestamps :: Timestamp -> Timestamp -> Double-diffTimestamps (Timestamp t1) (Timestamp t0) = t1 - t0--{--instance NFData OSCDatum where-   rnf (OSC_I x) = rnf x-   rnf (OSC_F x) = rnf x-   rnf (OSC_S x) = rnf x-{--   rnf (OSC_I8 x) = rnf x-   rnf (OSC_I16 x) = rnf x--}-   rnf (OSC_B x) = rnf x--}--initTreeCommand :: OSC-initTreeCommand = OSC "/g_new" [OSC_I 1, OSC_I 0, OSC_I 0]

@@ -0,0 +1,69 @@+-- | Vivid-specific OSC Bundle encoding++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Vivid.OSC.Bundles (+     encodeOSCBundles+   , initTreeCommand+   ) where++import Vivid.OSC+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++-- | Encode OSC bundles, specifically for NRT synthesis.+--   (It's more than just \"mconcat . map 'encodeOSCBundle'\").+-- +--   Note also that the last action is when the song ends - so if you want+--   e.g. a note to hold at the end you need to add a "wait"+encodeOSCBundles :: [OSCBundle] -> ByteString+encodeOSCBundles bundles =+   mconcat . map (encodedOSC_addLength . encodeOSCBundle) $ withEnd+ where+   sortedBundles :: [OSCBundle]+   sortedBundles =+      L.sortBy (\(OSCBundle t0 _) (OSCBundle t1 _) -> compare t0 t1) bundles+   sortedBundlesWithDefinitionsFirst :: [OSCBundle]+   sortedBundlesWithDefinitionsFirst =+      map putDefinitionsFirst joinedByTime+    where+      -- Note we aren't assuming there aren't bundles with the same timestamp.+      -- (Which isnt an issue if we got the bundles with 'runNRT', but it's good+      -- to check):+      joinedByTime :: [OSCBundle]+      joinedByTime =+         (flip map) groupedByTime $ \case+            as@(OSCBundle t _:_) ->+               OSCBundle t (concatMap (\(OSCBundle _ a) -> a) as)+            [] -> error "Should be impossible"+      groupedByTime :: [[OSCBundle]]+      groupedByTime =+         L.groupBy (\(OSCBundle t0 _) (OSCBundle t1 _) -> t1 == t0) sortedBundles++      -- If there are "/d_recv" actions and other actions at the same timestamp, we+      -- put the "/d_recv"s before the other actions:+      putDefinitionsFirst :: OSCBundle -> OSCBundle+      putDefinitionsFirst (OSCBundle t actions) = OSCBundle t $ (\(a,b)->a<>b) $+         (flip L.partition) actions $ \case+            Right (OSC "/d_recv" _) -> True+            _ -> False+   lastTimestamp = (\(OSCBundle t _) ->t) $ last sortedBundles++   withEnd = mconcat [+       [OSCBundle (Timestamp 0) [Right initTreeCommand]]+      ,sortedBundlesWithDefinitionsFirst+      ,[OSCBundle lastTimestamp [Right $ OSC "" []]]+      ]++++initTreeCommand :: OSC+initTreeCommand =+   SCCmd.g_new (NodeId 1) SCCmd.AddToHead (NodeId 0)+

@@ -1,43 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}--{-# LANGUAGE NoRebindableSyntax #-}-{-# LANGUAGE NoIncoherentInstances #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE NoUndecidableInstances #-}--module Vivid.OSC.Util (-     align-   , floatToWord-   , wordToFloat-   , doubleToWord-   , wordToDouble-   ) where--import Data.Bits ((.&.), complement, Bits)-import qualified Foreign as F-import System.IO.Unsafe (unsafePerformIO)---- from hosc:-align :: (Num i,Bits i) => i -> i-{-# INLINE align #-}-align n = ((n + 3) .&. complement 3) - n----- from data-binary-ieee754:-floatToWord :: Float -> F.Word32-floatToWord = coercionThing--wordToFloat :: F.Word32 -> Float-wordToFloat = coercionThing--doubleToWord :: Double -> F.Word64-doubleToWord = coercionThing--wordToDouble :: F.Word64 -> Double-wordToDouble = coercionThing---coercionThing :: (F.Storable a, F.Storable b) => a -> b-coercionThing x = unsafePerformIO $ F.alloca $ \buf -> do-   F.poke (F.castPtr buf) x-   F.peek buf

@@ -1,12 +1,15 @@+{-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}  module Vivid.Randomness (      pick    , picks+   , exprand    , module System.Random.Shuffle    ) where  import Control.Monad.Random (getRandomR, getRandomRs, MonadRandom)+import System.Random (Random) import System.Random.Shuffle  -- | Picks a random element from the provided list@@ -22,3 +25,8 @@ picks :: (MonadRandom m) => [a] -> m [a] picks l =    (map (l !!)) <$> getRandomRs (0, (length::[a]->Int) l - 1)++exprand :: (Fractional n, Floating n, MonadRandom m, Random n) => n -> n -> m n+exprand lo hi = do+   r <- getRandomR (0, 1)+   pure $ lo * exp (log (hi / lo) * r)

@@ -1,18 +1,17 @@ {-# OPTIONS_HADDOCK show-extensions #-} -{-# LANGUAGE NoRebindableSyntax #-}--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}+-- {-# LANGUAGE BangPatterns #-}+-- {-# LANGUAGE FlexibleInstances #-}+-- {-# LANGUAGE InstanceSigs #-}+-- {-# LANGUAGE KindSignatures #-}+-- {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeSynonymInstances #-}+-- {-# LANGUAGE ScopedTypeVariables #-}+-- {-# LANGUAGE TypeSynonymInstances #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoRebindableSyntax #-} {-# LANGUAGE NoUndecidableInstances #-}  @@ -29,7 +28,9 @@    -- * Nodes     , NodeId(..)-   , Node(..)+   , Synth(..)+   , Group(..)+   , defaultGroup     -- * Buffers @@ -39,6 +40,13 @@    , newBuffer    , newBufferFromFile    , saveBuffer+   , writeBuffer+   , writeBufferWith+   , WriteBufArgs(..)+   , defaultWBArgs+   , closeBuf+   , closeBuffer+   , zeroBuf     -- * Manual management of SC server connection @@ -49,17 +57,22 @@     , module Vivid.SCServer.State -   , shrinkNodeArgs+   , shrinkSynthArgs     ) where -import Vivid.Actions.Class import Vivid.OSC+import Vivid.OSC.Bundles (initTreeCommand)+import qualified Vivid.SC.Server.Commands as SCCmd+import Vivid.SC.Server.Types (Group(..))+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.Char8 as BS8 (pack)+import qualified Data.ByteString.UTF8 as UTF8 (fromString) import Data.Int (Int32) -- BBP hack: import Prelude@@ -71,8 +84,8 @@ --   Corresponds to the cmd-. \/ ctrl-.  key command in the SuperCollider IDE cmdPeriod :: (VividAction m) => m () cmdPeriod = do-   callOSC $ OSC "/g_freeAll" [OSC_I 0]-   callOSC $ OSC "/clearSched" []+   callOSC $ SCCmd.g_freeAll [NodeId 1] -- 1 instead of 0 is temp! (is it? 1 is default group...)+   callOSC $ SCCmd.clearSched    initTree     -- | Alias of 'cmdPeriod'@@ -90,17 +103,12 @@ --  --   Note that this is synchronous -- it doesn't return until the buffer is allocated --   (in theory, this could hang if e.g. the UDP packet is lost)-newBuffer :: (VividAction m) => Int32 -> m BufferId+newBuffer :: VividAction m => Int32 -> m BufferId newBuffer bufferLength = do-   bufId@(BufferId bufIdInt) <- newBufferId-   syncId@(SyncId syncIdInt) <- newSyncId-   callOSC $ OSC "/b_alloc" [-       OSC_I bufIdInt-      ,OSC_I bufferLength-      ,OSC_I 1-      , OSC_B . encodeOSC $ OSC "/sync" [OSC_I syncIdInt]-      ]-   waitForSync syncId+   bufId <- newBufferId+   oscWSync $ \syncId ->+      callOSC $+         SCCmd.b_alloc bufId bufferLength 1 (Just $ SCCmd.sync syncId)    return bufId  -- | Make a buffer and fill it with sound data from a file@@ -112,16 +120,9 @@ --   Note that like "makeBuffer" this is synchronous newBufferFromFile :: (VividAction m) => FilePath -> m BufferId newBufferFromFile fPath = do-   bufId@(BufferId bufIdInt) <- newBufferId-   syncId@(SyncId syncIdInt) <- newSyncId-   callOSC $ OSC  "/b_allocRead" [-        OSC_I bufIdInt-      , OSC_S (BS8.pack fPath)-      , OSC_I 0-      , OSC_I (-1)-      , OSC_B . encodeOSC $ OSC "/sync" [OSC_I syncIdInt]-      ]-   waitForSync syncId+   bufId <- newBufferId+   oscWSync $ \syncId -> callOSC $+      SCCmd.b_allocRead bufId fPath 0 Nothing (Just $ SCCmd.sync syncId)    return bufId  makeBufferFromFile :: (VividAction m) => FilePath -> m BufferId@@ -132,18 +133,62 @@  -- | Write a buffer to a file -- +--   Alias of 'writeBuffer'+--  --   Synchronous. saveBuffer :: (VividAction m) => BufferId -> FilePath -> m ()-saveBuffer (BufferId theBufId) fPath = do-   _syncId@(SyncId syncIdInt) <- newSyncId-   callOSC $ OSC "/b_write" [-      OSC_I theBufId-     ,OSC_S (BS8.pack fPath)-     ,OSC_S "wav"-     ,OSC_S "float"-     , OSC_I (-1)-     , OSC_I 0-     , OSC_I 0-       -- We make this synchronous because what if you send a "/b_write" then a "/quit"?(!):-     , OSC_B . encodeOSC $ OSC "/sync" [OSC_I syncIdInt]-     ]+saveBuffer = writeBuffer++writeBuffer :: VividAction m => BufferId -> FilePath -> m ()+writeBuffer = writeBufferWith defaultWBArgs++writeBufferWith :: VividAction m => WriteBufArgs -> BufferId -> FilePath -> m ()+writeBufferWith args bufId fPath =+   oscWSync $ \syncId -> callOSC $+      SCCmd.b_write+         bufId+         fPath+         "wav"+         "float"+         -- Num frames:+         Nothing+         -- Start frame:+         0+         -- 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"?(!):+         (Just $ SCCmd.sync syncId)++-- | We may add arguments in the future ; to future-proof your code, just update+--   fields of 'defaultWBArgs'+data WriteBufArgs+   = WriteBufArgs {+    _wb_keepOpen :: Bool+   }+ deriving (Show, Read, Eq, Ord)++defaultWBArgs :: WriteBufArgs+defaultWBArgs = WriteBufArgs {+     _wb_keepOpen = False+   }++-- | Close an open soundfile and write header information+-- +--   Synchronous+closeBuffer :: VividAction m => BufferId -> m ()+closeBuffer bufId = oscWSync $ \syncId ->+   callOSC $ SCCmd.b_close bufId (Just $ SCCmd.sync syncId)++closeBuf :: VividAction m => BufferId -> m ()+closeBuf = closeBuffer++-- | Zero the sample data in a buffer+-- +--   Synchronous+zeroBuf :: VividAction m => BufferId -> m ()+zeroBuf bufId = oscWSync $ \syncId ->+   callOSC $ SCCmd.b_zero bufId (Just $ SCCmd.sync syncId)++-- More info is available in HelpSource/Reference/default_group.schelp+defaultGroup :: Group ; defaultGroup = Group (NodeId 1)

@@ -20,7 +20,10 @@    , waitForSync_io_noGC    ) where +import Vivid.SC.Server.Commands as SCCmd+ import Vivid.OSC+import Vivid.OSC.Bundles (initTreeCommand) import Vivid.SCServer.State  import Network.Socket (@@ -54,13 +57,14 @@ --   computation is done upfront --  --   The 'HostName' is the ip address or "localhost". The 'ServiceName' is the port-createSCServerConnection :: SCConnectConfig -> IO Socket+createSCServerConnection :: SCConnectConfig -> IO (Either String Socket) createSCServerConnection connConfig = do    let !_ = scServerState    shouldMakeSock scServerState >>= \case       True -> do-         makeSock scServerState connConfig-      False -> error "Too late -- connection already established. Disconnect first."+         Right <$> makeSock scServerState connConfig+      False ->+         pure $ Left "Too late -- connection already established. Disconnect first."  -- | Explicitly close Vivid's connection to a SC server. -- @@ -161,9 +165,9 @@    listener <- forkIO $ startMailbox (_scConnectConfig_serverMessageFunction scConnectConfig) s    let firstSyncID = toEnum $ numberOfSyncIdsToDrop - 2    _ <- send s $ encodeOSCBundle $ OSCBundle (Timestamp 0) [-        Right $ OSC "/dumpOSC" [OSC_I 1]+        Right $ SCCmd.dumpOSC DumpOSC_Parsed       , Right $ initTreeCommand-      , Right $ OSC "/sync" [OSC_I firstSyncID]+      , Right $ SCCmd.sync (SyncId firstSyncID)       ]    waitForSync_io (SyncId firstSyncID)    return (s, listener)@@ -182,15 +186,16 @@    return ()  startMailbox :: (OSC -> IO ()) -> Socket -> IO ()-startMailbox otherMessageFunction s = forever $ recv {- From -} s 1024 >>= \(msg{- , _ -}) ->+startMailbox otherMessageFunction s = forever $ recv {- From -} s 65536 >>= \(msg{- , _ -}) ->    case decodeOSC msg of-      OSC "/synced" [OSC_I theSyncId] -> do+      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-      x -> otherMessageFunction x+      Right x -> otherMessageFunction x+      Left e -> putStrLn $ "ERROR DECODING OSC: " ++ show (msg, e)  -- | Print all messages other than \"/done\"s defaultMessageFunction :: OSC -> IO ()

@@ -23,7 +23,7 @@    ) where  import Vivid.OSC (OSC)-import Vivid.SCServer.Types+import Vivid.SC.Server.Types import Vivid.SynthDef.Types  import Network.Socket (Socket)

@@ -6,16 +6,22 @@ {-# LANGUAGE NoUndecidableInstances #-}  module Vivid.SCServer.Types (-     Node(..)-   , shrinkNodeArgs-   , NodeId(..)-   , BufferId(..)-   , SyncId(..)-   , HasNodeId(..)++   -- Types+     Synth(..)++   -- Functions+   , shrinkSynthArgs++   -- Classes+   , IsNode(..)+   , SynthOrNodeId+   , IsGroup    ) where  import Data.Int import GHC.TypeLits+import Vivid.SC.Server.Types import Vivid.SynthDef.TypesafeArgs  @@ -30,57 +36,53 @@ --  --   Note that if you don't want this type safety, you can e.g. -- ---   >> Node n <- synth foo ()+--   >> Synth n <- synth foo () --   >> setG n (0.1 ::I "vol") --  --   Or: --  --   >> ns <- mapM (flip synth ()) [foo, bar, baz]---   >> map (setG (0::I "asdf") . unNode) ns+--   >> map (setG (0::I "asdf") . unSynth) ns --  --   Or: --  --   >> n <- synthG foo () -- ---   (You also may want to look at 'shrinkNodeArgs' if you want to construct a list+--   (You also may want to look at 'shrinkSynthArgs' if you want to construct a list --   which has synthdefs or nodes of different types)-data Node (args :: [Symbol])-   = Node { unNode :: NodeId }+newtype Synth (args :: [Symbol]) = Synth { _unSynth :: NodeId }+ deriving (Show, Read, Eq, Ord)  -- | So let's say you have a node: -- ---   > foo :: Node '["amp", "freq", "phase"]+--   > foo :: Synth '["amp", "freq", "phase"] --  --   and you want to add it to a list of nodes: -- ---   > ns :: [Node '["freq", "phase"]]+--   > ns :: [Synth '["freq", "phase"]] --  --   If you don't plan on setting the \"amp\" argument, you can \"shrink\" to --   the compatible arguments: -- ---   > ns' = shrinkNodeArgs foo : ns+--   > ns' = shrinkSynthArgs foo : ns --  --   (The same thing exists for SynthDefs -- 'Vivid.SynthDef.shrinkSDArgs')-shrinkNodeArgs :: (Subset new old) => Node old -> Node new-shrinkNodeArgs (Node nId) = Node nId--newtype NodeId-      = NodeId { _unNodeId :: Int32 }-   deriving (Show, Eq, Ord, Read)--class HasNodeId a where-   getNodeId :: a -> NodeId+shrinkSynthArgs :: (Subset new old) => Synth old -> Synth new+shrinkSynthArgs (Synth nId) = Synth nId -instance HasNodeId NodeId where-   getNodeId n = n+class IsNode a where getNodeId :: a -> NodeId -instance HasNodeId (Node a) where-   getNodeId (Node n) = n+instance IsNode NodeId where getNodeId n = n+instance IsNode (Synth a) where getNodeId (Synth n) = n+instance IsNode Group where getNodeId (Group n) = n+instance IsNode ParGroup where getNodeId (ParGroup n) = n -newtype BufferId-      = BufferId { _unBufferId :: Int32 }-   deriving (Show, Eq, Ord, Read)+-- | For gradually-typed 'free'+class IsNode a => SynthOrNodeId a+instance SynthOrNodeId (Synth x)+instance SynthOrNodeId NodeId -newtype SyncId-      = SyncId Int32-   deriving (Show, Read, Eq, Ord)+-- | 'Group' and 'ParGroup'+class IsNode g => IsGroup g+instance IsGroup Group+instance IsGroup ParGroup

@@ -41,7 +41,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-} {-# LANGUAGE ViewPatterns #-}  {-# LANGUAGE NoIncoherentInstances #-}@@ -98,8 +98,9 @@   , SDBody   ) where +import Vivid.SC.SynthDef.Literally as Literal+import Vivid.SC.SynthDef.Types (CalculationRate(..), BinaryOp(..), UnaryOp(..)) import Vivid.SynthDef.ToSig-import Vivid.SynthDef.Literally as Literal import Vivid.SynthDef.Types import Vivid.SynthDef.FromUA (SDBody) @@ -107,7 +108,7 @@ import Control.Arrow (first{-, second-}) import Control.Monad.State (get, put, modify, execState) import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.ByteString.UTF8 as UTF8 import Data.Hashable (Hashable, hashWithSalt, hash) import Data.Int import Data.List (nub, elemIndex, find) -- , sortBy)@@ -181,7 +182,7 @@          Literal.LiteralSynthDef name newConsts params paramNames (map replaceIt ugens) variants  where    -- newConsts :: [Float];  newOneLoc :: Int32-   (newConsts, toEnum -> negOneLoc) =+   (newConsts, (toEnum::Int->Int32) -> negOneLoc) =       case elemIndex (-1) oldConsts of          Nothing -> (oldConsts <> [(-1)], (length::[a]->Int) oldConsts)          Just i -> (oldConsts, i)@@ -190,19 +191,19 @@          (Literal._uGenSpec_name ug == "UnaryOpUGen")       && (Literal._uGenSpec_specialIndex ug == uOpToSpecialI BitNot)    replaceIt :: UGenSpec -> UGenSpec-   replaceIt ugspec = if isBitNot ugspec-      then UGenSpec+   replaceIt ugspec = case isBitNot ugspec of+      False -> ugspec+      True -> UGenSpec          "BinaryOpUGen"          (Literal._uGenSpec_calcRate ugspec)          (Literal._uGenSpec_inputs ugspec <>             [InputSpec_Constant negOneLoc])          (Literal._uGenSpec_outputs ugspec)          (biOpToSpecialI BitXor)-      else ugspec  getSDHashName :: SynthDef a -> ByteString getSDHashName theSD =-   "vivid_" <> (BS8.pack . show . hash) theSD+   "vivid_" <> (UTF8.fromString . show . hash) theSD  {- -- Anyone, write it for me if you wanna!:@@ -220,7 +221,7 @@    _ -> control : rest  where    control = UGenSpec-      (BS8.pack "Control")+      (UTF8.fromString "Control")       KR       []       (replicate ((length::[a]->Int) params) (OutputSpec KR))@@ -232,8 +233,8 @@    makeSpec (_, UGen name calcRate ins numOuts) =       let (theName, specialIndex) = case name of              UGName_S s -> (s, 0)-             UGName_U uop -> (BS8.pack "UnaryOpUGen", uOpToSpecialI uop)-             UGName_B biop -> (BS8.pack "BinaryOpUGen", biOpToSpecialI biop)+             UGName_U uop -> (UTF8.fromString "UnaryOpUGen", uOpToSpecialI uop)+             UGName_B biop -> (UTF8.fromString "BinaryOpUGen", biOpToSpecialI biop)       in UGenSpec             theName             calcRate@@ -298,11 +299,11 @@ -- | Define a Synth Definition and give it a name you can refer to from e.g. sclang sdNamed :: VarList argList => String -> argList -> SDBody' (InnerVars argList) [Signal] -> SynthDef (InnerVars argList) sdNamed name params theState =-   makeSynthDef (SDName_Named $ BS8.pack name) params theState+   makeSynthDef (SDName_Named $ UTF8.fromString name) params theState  makeSynthDef :: VarList argList => SDName -> argList -> SDBody' (InnerVars argList) [Signal] -> SynthDef (InnerVars argList) makeSynthDef name params theState =-   let theSD = SynthDef name (map (first BS8.pack) paramList) Map.empty+   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)@@ -348,7 +349,7 @@       Nothing -> error "that output isn't in the graph!"  --- | Like 'Vivid.SCServer.shrinkNodeArgs' but for 'SynthDef's+-- | Like 'Vivid.SCServer.shrinkSynthArgs' but for 'SynthDef's shrinkSDArgs :: Subset new old => SynthDef old -> SynthDef new shrinkSDArgs (SynthDef a b c) = SynthDef a b c 

@@ -1,17 +1,20 @@+-- The `concat <$> sequence _` is to not run afoul of '-fconstraint-solver-iterations' -- temp?+ {-# OPTIONS_HADDOCK show-extensions #-}  -- {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs, NoMonoLocalBinds #-}+-- {-# LANGUAGE GADTs, NoMonoLocalBinds #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} -- {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-} {-# LANGUAGE TypeOperators #-} -- Needed for nested type family application: {-# LANGUAGE UndecidableInstances #-}@@ -102,8 +105,8 @@    type SDBodyArgs (NoDefaults args0) = args0    fromUA _ = return [] -instance FromUA (UA a args0) where-   type UAsArgs (UA a sdArgs) = '[a]+instance FromUA (UA a args) where+   type UAsArgs (UA a args) = '[a]    type SDBodyArgs (UA a args) = args    fromUA :: UA a args -> SDBody (UA a args) [(String, Signal)]    fromUA (UA x) = do@@ -121,7 +124,8 @@    type UAsArgs (UA a as0, UA b as1, UA c as2) = '[a, b, c]    type SDBodyArgs (UA a as0, UA b as1, UA c as2) = as0    fromUA (a, b, c) =-      (<>) <$> fromUA a <*> fromUA (b, c)+      -- (<>) <$> fromUA a <*> fromUA (b, c)+      concat <$> sequence [fromUA a, fromUA b, fromUA c]   instance (AllEqual '[as0,as1,as2,as3,as4], AllKnownSymbols '[a, b, c])@@ -129,7 +133,8 @@    type UAsArgs (UA a as0, UA b as1, UA c as2, UA d as3) = '[a, b, c, d]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3) = as0    fromUA (a, b, c, d) =-      (<>) <$> fromUA a <*> fromUA (b,c,d)+      -- (<>) <$> fromUA (a,b) <*> fromUA (c,d)+      concat <$> sequence [fromUA a,fromUA b,fromUA c, fromUA d]   @@ -139,14 +144,19 @@          => FromUA (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4) where    type UAsArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4) = '[a, b, c, d, e]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4) = as0-   fromUA (a, b, c, d, e) = (<>) <$> fromUA a <*> fromUA (b,c,d,e)+   fromUA (a, b, c, d, e) =+      -- (<>) <$> fromUA (a,b,c) <*> fromUA (d,e)+      concat <$> sequence [fromUA a,fromUA b,fromUA c,fromUA d,fromUA e]  -- 6: instance (AllEqual '[as0,as1,as2,as3,as4,as5], AllKnownSymbols '[a,b,c,d,e,f])          => FromUA (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5) where    type UAsArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5) = '[a, b, c, d, e, f]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5) = as0-   fromUA (a, b, c, d, e,f) = (<>) <$> fromUA a <*> fromUA (b,c,d,e,f)+   fromUA (a, b, c, d, e, f) =+      -- (<>) <$> fromUA (a,b,c) <*> fromUA (d,e,f)+      concat <$> sequence [fromUA a,fromUA b,fromUA c,fromUA d,fromUA e+         ,fromUA f]  -- 7: instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6], AllKnownSymbols '[a,b,c,d,e,f,g])@@ -154,8 +164,10 @@    type UAsArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6) = '[a, b, c, d, e, f, g]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6) = as0    fromUA (a,b,c,d,e,f,g) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g)-+      -- concat <$> sequence [fromUA (a,b,c),fromUA (d,e,f), fromUA g]+      -- (<>) <$> fromUA (a,b,c,d) <*> fromUA (e,f,g)+      concat <$> sequence [fromUA a,fromUA b,fromUA c, fromUA d,fromUA e+         ,fromUA f, fromUA g]  -- 8 instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7]@@ -165,8 +177,10 @@    type UAsArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6,UA h as7) = '[a, b, c, d, e, f, g, h]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6,UA h as7) = as0    fromUA (a,b,c,d,e,f,g,h) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h)-+      -- (<>) <$> fromUA (a,b,c,d) <*> fromUA (e,f,g,h)+      -- concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h)]+      concat <$> sequence [fromUA a,fromUA b,fromUA c, fromUA d,fromUA e+         ,fromUA f, fromUA g, fromUA h]  -- 9: instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8]@@ -176,7 +190,8 @@    type UAsArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6,UA h as7,UA i as8) = '[a, b, c, d, e, f, g, h, i]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6,UA h as7,UA i as8) = as0    fromUA (a,b,c,d,e,f,g,h,i) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i)+      -- (<>) <$> fromUA (a,b,c,d,e) <*> fromUA (f,g,h,i)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i)]   instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9]@@ -188,8 +203,8 @@           '[a,b,c,d,e,f,g,h,i,j]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6,UA h as7,UA i as8,UA j as9) = as0    fromUA (a,b,c,d,e,f,g,h,i,j) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j)-+      -- (<>) <$> fromUA (a,b,c,d,e) <*> fromUA (f,g,h,i,j)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j)]  instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10]          ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k])@@ -200,7 +215,8 @@           '[a,b,c,d,e,f,g,h,i,j,k]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6,UA h as7,UA i as8,UA j as9,UA k as10) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k)+      -- (<>) <$> fromUA (a,b,c,d,e,f) <*> fromUA (g,h,i,j,k)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k)]   instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11]@@ -212,7 +228,8 @@           '[a,b,c,d,e,f,g,h,i,j,k,l]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6,UA h as7,UA i as8,UA j as9,UA k as10,UA l as11) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l)+      -- (<>) <$> fromUA (a,b,c,d,e,f) <*> fromUA (g,h,i,j,k,l)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l)]   instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12]@@ -227,7 +244,8 @@           '[a,b,c,d,e,f,g,h,i,j,k,l,m]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6,UA h as7,UA i as8,UA j as9,UA k as10,UA l as11,UA m as12) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g) <*> fromUA (h,i,j,k,l,m)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m)]   instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13]@@ -242,7 +260,8 @@           '[a,b,c,d,e,f,g,h,i,j,k,l,m,n]    type SDBodyArgs (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5,UA g as6,UA h as7,UA i as8,UA j as9,UA k as10,UA l as11,UA m as12,UA n as13) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g) <*> fromUA (h,i,j,k,l,m,n)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n)]   instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14]@@ -261,7 +280,8 @@                   ,UA m as12,UA n as13,UA o as14                   ) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h) <*> fromUA (i,j,k,l,m,n,o)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o)]   instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15]@@ -280,7 +300,8 @@                   ,UA m as12,UA n as13,UA o as14,UA p as15                   ) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h) <*> fromUA (i,j,k,l,m,n,o,p)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p)]   instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16]@@ -299,7 +320,8 @@                   ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16                   ) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i) <*> fromUA (j,k,l,m,n,o,p,q)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q)]   instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17]@@ -319,7 +341,8 @@                   ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17                   ) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i) <*> fromUA (j,k,l,m,n,o,p,q,r)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q,r)]   instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17,as18]@@ -339,8 +362,8 @@                   ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17                   ,UA s as18) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)-+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i,j) <*> fromUA (k,l,m,n,o,p,q,r,s)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q,r), fromUA (s)]  instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17,as18,as19]          ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t])@@ -359,7 +382,8 @@                   ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17                   ,UA s as18,UA t as19) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i,j) <*> fromUA (k,l,m,n,o,p,q,r,s,t)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q,r), fromUA (s,t)]  instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17,as18,as19,as20]          ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u])@@ -380,7 +404,8 @@                   ,UA s as18,UA t as19,UA u as20                   ) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i,j,k) <*> fromUA (l,m,n,o,p,q,r,s,t,u)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q,r), fromUA (s,t,u)]  instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17,as18,as19,as20,as21]          ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v])@@ -401,7 +426,8 @@                   ,UA s as18,UA t as19,UA u as20,UA v as21                   ) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i,j,k) <*> fromUA (l,m,n,o,p,q,r,s,t,u,v)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q,r), fromUA (s,t,u), fromUA (v)]  instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17,as18,as19,as20,as21,as22]          ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w])@@ -423,7 +449,8 @@                   ,UA s as18,UA t as19,UA u as20,UA v as21,UA w as22                   ) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i,j,k,l) <*> fromUA (m,n,o,p,q,r,s,t,u,v,w)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q,r), fromUA (s,t,u), fromUA (v,w)]  instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17,as18,as19,as20,as21,as22,as23]          ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x])@@ -445,7 +472,8 @@                   ,UA s as18,UA t as19,UA u as20,UA v as21,UA w as22,UA x as23                   ) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i,j,k,l) <*> fromUA (m,n,o,p,q,r,s,t,u,v,w,x)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q,r), fromUA (s,t,u), fromUA (v,w,x)]  instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17,as18,as19,as20,as21,as22,as23,as24]          ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y])@@ -467,7 +495,8 @@                   ,UA s as18,UA t as19,UA u as20,UA v as21,UA w as22,UA x as23                   ,UA y as24) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m) <*> fromUA (n,o,p,q,r,s,t,u,v,w,x,y)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q,r), fromUA (s,t,u), fromUA (v,w,x), fromUA (y)]  instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17,as18,as19,as20,as21,as22,as23,as24,as25]          ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z])@@ -489,12 +518,13 @@                   ,UA s as18,UA t as19,UA u as20,UA v as21,UA w as22,UA x as23                   ,UA y as24,UA z as25) = as0    fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) =-      (<>) <$> fromUA a <*> fromUA (b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z)+      -- (<>) <$> fromUA (a,b,c,d,e,f,g,h,i,j,k,l,m) <*> fromUA (n,o,p,q,r,s,t,u,v,w,x,y,z)+      concat <$> sequence [fromUA (a,b,c), fromUA (d,e,f), fromUA (g,h,i), fromUA (j,k,l), fromUA (m,n,o), fromUA (p,q,r), fromUA (s,t,u), fromUA (v,w,x), fromUA (y,z)]   -- | \"UGen Arg\"-data UA (name :: Symbol) (args :: [Symbol]) where-   UA :: KnownSymbol name => SDBody' args Signal -> UA name args+data UA (name :: Symbol) (args :: [Symbol]) =+   KnownSymbol name => UA (SDBody' args Signal)   type family AllEqual (a :: [[Symbol]]) :: Constraint where

@@ -1,377 +0,0 @@--- |  __You probably don't need to use this directly__ -- use "Vivid.SynthDef" instead--- ---   This is a representation of how SynthDefs are sent over the wire, as described in the---   < http://doc.sccode.org/Reference/Synth-Definition-File-Format.html Synth Definition File Format >---   helpfile.--- --{-# OPTIONS_HADDOCK show-extensions #-}--{-# LANGUAGE NoRebindableSyntax #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}--{-# LANGUAGE NoIncoherentInstances #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE NoUndecidableInstances #-}--module Vivid.SynthDef.Literally (-     LiteralSynthDef(..)-   , encodeSynthDefFile-   , decodeSynthDefFile--   , UGenSpec(..)-   , InputSpec(..)-   , ParamName(..)-   , SynthDefFile(..)-   , OutputSpec(..)--   , uOpToSpecialI-   , biOpToSpecialI-   , specialIToUOp-   , specialIToBiOp--   , sdLitPretty-   ) where--import Vivid.SynthDef.Types-import Vivid.OSC.Util (floatToWord, wordToFloat)--import Control.Arrow (first)-import Control.Monad (when)-import Data.Binary (decode, encode)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS (cons, splitAt, drop, head, length)-import qualified Data.ByteString.Char8 as BS8 (unpack, pack)-import qualified Data.ByteString.Lazy as BSL (fromStrict, toStrict)-import Data.Int-import Data.List.Split (chunksOf)-import Data.Monoid--data LiteralSynthDef-   = LiteralSynthDef {-    _synthDefName :: ByteString -- pstring: "a pascal format string: a byte giving the length followed by that many bytes"-   ,_synthDefConstants :: [Float]-   ,_synthDefParameters :: [Float] -- Initial values-   ,_synthDefParamNames :: [ParamName]-   ,_synthDefUGens :: [UGenSpec]-   ,_synthDefVariants :: [VariantSpec]-   }- deriving (Show)--data SynthDefFile = SynthDefFile [LiteralSynthDef]- deriving (Show)---- Doesn't need to be in IO - yes, I know!-decodeSynthDefFile :: ByteString -> IO SynthDefFile-decodeSynthDefFile blob = do-   let (top, rest) = BS.splitAt 4 blob-   let (fileVersion :: Int32, rest2) =-          first (decode . BSL.fromStrict) $ BS.splitAt 4 rest--   when (top /= "SCgf" || fileVersion /= 2) $-      error $ "screwed up synthdef file " <> show top <> show fileVersion--   let (numberOfSynthDefs :: Int16, rest3) =-          first (decode . BSL.fromStrict) $ BS.splitAt 2 rest2--   let (synthDefs, rest4) = getNWith numberOfSynthDefs decodeSynthDef rest3--   if rest4 /= ""-      then error $ "leftover data: " <> show rest4-      else return ()--   return $ SynthDefFile synthDefs--{--a synth-definition-file is :-int32 - four byte file type id containing the ASCII characters: "SCgf"-int32 - file version, currently 2.-int16 - number of synth definitions in this file (D).-[ synth-definition ] * D--}--encodeSynthDefFile :: SynthDefFile -> ByteString-encodeSynthDefFile (SynthDefFile synthDefs) = mconcat [-     "SCgf"-   , BSL.toStrict $ encode (2 :: Int32)-   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) synthDefs) :: Int16)-   , mconcat $ map encodeSynthDef synthDefs-   ]---- Yes, the 'restN's are ugly, yes i could have used a state monad. Don't judge!-decodeSynthDef :: ByteString -> (LiteralSynthDef, {- rest: -} ByteString)-decodeSynthDef blob =-   let (name :: ByteString, rest) = getPString blob--       (numConstants :: Int32, rest2) = getInt32 rest--       (constants :: [Float], rest3) =-          first (map (wordToFloat . decode . BSL.fromStrict)) $ getN4ByteBlocks numConstants rest2--       (numParams :: Int32, rest4) = getInt32 rest3--       (params :: [Float], rest5) =-          first (map (wordToFloat . decode . BSL.fromStrict)) $ getN4ByteBlocks numParams rest4--       (numParamNames :: Int32, rest6) = getInt32 rest5--       (paramNames :: [ParamName], rest7) = getNWith numParamNames getParamName rest6--       (numUGens :: Int32, rest8) = getInt32 rest7--       (uGens, rest9) = getNWith numUGens getUGenSpec rest8--       (numVariants, rest10) = getInt16 rest9--       (variantSpecs, rest11) = getNWith numVariants (getVariantSpec numParams) rest10--   in (LiteralSynthDef name constants params paramNames uGens variantSpecs, rest11)--{--a synth-definition is :-pstring - the name of the synth definition-int32 - number of constants (K)-[float32] * K - constant values-int32 - number of parameters (P)-[float32] * P - initial parameter values-int32 - number of parameter names (N)-[ param-name ] * N-int32 - number of unit generators (U)-[ ugen-spec ] * U-int16 - number of variants (V)-[ variant-spec ] * V--}--encodeSynthDef :: LiteralSynthDef -> ByteString-encodeSynthDef (LiteralSynthDef name constants params paramNames uGenSpecs variants) = mconcat [-     encodePString name-   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) constants) :: Int32)-   , mconcat $ map (BSL.toStrict . encode . floatToWord) constants-   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) params) :: Int32)-   , mconcat $ map (BSL.toStrict . encode . floatToWord) params-   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) paramNames) :: Int32)-   , mconcat $ map encodeParamName paramNames-   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) uGenSpecs) :: Int32)-   , mconcat $ map encodeUGenSpec uGenSpecs-   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) variants) :: Int16)-   , mconcat $ map encodeVariantSpec variants-   ]--data ParamName = ParamName {-    _paramName_name :: ByteString-   ,_paramName_indexInParamArray :: Int32-   }- deriving (Show)--{--a param-name is :-pstring - the name of the parameter-int32 - its index in the parameter array--}--getParamName :: ByteString -> (ParamName, ByteString)-getParamName blob =-   let (name, rest) = getPString blob-       (index, rest2) = getInt32 rest-   in (ParamName name index, rest2)--encodeParamName :: ParamName -> ByteString-encodeParamName (ParamName name index) =-   encodePString name <> BSL.toStrict (encode index)--data UGenSpec = UGenSpec {-    _uGenSpec_name :: ByteString-   ,_uGenSpec_calcRate :: CalculationRate-   ,_uGenSpec_inputs :: [InputSpec]-   ,_uGenSpec_outputs :: [OutputSpec]-   ,_uGenSpec_specialIndex :: Int16-   }- deriving (Show)--{--a ugen-spec is :-pstring - the name of the SC unit generator class-int8 - calculation rate-int32 - number of inputs (I)-int32 - number of outputs (O)-int16 - special index-[ input-spec ] * I-[ output-spec ] * O--}--getUGenSpec :: ByteString -> (UGenSpec, {- rest: -} ByteString)-getUGenSpec blob =-   let (name, rest) = getPString blob-       (calcRate :: CalculationRate, rest2) =-          first ((toEnum) . (fromEnum :: Int8 -> Int) . decode . BSL.fromStrict) $-             BS.splitAt 1 rest-       (numInputs :: Int32, rest3) = getInt32 rest2-       (numOutputs :: Int32, rest4) = getInt32 rest3--       (specialIndex, rest5) = getInt16 rest4-       (inputSpecs, rest6) = getNWith numInputs getInputSpec rest5-       (outputSpecs, rest7) = getNWith numOutputs getOutputSpec rest6--   in (UGenSpec name calcRate inputSpecs outputSpecs specialIndex, rest7)--encodeUGenSpec :: UGenSpec -> ByteString-encodeUGenSpec (UGenSpec name calcRate inputSpecs outputSpecs specialIndex) = mconcat [-    encodePString name-   ,BSL.toStrict $ encode $ (toEnum (fromEnum calcRate) :: Int8)-   ,BSL.toStrict $ encode $ (toEnum ((length::[a]->Int) inputSpecs) :: Int32)-   ,BSL.toStrict $ encode $ (toEnum ((length::[a]->Int) outputSpecs) :: Int32)-   ,BSL.toStrict $ encode specialIndex-   ,mconcat $ map encodeInputSpec inputSpecs-   ,mconcat $ map encodeOutputSpec outputSpecs-   ]--data InputSpec-   = InputSpec_UGen {-    _inputSpec_uGen_index :: Int32-   ,_inputSpec_uGen_outputIndex :: Int32-   }-   | InputSpec_Constant {-    _inputSpec_constant_index :: Int32-   }- deriving (Show, Read, Eq)--{--an input-spec is :-int32 - index of unit generator or -1 for a constant-if (unit generator index == -1) :-int32 - index of constant-else :-int32 - index of unit generator output--}--getInputSpec :: ByteString -> (InputSpec, ByteString)-getInputSpec blob =-   let (stuffForThis, rest) = BS.splitAt 8 blob-       (one :: Int32, two :: Int32) = (\(a,b) -> ((decode . BSL.fromStrict) a, (decode . BSL.fromStrict) b)) $ BS.splitAt 4 stuffForThis-       spec = case one of-          -1 -> InputSpec_Constant two-          n | n > -1 -> InputSpec_UGen one two-          _ -> error "bad number"-   in (spec, rest)--encodeInputSpec :: InputSpec -> ByteString-encodeInputSpec inputSpec = mconcat $ map (BSL.toStrict . encode) $ encodeInputSpec' inputSpec- where-   encodeInputSpec' :: InputSpec -> [Int32]-   encodeInputSpec' (InputSpec_Constant i) = [ (-1), i ]-   encodeInputSpec' (InputSpec_UGen i oI) = [ i, oI ]--data OutputSpec = OutputSpec { _outputSpec_calcRate :: CalculationRate }- deriving (Show, Read, Eq)--{--an output-spec is :-int8 - calculation rate--}--getOutputSpec :: ByteString -> (OutputSpec, ByteString)-getOutputSpec blob =-      first (OutputSpec . toEnum . (fromEnum :: Int8 -> Int) . decode . BSL.fromStrict) $-         BS.splitAt 1 blob--encodeOutputSpec :: OutputSpec -> ByteString-encodeOutputSpec (OutputSpec calcRate) =-   BSL.toStrict $ encode $ (toEnum (fromEnum calcRate) :: Int8)--data VariantSpec-   = VariantSpec {-    _variantSpec_name :: ByteString-   ,_variantSpec_initialParamVals :: [Float] -- float32-   }- deriving (Show)--{--a variant-spec is :-pstring - the name of the variant-[float32] * P - variant initial parameter values--}--getVariantSpec :: Int32 -> ByteString -> (VariantSpec, ByteString)-getVariantSpec numParams blob =-   let (name, rest) = getPString blob-       (initialParamVals :: [Float], rest2) = first (map (decode . BSL.fromStrict)) $ getN4ByteBlocks numParams rest-   in (VariantSpec name initialParamVals, rest2)--encodeVariantSpec :: VariantSpec -> ByteString-encodeVariantSpec (VariantSpec name initialParamVals) =-   encodePString name <> mconcat (map (BSL.toStrict . encode . floatToWord) initialParamVals)----- helpers:-getPString :: ByteString -> (ByteString, {- rest: -} ByteString)-getPString blob = first (BS.drop 1) $-   BS.splitAt (fromEnum (BS.head blob) + 1) blob--encodePString :: ByteString -> ByteString-encodePString s = toEnum (BS.length s) `BS.cons` s--getNWith :: (Integral i) => i -> (ByteString -> (a, ByteString)) -> ByteString -> ([a], ByteString)-getNWith 0 _ rest = ([], rest)-getNWith n f rest =-   let (head1, rest2) = f rest-       (head2, rest3) = getNWith (n - 1) f rest2-   in (head1 : head2, rest3)-   -getInt32 :: ByteString -> (Int32, ByteString)-getInt32 blob = first (decode . BSL.fromStrict) $ BS.splitAt 4 blob--getInt16 :: ByteString -> (Int16, ByteString)-getInt16 blob = first (decode . BSL.fromStrict) $ BS.splitAt 2 blob--getN4ByteBlocks :: Int32 -> ByteString -> ([ByteString], ByteString)-getN4ByteBlocks numBlocks blob =-   first (map (BS8.pack) . chunksOf 4 . BS8.unpack) $-             BS.splitAt (4 * fromEnum numBlocks) blob----uOpToSpecialI :: UnaryOp -> Int16-uOpToSpecialI uop = toEnum . fromEnum $ uop--specialIToUOp :: Int16 -> UnaryOp-specialIToUOp specialI = toEnum . fromEnum $ specialI--biOpToSpecialI :: BinaryOp -> Int16-biOpToSpecialI theBiOp = toEnum . fromEnum $ theBiOp--specialIToBiOp :: Int16 -> BinaryOp-specialIToBiOp theBiOp = toEnum . fromEnum $ theBiOp---sdLitPretty :: LiteralSynthDef -> String-sdLitPretty synthDef = mconcat [-    "Constants: ", show $ _synthDefConstants synthDef-  , "\n"---  , show $ zip (_synthDefParameters synthDef) (_synthDefParamNames synthDef)-  , show $ map (\(ParamName a i)->(a, _synthDefParameters synthDef !! fromIntegral i)) (_synthDefParamNames synthDef)-  , "\n"-  , mconcat$-      (flip map) (zip [0::Int ..] (_synthDefUGens synthDef)) $ \(i,ug) -> mconcat [-                show i <> " " <> show (_uGenSpec_name ug) <> " - " <> show (_uGenSpec_calcRate ug) <> " (" <> show ((length::[a]->Int) $ _uGenSpec_outputs ug) <> " outputs)"-               ,"\n"-               ,mconcat $ map ((<>"\n") . ("  "<>) . showInputSpec) $ _uGenSpec_inputs ug-               ,case BS8.unpack (_uGenSpec_name ug) of-                   "UnaryOpUGen" -> mconcat [ "  "-                      , show ( specialIToUOp (_uGenSpec_specialIndex ug))-                      , "\n" ]-                   "BinaryOpUGen" ->-                      "  " <> show (specialIToBiOp (_uGenSpec_specialIndex ug)) <> "\n"--                   _ -> ""-               ]-  ]- where-   showInputSpec :: InputSpec -> String-   showInputSpec (InputSpec_Constant constantIndex) = mconcat [-       "Constant: "-      ,show $ (_synthDefConstants synthDef) !! fromEnum constantIndex-      ," (index ", show constantIndex, ")"-      ]-   showInputSpec (InputSpec_UGen ugNum ugOut) =-      "UGOut: "<>show (ugNum, ugOut)---   showInputSpec x = show x

@@ -1,14 +1,22 @@ {-# OPTIONS_HADDOCK show-extensions #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +{-# LANGUAGE CPP #-}+ {-# LANGUAGE FlexibleInstances #-} +-- {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE GADTs, NoMonoLocalBinds #-}+-- {-# LANGUAGE DefaultSignatures #-}+-- {-# LANGUAGE ExtendedDefaultRules #-}+-- {-# LANGUAGE FlexibleContexts #-}+-- {-# LANGUAGE GADTs, NoMonoLocalBinds #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}+-- {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}+{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-}  {-# LANGUAGE NoMonomorphismRestriction #-}@@ -17,33 +25,51 @@      ToSig(..)    ) where +import Vivid.SC.Server.Types (BufferId(..)) import Vivid.SynthDef.Types-import Vivid.SCServer.Types -import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.ByteString.UTF8 as UTF8+-- import Data.Proxy import GHC.TypeLits --- | Don't define other instances of this! (Unless you know what you're doing)---   Instance resolution could get screwed up. class ToSig s (args :: [Symbol]) where    toSig :: s -> SDBody' args Signal  instance ToSig Signal args where    toSig :: Signal -> SDBody' args Signal-   toSig = return+   toSig = pure  instance (KnownSymbol a, Subset '[a] args) => ToSig (Variable a) args where-   toSig a = (return . Param . BS8.pack . symbolVal) a+   toSig a = (return . Param . UTF8.fromString . symbolVal) a --- Incoherent is just to get numbers defaulting to Floats in a useful way in--- SynthDefs. The type resolution algorithm should never give weird behavior--- as long as other instances aren't defined:+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 801 +instance ToSig Integer args where+   toSig = pure . Constant . realToFrac++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+++-- Incoherent is to get numbers defaulting to Floats in a useful way in+-- SynthDefs. The type resolution algorithm should rarely (discovery: not+-- never!) give weird behavior as long as other instances aren't defined:+ -- | For 'Constant' (Float) values instance {-# INCOHERENT #-} (Num n, Real n) => ToSig n args where    toSig :: n -> SDBody' args Signal    toSig = return . Constant . realToFrac +#endif+ -- This way instead of e.g. -- > BufferId b <- makeBuffer 1 -- > playBuf (buf_ $ toEnum $ fromEnum b@@ -51,6 +77,7 @@ -- we can say: -- > b <- makeBuffer 1 -- > playBuf (buf_ b+-- instance ToSomeSig BufferId where instance ToSig BufferId args where    toSig :: BufferId -> SDBody' args Signal    toSig (BufferId n) = (return . Constant . realToFrac) n

@@ -4,18 +4,18 @@ -- {-# LANGUAGE DeriveGeneric #-}  {-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs, NoMonoLocalBinds #-}+-- {-# LANGUAGE GADTs, NoMonoLocalBinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoUndecidableInstances #-} +-- TODO: rename so  module Vivid.SynthDef.Types (      Signal(..)-   , CalculationRate(..)    , SynthDef(..)    , SDName(..)    , SDBody'@@ -23,11 +23,10 @@    , zoomSynthDef    , UGen(..)    , UGenName(..)-   , UnaryOp(..)-   , BinaryOp(..)    , module Vivid.SynthDef.TypesafeArgs    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..), UnaryOp(..), BinaryOp(..)) import Vivid.SynthDef.TypesafeArgs -- (VarSet(..), Subset, Parameter)  import Control.Monad.State (State, get, runState, put)@@ -90,17 +89,6 @@  -- instance Hashable UGenName --- The order of these is important for the enum instance:--- | The rate that a UGen computes at-data CalculationRate-   = IR -- ^ constant value-   | KR -- ^ control rate-   | AR -- ^ audio rate-   | DR -- ^ demand rate- deriving (Show, Read, Eq, Enum, Ord)---- instance Hashable CalculationRate- -- | State monad to construct SynthDefs --  --   The SynthDef is an under-construction synth definition@@ -140,65 +128,3 @@    return val  --- | Binary signal operations. For the simple ones (like 'Add', 'Mul', etc.),---   there are functions (like 'Vivid.UGens.~+', 'Vivid.UGens.~*', etc.)---   that wrap them up so you---   don't have to make a ugen for them yourself.--- ---   In the future these may not be exported -- we'll just have functions for---   all of them.-data BinaryOp-   = Add | Sub | Mul -   | IDiv -- ^ Integer division-   | FDiv -- ^ Float division-   | Mod | Eq | Ne | Lt | Gt | Le | Ge-   | Min | Max | BitAnd | BitOr | BitXor | Lcm | Gcd | Round | RoundUp | Trunc-   | Atan2 | Hypot | Hypotx | Pow | ShiftLeft | ShiftRight | UnsignedShift | Fill-   -- comments come from SC source:-   | Ring1 -- ^ a * (b + 1) == a * b + a-   | Ring2 -- ^ a * b + a + b-   | Ring3 -- ^ a * a * b-   | Ring4 -- ^ a * a * b - a * b * b-   | DifSqr -- ^ a * a - b * b-   | SumSqr -- ^ a * a + b * b-   | SqrSum -- ^ (a + b) ^ 2-   | SqrDif -- ^ (a - b) ^ 2-   | AbsDif -- ^ abs(a - b)-   | Thresh-   | AMClip-   | ScaleNeg-   | Clip2 -- Like 'Vivid.UGens.Maths.clip' but the min value is always the negative of the max value-   | Excess-   | Fold2 | Wrap2 | FirstArg-   | RandRange | ExpRandRange | NumBinarySelectors- deriving (Show, Eq, Ord, Enum)---- instance Hashable BinaryOp---- These seem to only be in the SuperCollider source:---   sc/server/plugins/(Bi|U)naryOpUgens.cpp---- | Unary signal operations. Many of these have functions so you don't need to---   use this internal representation (e.g. 'Neg' has 'neg', etc).--- ---   This type might not be exposed in the future.-data UnaryOp-   = Neg | Not | IsNil | NotNil-   | BitNot -- ^ There's a bug in some SC versions where .bitNot isn't implemented-            --   correctly. Vivid backfills it with a fix, so you can use BitNot with-            --   any SC version-   | Abs | AsFloat | AsInt | Ciel | Floor-   | Frac | Sign | Squared | Cubed | Sqrt | Exp | Recip | MIDICPS | CPSMIDI-   | MIDIRatio | RatioMIDI-    -- dbamp and ampdb: converts betw db and "amp" so that e.g. -inf db == 0 amp-    -- dunno how the other scaling works-   | DbAmp | AmpDb-   | OctCPS | CPSOct | Log | Log2 | Log10-   | Sin | Cos | Tan | ArcSin | ArcCos | ArcTan | SinH | CosH | TanH-   | Rand | Rand2 | LinRand | BiLinRand | Sum3Rand-   | Distort | SoftClip | Coin | DigitValue-   | Silence | Thru | RectWindow | HanWindow | WelchWindow | TriWindow | Ramp-   | SCurve | NumUnarySelectors- deriving (Show, Eq, Ord, Enum)---- instance Hashable UnaryOp

@@ -3,10 +3,11 @@  -- {-# LANGUAGE ConstraintKinds -} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GADTs, NoMonoLocalBinds #-}+-- {-# LANGUAGE GADTSyntax, NoMonoLocalBinds #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -14,7 +15,7 @@ -- {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-} {-# LANGUAGE TypeOperators #-} -- Needed for a nested type family instance: {-# LANGUAGE UndecidableInstances #-}@@ -153,9 +154,9 @@    SetEqual a b = SubsetBoolToBool (IsSubsetOf a b) && SubsetBoolToBool (IsSubsetOf b a)  +data Variable (a :: Symbol) =+   KnownSymbol a => V -data Variable a  where-   V :: KnownSymbol a => Variable a  data Vs (a :: [Symbol]) = Vs @@ -194,8 +195,8 @@ emptyVarSet :: VarSet '[] emptyVarSet = VarSet -data I (x :: Symbol) where-   I :: (KnownSymbol x) => Float -> I x+data I (x :: Symbol) =+   KnownSymbol x => I Float  instance (KnownSymbol s) => Show (I s) where    show (I f) =

@@ -64,7 +64,7 @@ --   , module Vivid.UGens.Multichannel.Panners    , module Vivid.UGens.Random    , module Vivid.UGens.Reverbs-   -- , module Vivid.UGens.SynthControl+   , module Vivid.UGens.SynthControl    , module Vivid.UGens.Triggers    -- , module Vivid.UGens.Undocumented    , module Vivid.UGens.UserInteraction@@ -102,7 +102,7 @@ --import Vivid.UGens.Multichannel.Panners import Vivid.UGens.Random import Vivid.UGens.Reverbs--- import Vivid.UGens.SynthControl+import Vivid.UGens.SynthControl import Vivid.UGens.Triggers -- import Vivid.UGens.Undocumented import Vivid.UGens.UserInteraction

@@ -5,7 +5,7 @@  {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -17,10 +17,13 @@    , (~*)    , (~**)    , (~/)++{- -- removed these to be compatible with tidal, which also uses some of these:    , (~>)    , (~>=)    , (~<)    , (~<=)+-}    , binaryOp    , biOp    , unaryOp@@ -59,6 +62,7 @@ (~/) :: (ToSig i0 a, ToSig i1 a) => i0 -> i1 -> SDBody' a Signal (~/) = binaryOp FDiv +{- infix 4 ~> -- | Test signals for left greater than right (~>) :: (ToSig i0 a, ToSig i1 a) => i0 -> i1 -> SDBody' a Signal@@ -78,6 +82,7 @@ -- | Test signals for left less than or equal to right (~<=) :: (ToSig i0 a, ToSig i1 a) => i0 -> i1 -> SDBody' a Signal (~<=) = binaryOp Le+-}  infixl 6 ~- -- | Subtract signals

@@ -35,6 +35,7 @@    -- , slope    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args@@ -77,13 +78,21 @@ --- keyTrack :: --- keyTrack = --- | "This is a better pitch follower than ZeroCrossing, but more costly of CPU. For most purposes the default settings can be used and only in needs to be supplied. Pitch returns two values (via an Array of OutputProxys, see the OutputProxy help file), a freq which is the pitch estimate and hasFreq, which tells whether a pitch was found. Some vowels are still problematic, for instance a wide open mouth sound somewhere between a low pitched short 'a' sound as in 'sat', and long 'i' sound as in 'fire', contains enough overtone energy to confuse the algorithm."+-- | "This is a better pitch follower than ZeroCrossing, but more costly of CPU. For most purposes the default settings can be used and only in needs to be supplied."+--   +--   "[This function] returns two values [...], a freq which is the pitch estimate and hasFreq, which tells whether a pitch was found."+--+--   Note -- as this returns a 2-tuple of 'Signal's -- that you may need to be careful not+--   to accidentally use functions from the Foldable instance for (,) with the return+--   value of 'pitch'. -- +--   "Some vowels are still problematic, for instance a wide open mouth sound somewhere between a low pitched short 'a' sound as in 'sat', and long 'i' sound as in 'fire', contains enough overtone energy to confuse the algorithm."+--  --   "None of these settings are time variable." --  --   Can only run at "KR"-pitch :: (Args '["in"] '["initFreq", "minFreq", "maxFreq", "execFreq", "maxBinsPerOctave", "median", "ampThreshold", "peakThreshold", "downSample", "clar"] a) => a -> SDBody a Signal-pitch = makeUGen+pitch :: (Args '["in"] '["initFreq", "minFreq", "maxFreq", "execFreq", "maxBinsPerOctave", "median", "ampThreshold", "peakThreshold", "downSample", "clar"] a) => a -> SDBody a (Signal, Signal)+pitch = ((\[a,b]->(a,b)) <$>) . makePolyUGen 2    "Pitch" KR    (Vs::Vs '["in", "initFreq", "minFreq", "maxFreq", "execFreq", "maxBinsPerOctave", "median", "ampThreshold", "peakThreshold", "downSample", "clar"])    (initFreq_ (440::Float), minFreq_ (60 ::Float), maxFreq_ (4000 ::Float), execFreq_ (100::Float), maxBinsPerOctave_ (16::Float), median_ (1::Float), ampThreshold_ (0.01::Float), peakThreshold_ (0.5::Float), downSample_ (1::Float), clar_ (0::Float))

@@ -14,7 +14,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PartialTypeSignatures #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-} {-# LANGUAGE TypeOperators #-}  @@ -24,11 +24,12 @@  module Vivid.UGens.Args where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA -- import Vivid.SynthDef.TypesafeArgs (getSymbolVals) -import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.ByteString.UTF8 as UTF8 (fromString) import qualified Data.Map as Map -- import Data.Monoid -- import GHC.TypeLits@@ -106,6 +107,10 @@ bw_ :: ToSig s as => s -> UA "bw" as bw_ = UA . toSig +-- Maybe should actually just be "bw"?:+bwFreq_ :: ToSig s as => s -> UA "bwFreq" as+bwFreq_  = UA . toSig+ bwr_ :: ToSig s as => s -> UA "bwr" as bwr_ = UA . toSig @@ -177,6 +182,9 @@ decaytime_ :: ToSig s as => s -> UA "decaySecs" as decaytime_ = decaySecs_ +default_ :: ToSig s as => s -> UA "default" as+default_ = UA . toSig+ -- | Alias of 'delaySecs_' for SC compatibility delay_ :: ToSig s as => s -> UA "delaySecs" as delay_ = delaySecs_@@ -201,6 +209,9 @@ depthVariation_ :: ToSig s as => s -> UA "depthVariation" as depthVariation_ = UA . toSig +div_ :: ToSig s as => s -> UA "div" as+div_ = UA . toSig+ dn_ :: ToSig s as => s -> UA "dn" as dn_ = UA . toSig @@ -216,9 +227,9 @@ dstlo_ :: ToSig s as => s -> UA "dstlo" as dstlo_ = UA . toSig --- | Alias of 'secs_'-dur_ :: ToSig s as => s -> UA "secs" as-dur_ = secs_+-- | Alias of 'duration_'+dur_ :: ToSig s as => s -> UA "duration" as+dur_ = duration_  duration_ :: ToSig s as => s -> UA "duration" as duration_ = UA . toSig@@ -243,6 +254,9 @@ fftsize_ :: ToSig s as => s -> UA "fftSize" as fftsize_ = fftSize_ +formFreq_ :: ToSig s as => s -> UA "formFreq" as+formFreq_ = UA . toSig+ frames_ :: ToSig s as => s -> UA "numFrames" as frames_ = numFrames_ @@ -262,6 +276,9 @@ friction_ :: ToSig s as => s -> UA "friction" as friction_ = UA . toSig +fundFreq_ :: ToSig s as => s -> UA "fundFreq" as+fundFreq_ = UA . toSig+ g_ :: ToSig s as => s -> UA "g" as g_ = UA . toSig @@ -590,8 +607,24 @@    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 (BS8.pack sdName)) calcRate (signals :: [Signal]) numOuts+   addUGenF $ UGen (UGName_S (UTF8.fromString sdName)) calcRate (signals :: [Signal]) numOuts +makeMonoUGen, makeUGen :: (+     GetSymbolVals (Vs tags)+   , FromUA optional+   , FromUA userSupplied+   , SDBodyArgs optional ~ SDBodyArgs userSupplied+   , SDBodyArgs optional ~ args+   ) => String -> CalculationRate -> Vs tags -> optional -> (userSupplied -> SDBody' args Signal) makeMonoUGen = makeMakeUGen addMonoUGen 1-makePolyUGen n = makeMakeUGen addPolyUGen n makeUGen = makeMonoUGen++makePolyUGen :: (+     GetSymbolVals (Vs tags)+   , FromUA optional+   , FromUA userSupplied+   , SDBodyArgs optional ~ SDBodyArgs userSupplied+   , SDBodyArgs optional ~ args+   ) => Int -> String -> CalculationRate -> Vs tags -> optional -> (userSupplied -> SDBody' args [Signal])+makePolyUGen n = makeMakeUGen addPolyUGen n+

@@ -1,6 +1,9 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -53,11 +56,13 @@ ---   , wrapIndex    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args  import Data.Proxy+import GHC.Real (Ratio((:%)))  -- | Add a single LocalBuf for FFT -- @@ -72,13 +77,20 @@    addUGen $ UGen (UGName_S "LocalBuf") IR [numChannels', numFrames', mlb] 1  --- | Unlike in SC, "doneAction" defaults to 2+-- | Unlike in SC, \"doneAction\\" defaults to 2+-- +--   Also, the default rate is the 'bufRateScale' of the buffer playBuf :: (Args '["buf"] '["rate","trigger","startPos","loop","doneAction"] a) => a -> SDBody a Signal-playBuf = makeUGen+playBuf args = ($ args) $ makeUGen    "PlayBuf" AR    (Vs::Vs '["buf","rate","trigger","startPos","loop","doneAction"])-   (rate_ ((1)::Float), trigger_ ((1)::Float), startPos_ ((0)::Float)+   (rate_ defaultRate, trigger_ ((1)::Float), startPos_ ((0)::Float)    ,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+        -- update docs too:+          -- todo : put bufratescale on all of em if we decide to keep this behavior+   defaultRate = bufRateScale $ uaArgVal args (V::V "buf")   -- | Unlike in SC, "doneAction" defaults to 2 and "loop" defaults to 0@@ -89,14 +101,14 @@    -- 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 it's not recommended.+-- | 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    "BufChannels" KR    (Vs::Vs '["buf"])    NoDefaults --- | Defaults to 'KR'. Can be 'IR' too but it's not recommended.+-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so! bufDur :: (Args '["buf"] '[] a) => a -> SDBody a Signal bufDur = makeUGen    "BufDur" KR@@ -105,7 +117,7 @@  -- bufFrames :: (Args '["buf"] '[] a) => a -> SDBody a Signal --- | Defaults to 'KR'. Can be 'IR' too but it's not recommended.+-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so! --  --   Note you don't need to use "buf_" when you use this bufFrames :: ToSig s as => s -> SDBody' as Signal@@ -116,18 +128,18 @@  -- bufRateScale :: (Args '["buf"] '[] a) => a -> SDBody a Signal --- | Defaults to 'KR'. Can be 'IR' too but it's not recommended.+-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so! --  --   Note you don't need to use "buf_" when you use this bufRateScale :: ToSig s as => s -> SDBody' as Signal-bufRateScale = (flip (.)) buf_ $ makeUGen+bufRateScale = (. buf_) $ makeUGen    "BufRateScale" KR    (Vs::Vs '["buf"])    NoDefaults  -- bufSampleRate :: (Args '["buf"] '[] a) => a -> SDBody a Signal --- | Defaults to 'KR'. Can be 'IR' too but it's not recommended.+-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so! --  --   Note you don't need to use "buf_" when you use this bufSampleRate :: ToSig s as => s -> SDBody' as Signal@@ -138,7 +150,7 @@  -- bufSamples :: (Args '["buf"] '[] a) => a -> SDBody a Signal --- | Defaults to 'KR'. Can be 'IR' too but it's not recommended.+-- | Defaults to 'KR'. Can be 'IR' too but be careful that the buffer doesn't change if so! --  --   Note you don't need to use "buf_" when you use this bufSamples :: ToSig s as => s -> SDBody' as Signal@@ -147,12 +159,21 @@    (Vs::Vs '["buf"])    NoDefaults --- | "phase" must be at audio rate ('AR')-bufRd :: (Args '[{- "numChans",-} "buf", "phase"] '["loop", "interp"] a) => a -> SDBody a Signal-bufRd = makeUGen-   "BufRd" AR-   (Vs::Vs '[{- "numChans", -} "buf", "phase", "loop", "interp"])-   (loop_ ((1)::Float), interp_ ((2)::Float))+-- | \"phase\" must be at audio rate ('AR')+-- +--   \"numChans\" can't be set after the synth is created, and must be a fixed integer+bufRd :: Args '["numChans", "buf", "phase"] '["loop", "interp"] a => a -> SDBody a [Signal]+bufRd args = do+   numChans <- uaArgVal args (V::V "numChans") >>= \case+      Constant x -> case toRational x of+         n :% 1 -> pure $ fromInteger n+         _ -> error $ "bufRd: numChans not an integer!: " ++ show x+      _ -> error "bufrd: not a fixed integer!"+   makePolyUGen numChans+      "BufRd" AR+      (Vs::Vs '["buf", "phase", "loop", "interp"])+      (loop_ ((1)::Float), interp_ ((2)::Float))+      args  -- | "phase" must be at audio rate ('AR') bufWr :: (Args '["in", {- "numChans", -} "buf", "phase"] '["loop"] a) => a -> SDBody a Signal

@@ -1,6 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -14,9 +14,11 @@ ---   , t2k    ) where ++import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef -import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.ByteString.UTF8 as UTF8   -- | Convert an audio rate signal to a control rate signal@@ -47,7 +49,7 @@          ]    addUGen $ UGen (UGName_S letters) toRate [s'] 1  where-   letters = BS8.pack [calcLetter fromRate,'2',calcLetter toRate]+   letters = UTF8.fromString [calcLetter fromRate,'2',calcLetter toRate]    calcLetter = \case       KR -> 'K'       AR -> 'A'

@@ -15,6 +15,7 @@ ---   , stereoConvolution2L    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.UGens.Args import Vivid.SynthDef import Vivid.SynthDef.FromUA

@@ -41,12 +41,13 @@    , delayC    , delayL    , delayN----   , pluck+   , pluck ---   , tDelay    ) where  -- import Data.ByteString (ByteString) +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args@@ -129,7 +130,12 @@    (Vs::Vs '["in", "maxDelaySecs", "delaySecs"])    (maxDelayTime_ (0.2::Float), delayTime_ (0.2::Float)) ---- pluck ::---- pluck =+pluck :: Args '[] '["in","trigger","maxDelaySecs","delaySecs","decaySecs","coef"] a => a -> SDBody a Signal+pluck = makeUGen+   "Pluck" AR+   (Vs::Vs '["in","trigger","maxDelaySecs","delaySecs","decaySecs","coef"])+   (in_ (0::Float), trigger_ (1::Float), maxDelaySecs_ (0.2::Float)+   ,delaySecs_ (0.2::Float), decaySecs_ (1::Float), coef_ (0.5::Float))+ --- tDelay :: --- tDelay =

@@ -35,13 +35,14 @@ ---   , tDuty    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.UGens.Args import Vivid.SynthDef -- import Vivid.SynthDef.TypesafeArgs import Vivid.SynthDef.FromUA  -- import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.UTF8 as UTF8 import Data.Proxy  -- | This correctly decodes/encodes to OSC:@@ -57,7 +58,7 @@ dbrown = demandBrownian "Dbrown"  -- | Defaults to 'KR'-demand :: Args '[] '["trigger","reset","ugen"] a => a -> SDBody a Signal+demand :: Args '["trigger","reset","ugen"] '[] a => a -> SDBody a Signal demand = makeUGen    "Demand" KR    (Vs::Vs '["trigger","reset","ugen"])@@ -84,7 +85,7 @@ --- dpoll :: --- dpoll = --- | \"'dxrand' never plays the same value twice, whereas 'drand' chooses any value in the list\"+-- | \"'dxrand' never plays the same value twice, whereas drand chooses any value in the list\" drand :: (Args '[] '["repeats"] a, ToSig s (SDBodyArgs a)) => a -> [s] -> SDBody a Signal drand = drawFromList "Drand" @@ -100,7 +101,7 @@ drawFromList ugName args sigs = do    sigs' <- mapM toSig sigs    reps <- uaArgValWDefault (1::Float) args (Proxy::Proxy "repeats")-   addUGen $ UGen (UGName_S $ BS8.pack ugName) DR (reps:sigs') 1+   addUGen $ UGen (UGName_S $ UTF8.fromString ugName) DR (reps:sigs') 1  dser :: (Args '[] '["repeats"] a, ToSig s (SDBodyArgs a)) => a -> [s] -> SDBody a Signal dser = drawFromList "Dser"@@ -134,7 +135,7 @@ --- dwrand :: --- dwrand = --- | \"'dxrand' never plays the same value twice, whereas 'drand' chooses any value in the list\"+-- | \"dxrand never plays the same value twice, whereas 'drand' chooses any value in the list\" dxrand :: (Args '[] '["repeats"] a, ToSig s (SDBodyArgs a)) => a -> [s] -> SDBody a Signal dxrand = drawFromList "Dxrand" 

@@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -13,6 +13,7 @@    , normalizer    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA --- import Vivid.SynthDef.TypesafeArgs@@ -30,7 +31,7 @@  -- | Note this can only run at "AR" -- ---   \"secs\" is the lookahead time -- if you're coming from SC you can use 'Vivid.UGens.Args.dur_'+--   \"secs\" is the lookahead time -- if you're coming from SC you can use 'Vivid.UGens.Args.dur_' for consistency limiter :: (Args '["in"] '["level", "secs"] a) => a -> SDBody a Signal limiter = makeUGen    "Limiter" AR

@@ -5,7 +5,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-} {-# LANGUAGE ViewPatterns #-}  {-# LANGUAGE FlexibleContexts #-}@@ -34,6 +34,7 @@    ) where  import Vivid.Envelopes+import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA -- import Vivid.SynthDef.TypesafeArgs@@ -46,7 +47,7 @@ import Data.Proxy  -- | Defaults to 'AR'-adsrGen :: (Args '[] '["peakLevel", {- "curve", -} "bias", "gate", "doneAction"] as, ToSig attackTime (SDBodyArgs as), ToSig delayTime (SDBodyArgs as), ToSig sustainLevel (SDBodyArgs as), ToSig releaseTime (SDBodyArgs as)) => attackTime -> delayTime -> sustainLevel -> releaseTime -> EnvCurve -> as -> SDBody as Signal+adsrGen :: (Args '[] '["peakLevel", {- "curve", -} "bias", "gate", "doneAction"] as, ToSig attackTime (SDBodyArgs as), ToSig decayTime (SDBodyArgs as), ToSig sustainLevel (SDBodyArgs as), ToSig releaseTime (SDBodyArgs as)) => attackTime -> decayTime -> sustainLevel -> releaseTime -> EnvCurve -> as -> SDBody as Signal adsrGen attackTime decayTime sustainLevel releaseTime curve userArgs = do    attackTime' <- toSig attackTime    decayTime' <- toSig decayTime@@ -88,9 +89,11 @@ --- dadsrGen =  +-- TODO: do we need 'fadeSecs' anymore? maybe we should just use 'releaseIn'... envGate :: Subset '["gate","fadeSecs"] a => SDBody' a Signal envGate = do-   gate <- (V::V "fadeSecs") ~<= (0::Float)+     -- Le -- less than or equal+   gate <- biOp Le (V::V "fadeSecs") (0::Float)    let theEnv = EnvLiterally {             _envLiterally_initialVal = gate           , _envLiterally_releaseNode = Just 1@@ -138,20 +141,20 @@ --   Note this won't change after it's created, so if you'd like --   to e.g. be able to change the \"freq\" in -- ---   > line (start_ 0, end_ (A::A "freq"))+--   > line (start_ 0, end_ (V::V "freq")) --  --   you should write -- ---   > (A::A "freq") ~* line (start_ 0, end_ 1)+--   > (V::V "freq") ~* line (start_ 0, end_ 1) --  --   instead. --  --   Defaults to KR-line :: (Args '[] '["start","end","secs","doneAction"] a) => a -> SDBody a Signal+line :: (Args '[] '["start","end","duration","doneAction"] a) => a -> SDBody a Signal line = makeUGen    "Line" AR-   (Vs::Vs '["start","end","secs","doneAction"])-   (start_ (0::Float), end_ (0::Float), secs_ (1::Float), doneAction_ (0::Float))+   (Vs::Vs '["start","end","duration","doneAction"])+   (start_ (0::Float), end_ (0::Float), duration_ (1::Float), doneAction_ (0::Float))  -- | "Simple linear envelope generator" -- @@ -165,6 +168,7 @@    (gate_ (1::Float), attackTime_ (0.01::Float), susLevel_ (1::Float), releaseTime_ (1::Float), doneAction_ (0::Float))  + -- | Percussive hit --  --   'doneAction' is currently 2 but may either be 0 or 2 in future versions@@ -186,8 +190,8 @@ -- | \"Generates an exponential curve from the start value to the end value. Both the start and end values must be non-zero and have the same sign.\" --  -- Defaults to KR-xLine :: (Args '[] '["start","end","secs","doneAction"] a) => a -> SDBody a Signal+xLine :: (Args '[] '["start","end","duration","doneAction"] a) => a -> SDBody a Signal xLine = makeUGen    "XLine" KR-   (Vs::Vs '["start","end","secs","doneAction"])-   (start_ (1::Float), end_ (2::Float), secs_ (1::Float), doneAction_ (0::Float))+   (Vs::Vs '["start","end","duration","doneAction"])+   (start_ (1::Float), end_ (2::Float), duration_ (1::Float), doneAction_ (0::Float))

@@ -1,12 +1,19 @@ {-# LANGUAGE DataKinds #-}+-- HERE:+{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}  module Vivid.UGens.Examples where  import Vivid +import Vivid.SC.SynthDef.Types+ -- | 'Dbrown' example from the SC help file+-- HERE:+dbrown_example :: SDBody' a [Signal] dbrown_example = do    mx <- mouseX (min_ 1, max_ 40, warp_ 1)    imp <- impulse (freq_ mx) ? KR

@@ -70,6 +70,7 @@ ---   , pv_rectComb2    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.UGens.Args import Vivid.SynthDef.FromUA@@ -90,8 +91,10 @@  --- fftTrigger :: --- fftTrigger =---- packFFT ::++--- packFFT :: Args ["buf","bufsize","magsphases","tobin"] '["frombin","zeroothers"] a => a -> SDBody a Signal --- packFFT =+-- frombin: 0, zeroothers: 0  {- "@@ -109,14 +112,18 @@ --- specPcile :: --- specPcile = ---- unpack1FFT ::+--- unpack1FFT :: Args '["chain","bufsize","binindex"] '["whichmeasure"] a => SDBody a Signal --- unpack1FFT =---- unpackFFT ::+-- whichmeasure: 0++--- unpackFFT :: Args '["chain","bufsize","tobin"] '["frombin"] a => SDBody a Signal --- unpackFFT =+-- frombin: 0 ---- pv_add ::---- pv_add =+--- pv_add :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal+--- pv_add bufA bufB = + pv_binScramble :: (Args '["buf"] '["wipe", "width", "trigger"] a) => a -> SDBody a Signal pv_binScramble = makeUGen    "PV_BinScramble" KR@@ -153,19 +160,21 @@    (Vs::Vs '["buf"])    NoDefaults ---- pv_copy ::---- pv_copy =---- pv_copyPhase ::---- pv_copyPhase =+--- pv_copy :: (ToSig bufA as, ToSig bufB as) => SDBody' as Signal+--- pv_copy bufA bufB = +--- pv_copyPhase :: (ToSig bufA as, ToSig bufB as) => SDBody' as Signal+--- pv_copyPhase bufA bufB =+ 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 ::---- pv_div =+--- pv_div :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal+--- pv_div bufA bufB =+ --- pv_hainsworthFoote :: --- pv_hainsworthFoote = --- pv_jensenAndersen ::@@ -232,12 +241,13 @@    (Vs::Vs '["buf"])    NoDefaults ---- pv_max ::---- pv_max =---- pv_min ::---- pv_min =---- pv_mul ::---- pv_mul =+--- 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_phaseShift :: (Args '["buf", "shift"] '["integrate"] a) => a -> SDBody a Signal pv_phaseShift = makeUGen

@@ -17,6 +17,7 @@    , moogFF    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args

@@ -1,6 +1,6 @@ -- | These UGens only run at audio rate ('AR') -- ---   They also can cause CPU spikes when their parameters are changed+--   They also can cause CPU spikes when their parameters are changed!  {-# LANGUAGE DataKinds #-} @@ -21,6 +21,7 @@    , bPeakEQ    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args@@ -52,9 +53,7 @@    (Vs::Vs '["in", "freq", "bw"])    (freq_ (1200::Float), bw_ (1::Float)) --- | Can cause CPU spikes--- ---   This is only in AR+-- | This is only in AR bHiPass :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal bHiPass = makeUGen    "BHiPass" AR

@@ -21,7 +21,7 @@    , hpz1    , hpz2    , integrator----   , klank+   , klank    , lag    , lag2    , lag3@@ -45,10 +45,13 @@    ) where  -- import Vivid.OSC+import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.UGens.Args import Vivid.SynthDef.FromUA +import qualified Data.ByteString.UTF8 as UTF8+import Data.Monoid import Data.Proxy  -- import Data.ByteString (ByteString)@@ -126,33 +129,73 @@    (Vs::Vs '["in"])    NoDefaults -hpz2 :: (Args '["in"] '[] a) => a -> SDBody a Signal+hpz2 :: Args '["in"] '[] a => a -> SDBody a Signal hpz2 = makeUGen    "HPZ2" AR    (Vs::Vs '["in"])    NoDefaults -integrator :: (Args '["in"] '["coef"] a) => a -> SDBody a Signal+integrator :: Args '["in"] '["coef"] a => a -> SDBody a Signal integrator = makeUGen    "Integrator" AR    (Vs::Vs '["in", "coef"])    (coef_ (1::Float)) ---- klank ::---- klank = +-- todo: i want either 'freqScale' or a way to pass in params to the list of frequencies++-- | \"Klank is a bank of fixed frequency resonators which can be used to simulate the resonant modes of an object. Each mode is given a ring time, which is the time for the mode to decay by 60 dB\"+-- +--   The 'in_' argument is \"the excitation input to the resonant filter bank\"+-- +--   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 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 ]++{-+3 "Klank" - AR (1 outputs)+  UGOut: (2,0) -- "excitation input" thing+  Constant: 1.0 (index 3) -- freqscale+  Constant: 0.0 (index 4) -- freqoffset+  Constant: 1.0 (index 5) -- decayscale++  Constant: 220.0 (index 6) -- frequency+  Constant: 0.5 (index 7)   -- amplitude+  Constant: 1.0 (index 8)   -- rungTime++  Constant: 440.0 (index 9)+  Constant: 1.0 (index 8)+  Constant: 1.0 (index 8)++  Constant: 880.0 (index 10)+  Constant: 0.5 (index 7)+  Constant: 1.0 (index 8)+-}+ -- | The \"lagSecs\" arg is the same as the \"lagTime\" arg in SC --   (you can use 'Vivid.UGens.Args.lagTime_' if you like) -- --   The calculation rate of this is whatever its \"in\" is (cool, right?)-lag :: (Args '["in"] '["lagSecs"] a) => a -> SDBody a Signal+lag :: Args '["in"] '["lagSecs"] a => a -> SDBody a Signal lag as = do    makeThing =<< getCalcRate =<< uaArgVal as (Proxy::Proxy "in")  where-   makeThing calcRate = (flip ($)) as $ makeUGen+   makeThing calcRate = ($ as) $ makeUGen       "Lag" calcRate       (Vs::Vs '["in", "lagSecs"])-      (lagTime_ (0.1::Float))+      (lagSecs_ (0.1::Float))  -- | 'lag2 (in_ x)' is equal to 'lag (in_ (lag (in_ x)))' --@@ -161,7 +204,7 @@ lag2 as =    makeThing =<< getCalcRate =<< uaArgVal as (Proxy::Proxy "in")  where-   makeThing calcRate = (flip ($)) as $ makeUGen+   makeThing calcRate = ($ as) $ makeUGen       "Lag2" calcRate       (Vs::Vs '["in", "lagSecs"])       (lagTime_ (0.1::Float))@@ -173,7 +216,7 @@ lag3 as =    makeThing =<< getCalcRate =<< uaArgVal as (Proxy::Proxy "in")  where-   makeThing calcRate = (flip ($)) as $ makeUGen+   makeThing calcRate = ($ as) $ makeUGen       "Lag3" calcRate       (Vs::Vs '["in", "lagSecs"])       (lagTime_ (0.1::Float))

@@ -18,7 +18,8 @@    , tBall    ) where -import Vivid.SynthDef (CalculationRate(AR), {- SDBody, -} Signal)+import Vivid.SC.SynthDef.Types (CalculationRate(..))+import Vivid.SynthDef ({- SDBody, -} Signal) import Vivid.UGens.Args import Vivid.SynthDef.FromUA import Vivid.SynthDef.TypesafeArgs

@@ -11,6 +11,7 @@    , vibrato    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.UGens.Args import Vivid.SynthDef.FromUA

@@ -31,6 +31,7 @@ ---   , standardN    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.UGens.Args import Vivid.SynthDef import Vivid.SynthDef.FromUA

@@ -12,7 +12,7 @@      -- In Vivid.UGens.Filters:    -- , dynKlank      fSinOsc----   , formant+   , formant    , impulse ---   , klang      -- In Vivid.UGens.Filters:@@ -40,6 +40,7 @@ ---   , vOsc3    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args@@ -57,8 +58,13 @@    (Vs::Vs '["freq", "phase"])    (phase_ (0::Float)) ---- formant ::---- formant =+-- | Only runs at audio rate. All arguments must be at control rate or constant.+--   \"bwFreq\" must be greater than or equal to \"fundFreq\".+formant :: Args '["fundFreq", "formFreq", "bwFreq"] '[] a => a -> SDBody a Signal+formant = makeUGen+   "Formant" AR+   (Vs::Vs '["fundFreq", "formFreq", "bwFreq"])+   NoDefaults  impulse :: (Args '["freq"] '["phase"] a) => a -> SDBody a Signal impulse = makeUGen@@ -73,7 +79,7 @@ lfCub = makeUGen    "LFCub" AR    (Vs::Vs '["freq", "iphase"])-   (freq_ (440::Float))+   (iphase_ (0::Float))  lfGauss :: (Args '[] '["duration", "width", "iphase", "loop", "doneAction"] a) => a -> SDBody a Signal lfGauss = makeUGen@@ -85,7 +91,7 @@ lfPar = makeUGen    "LFPar" AR    (Vs::Vs '["freq", "iphase"])-   (freq_ (440::Float))+   (iphase_ (0::Float))  lfPulse :: (Args '["freq"] '["iphase", "width"] a) => a -> SDBody a Signal lfPulse = makeUGen

@@ -9,14 +9,15 @@    -- , silent    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef -import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.ByteString.UTF8 as UTF8 (fromString)  -- | \"This UGen simply outputs the initial value you give it\" dc :: Float -> SDBody' a Signal dc n =-   addUGen $ UGen (UGName_S (BS8.pack "DC")) AR [Constant n] 1+   addUGen $ UGen (UGName_S (UTF8.fromString "DC")) AR [Constant n] 1  -- Not creating this because I don't want to clutter the namespace. -- Just write "dc 0"!

@@ -32,6 +32,7 @@    , whiteNoise    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args

@@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE OverloadedStrings #-}  {-# LANGUAGE NoIncoherentInstances #-}@@ -9,22 +10,23 @@      -- This is deprecated in SC:    --   audioIn ---     diskIn----   , diskOut+     diskOut ---   , in__-     aIn+   , aIn    , kIn ---   , inFeedback ---   , inTrig ---   , lagIn----   , localIn----   , localOut+   , localIn+   , localOut ---   , maxLocalBufs ---   , offsetOut    , out+   , out'    , aOut-   , kOut-   , kOut_mono----   , replaceOut+--- , kOut+--- , kOut_mono+   , replaceOut       -- These 2 have been deprecated in SC: --    , sharedIn@@ -35,6 +37,8 @@ ---   , xOut    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..))+import Vivid.SC.Server.Types (BufferId(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Algebraic@@ -42,7 +46,7 @@  import Data.Proxy -aIn :: (Args '["bus"] '[] a) => a -> SDBody a Signal+aIn :: Args '["bus"] '[] a => a -> SDBody a Signal aIn = makeUGen    "In" AR    (Vs::Vs '["bus"])@@ -50,8 +54,22 @@  --- diskIn :: --- diskIn =---- diskOut ::---- diskOut =++-- | 'buf' is a temporary buffer to accumulate before writing.+-- +--    "NOTE: The Buffer's numFrames must be a power of two and is recommended to be at least 65536 -- preferably 131072 or 262144. Smaller buffer sizes mean more frequent disk access, which can cause glitches."+--+--    65536 == 2 ^ 16+--    131072 == 2 ^ 17+--    262144 == 2 ^ 18+-- +--    For ease of use with 'sd' this has output type \"[Signal]\", but the list+--      is always empty+diskOut :: ToSig s a => BufferId -> [s] -> SDBody' a [Signal]+diskOut (BufferId bufId) sigs = do+   sigs' <- mapM toSig sigs+   addPolyUGen $ UGen (UGName_S "DiskOut") AR (Constant (realToFrac bufId) : sigs') 0+ --- in__ :: --- in__ = --- inFeedback ::@@ -59,7 +77,7 @@ --- inTrig :: --- inTrig = -kIn :: (Args '["bus"] '[] a) => a -> SDBody a Signal+kIn :: Args '["bus"] '[] a => a -> SDBody a Signal kIn = makeUGen    "In" KR    (Vs::Vs '["bus"])@@ -67,10 +85,20 @@  --- lagIn :: --- lagIn =---- localIn ::---- localIn =---- localOut ::---- localOut =++-- localIn :: Args '[] '["default"] a => Int -> a -> SDBody a [Signal]+-- "default" is 0 for now:+localIn :: Int -> SDBody' a [Signal]+localIn numChans = do+   addPolyUGen $ UGen (UGName_S "LocalIn") AR [Constant 0] numChans++localOut :: ToSig s as => [s] -> SDBody' as ()+localOut inSig = do+   sigs <- mapM toSig inSig+   [] <- addPolyUGen $ UGen (UGName_S "LocalOut") AR sigs 0+   pure ()++ --- maxLocalBufs :: --- maxLocalBufs = --- offsetOut ::@@ -79,37 +107,33 @@ out :: (ToSig i a, ToSig busNum a) => busNum -> [i] -> SDBody' a [Signal] out = aOut +out' :: (Elem "out" a, ToSig i a) => [i] -> SDBody' a [Signal]+out' = out (V::V "out")+ aOut :: (ToSig i a, ToSig busNum a) => busNum -> [i] -> SDBody' a [Signal] aOut busNum is = do    busNum' <- toSig busNum    is' <- mapM toSig is    addPolyUGen $ UGen (UGName_S "Out") AR (busNum' : is') ((length::[a]->Int) is) -kOut :: (ToSig i a, ToSig busNum a) => busNum -> [i] -> SDBody' a [Signal]-kOut busNum is = do-   busNum' <- toSig busNum-   is' <- mapM toSig is-   addPolyUGen $ UGen (UGName_S "Out") KR (busNum' : is') ((length::[a]->Int) is)---- | Temporary-kOut_mono :: (ToSig i a) => Int -> i -> SDBody' a Signal-kOut_mono busNum i = do-   i' <- toSig i-   addUGen $ UGen (UGName_S "Out") KR [Constant (toEnum busNum), i'] 1+-- kOut  -- kIn :: -- kIn = ---- replaceOut ::---- replaceOut =-+-- todo: does this work/is it robust?:+replaceOut :: (ToSig i a, ToSig busNum a) => busNum -> [i] -> SDBody' a [Signal]+replaceOut busNum is = do+   busNum' <- toSig busNum+   is' <- mapM toSig is+   addPolyUGen $ UGen (UGName_S "ReplaceOut") AR (busNum' : is') ((length::[a]->Int) is)  -- | Audio bus input (usually mic) soundIn :: Args '["bus"] '[] a => a -> SDBody a Signal soundIn args = do    bus <- args `uaArgVal` (Proxy::Proxy "bus")    nob <- addUGen $ UGen (UGName_S "NumOutputBuses") IR [] 1 {- :: SDBody a Signal -}-   inPos <- nob ~+ bus+   inPos <- nob ~+ (bus :: Signal)    addUGen $ UGen (UGName_S "In") AR [inPos] 1  

@@ -17,13 +17,14 @@    , numInputBuses    , numOutputBuses    , numRunningSynths-   -- , poll+   , poll    , radiansPerSample    , sampleDur    , sampleRate    , subsampleOffset    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args@@ -74,8 +75,20 @@ numRunningSynths =    addUGen $ UGen (UGName_S "NumRunningSynths") IR [] 1 --- poll ::--- poll =+-- } This is CPU-intensive: only use for debugging!+-- +--   First argument is frequency of polling: the number of times per second to poll+-- +--   Returns the UGen it's polling so you can add \"poll\" to an existing+--   signal chain without altering it+poll :: Float -> String -> SDBody' a Signal -> SDBody' a Signal+poll freq label polledThing = do+   imp <- addUGen $ UGen (UGName_S "Impulse") AR [Constant freq] 1+   pt <- polledThing+   let args = ([imp, pt] ++) $ map (Constant . realToFrac) $+        [-1, (length::[a]->Int) label] ++ map fromEnum label+   _ <- addUGen $ UGen (UGName_S "Poll") AR args 1+   pure pt  radiansPerSample :: SDBody' a Signal radiansPerSample =

@@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}--- {-# LANGUAGE TypeFamilies #-}+-- {-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -29,12 +29,13 @@ ---   , wrap    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA -- import Vivid.UGens.Algebraic import Vivid.UGens.Args -import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.ByteString.UTF8 as UTF8 (fromString) import Data.Proxy  -- | @@ -79,7 +80,7 @@    s0' <- toSig s0    s1' <- toSig s1    calcRate <- (maximum::Ord a=>[a]->a) <$> sequence (map getCalcRate [s0', s1'])-   addUGen $ UGen (UGName_S . BS8.pack $ sdName) calcRate [s0',s1'] 1+   addUGen $ UGen (UGName_S . UTF8.fromString $ sdName) calcRate [s0',s1'] 1  -- | "Converts a linear range of values to an exponential range of values." -- @@ -106,7 +107,7 @@       KR -> successGraph KR       _ -> error "linExp: 'in' value must be at AR/KR"  where-   successGraph calcRate = (flip ($)) as $ makeUGen+   successGraph calcRate = ($ as) $ makeUGen       "LinExp" calcRate       (Vs::Vs '["in", "srclo", "srchi", "dstlo", "dsthi"])       (srclo_ (0::Float), srchi_ (1::Float), dstlo_ (1::Float), dsthi_ (2::Float))

@@ -25,9 +25,8 @@ ---   , panAz      -- See above:    -- , rotate2----   , splay+   , splay ---   , splayAz----   , splayZ       -- * Multichannel > Select @@ -42,14 +41,19 @@          , mix ---   , numChannels++   , addChannels    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef --import Vivid.SynthDef.FromUA import Vivid.UGens.Algebraic import Vivid.UGens.Args+import Vivid.UGens.Generators.SingleValue (dc) import Vivid.SynthDef.FromUA +import Control.Monad (foldM, zipWithM) import Data.List.Split (chunksOf)  --- biPanB2 ::@@ -76,16 +80,43 @@    (Vs::Vs '["in","pos","level"])    (level_ (1::Float)) +-- return a tuple?: -- no no that's exactly when you run into problems with the foldable shit -- people get a tuple when they expect a list.... --- pan4 :: --- pan4 = --- panAz :: --- panAz =---- splay ::---- splay =++-- | "Spreads [a list] of channels across the stereo field."+splay :: ToSig s a => [s] -> SDBody' a [Signal]+splay sigsMono = do+   -- sigs' <- mapM toSig sigs+   let numChans :: Float+       numChans = toEnum $ max 2 $ (length::[a]->Int) sigsMono+   let positions :: [Float]+       positions =+         map ((\x->x-1) . (*(2/(numChans-1)))) [0..(numChans-1)]+    -- note SC has a different calculation for KR:+   let level = sqrt (recip numChans)+   sigsStereo <- (\x -> zipWithM x sigsMono positions) $ \sig pos ->+      pan2 (in_ sig, pos_ pos)+   -- todo: is the rate correct in ALL cases?:+   mapM (level ~*) =<< foldM addChannels [] sigsStereo+++-- | "Spreads [a list] of channels across the stereo field. Optional arguments are spread+--   and center, and equal power levelCompensation. The formula for the stereo position+--   is:+-- +--   > ((0 .. (n - 1)) * (2 / (n - 1) - 1) * spread + center+--- splay' :: +--- splay' =+ --- splayAz :: --- splayAz =---- splayZ ::---- splayZ =++-- Don't implement: the geometry is wrong here and it's been deprecated:+-- splayZ ::+ --- linSelectX :: --- linSelectX = --- linXFade2 ::@@ -105,11 +136,12 @@ --- xFade2 =  -- | Mixes down a list of audio rate inputs to one. ---   The list can't be empty. --  --   This is more efficient than e.g. @foldl1 (~+)@+--+--   If the list is empty this is the same as @dc 0@ mix :: ToSig s a => [s] -> SDBody' a Signal-mix [] = error "empty mix"+mix [] = dc 0 mix [x] = toSig x mix xs = mix =<< (mapM mix' . chunksOf 4) =<< mapM toSig xs  where@@ -123,3 +155,11 @@  --- numChannels :: --- numChannels =++-- | Like 'zipWithM' but if the lists are of different lengths, doesn't shorten the longer one+addChannels :: (ToSig s0 a, ToSig s1 a) => [s0] -> [s1] -> SDBody' a [Signal]+addChannels [] xs = mapM toSig xs+addChannels xs [] = mapM toSig xs+addChannels (x:xs) (y:ys) = do+   foo <- toSig x ~+ toSig y+   (foo:) <$> addChannels xs ys

@@ -34,6 +34,7 @@    -- , tWIndex    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args

@@ -11,6 +11,7 @@ ---   , gVerb    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args

@@ -13,7 +13,7 @@    -- , detectSilence ---   , done ---   , free__----   , freeSelf+     freeSelf ---   , freeSelfWhenDone ---   , lagControl ---   , namedControl@@ -23,6 +23,10 @@ ---   , trigControl    ) where +import Vivid.UGens.Args+import Vivid.SC.SynthDef.Types (CalculationRate(..))+import Vivid.SynthDef+import Vivid.SynthDef.FromUA     -- Might not actually need these 2 directly: --- control ::@@ -34,10 +38,19 @@ --- done = --- free__ :: --- free__ =---- freeSelf ::---- freeSelf =++-- | Frees the synth when the trigger changes from non-positive to positive+-- +--   Runs at 'KR'+freeSelf :: Args '["trigger"] '[] a => a -> SDBody a Signal+freeSelf = makeUGen+   "FreeSelf" KR+   (Vs::Vs '["trigger"])+   NoDefaults+ --- freeSelfWhenDone :: --- freeSelfWhenDone =+ --- lagControl :: --- lagControl = --- namedControl ::

@@ -15,12 +15,12 @@      -- In UGens.Buffer:    -- , phasor    , pulseCount----   , pulseDivider+   , pulseDivider ---   , sendReply ---   , sendTrig ---   , setResetFF ---   , stepper----   , sweep+   , sweep      -- in UGens.Conversions:    -- , t2a    -- , t2k@@ -38,6 +38,7 @@ ---   , trig1    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.SynthDef.FromUA import Vivid.UGens.Args@@ -53,14 +54,28 @@    (Vs::Vs '["in", "trigger"])    NoDefaults -pulseCount :: (Args '[] '["trigger", "reset"] a) => a -> SDBody a Signal+pulseCount :: Args '[] '["trigger", "reset"] a => a -> SDBody a Signal pulseCount = makeUGen    "PulseCount" AR    (Vs::Vs '["trigger", "reset"])    (trig_ (0::Float), reset_ (0::Float)) ---- pulseDivider ::---- pulseDivider =+-- | \"Outputs one inpulse each time it receives a certain number of triggers at its input\"+-- +--   The trigger \"can be any signal. A trigger happens when the signal changes from+--   non-positive to positive\"+-- +--   \"div\" is the number of pulses to divide by. Default is 2.+-- +--   \"start\" is the starting value of the count+-- +--   Can be 'AR' or 'KR'+pulseDivider :: Args '["trigger"] '["div", "start"] a => a -> SDBody a Signal+pulseDivider = makeUGen+   "PulseDivider" AR+   (Vs::Vs '["trigger", "div", "start"])+   (div_ (2::Float), start_ (0::Float))+ --- sendReply :: --- sendReply = --- sendTrig ::@@ -69,8 +84,13 @@ --- setResetFF = --- stepper :: --- stepper =---- sweep ::---- sweep =++sweep :: Args '["trigger"] '["rate"] a => a -> SDBody a Signal+sweep = makeUGen+   "Sweep" AR+   (Vs::Vs '["trigger", "rate"])+   (rate_ (1::Float))+ --- tChoose :: --- tChoose = --- tExpRand ::

@@ -1,11 +1,13 @@ {-# LANGUAGE DataKinds #-} -- {-# LANGUAGE OverloadedStrings #-} -- {-# LANGUAGE Rank2Types #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, NoMonoLocalBinds #-}  {-# LANGUAGE NoIncoherentInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoUndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ExtendedDefaultRules #-}  module Vivid.UGens.UserInteraction ( ---     keyState@@ -14,6 +16,7 @@    , mouseY    ) where +import Vivid.SC.SynthDef.Types (CalculationRate(..)) import Vivid.SynthDef import Vivid.UGens.Args import Vivid.SynthDef.FromUA

@@ -1,242 +1,277 @@-name:                vivid
-version:             0.2.0.5
-homepage:            http://vivid-synth.com
-synopsis:            Sound synthesis with SuperCollider
-description:         
-  Music and sound synthesis with SuperCollider.
-  .
-  Example usage:
-  .
-  @
-  {-\# LANGUAGE DataKinds \#-}
-  @
-  .
-  > 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 = do
-  >    fork $ do
-  >       s0 <- synth theSound (36 ::I "note")
-  >       wait 1
-  >       free s0
-  >    s1 <- synth theSound (60 ::I "note")
-  >    forM_ [62,66,64] $ \note -> do
-  >       wait (1/4)
-  >       set s1 (note ::I "note")
-  >    wait (1/4)
-  >    free s1
-  >
-  > main = do
-  >    putStrLn "Simplest:"
-  >    playSong
-  >
-  >    putStrLn "With precise timing:"
-  >    doScheduledIn 0.1 playSong
-  >    wait 1
-  >
-  >    putStrLn "Written to a file, non-realtime synthesis:"
-  >    putStrLn "(Need to quit the running server for NRT)"
-  >    quitSCServer
-  >    writeNRT "/tmp/song.wav" playSong
-author:              Tom Murphy
-maintainer:          Tom Murphy
-category:            Audio, Music, Sound
-build-type:          Simple
-cabal-version:       >=1.8
-stability:           experimental
-license:             GPL
-
-library
-  exposed-modules:
-      Vivid
-    , Vivid.Actions
-    , Vivid.Actions.Class
-    , Vivid.Actions.IO
-    , Vivid.Actions.NRT
-    , Vivid.Actions.Scheduled
-    , Vivid.ByteBeat
-    , Vivid.Envelopes
-    , Vivid.NoPlugins
-    , Vivid.OSC
-    , Vivid.OSC.Util
-    , Vivid.Randomness
-    , Vivid.SCServer
-    , Vivid.SCServer.Connection
-    , Vivid.SCServer.State
-    , Vivid.SCServer.Types
-    , Vivid.SynthDef
-    , Vivid.SynthDef.FromUA
-    , Vivid.SynthDef.Literally
-    , Vivid.SynthDef.ToSig
-    , Vivid.SynthDef.Types
-    , Vivid.SynthDef.TypesafeArgs
-    , Vivid.UGens
-    , Vivid.UGens.Algebraic
-    , Vivid.UGens.Analysis
-    , Vivid.UGens.Args
-    , Vivid.UGens.Buffer
-    , Vivid.UGens.Conversion
-    , Vivid.UGens.Convolution
-    , Vivid.UGens.Delays
-    , Vivid.UGens.Demand
-    , Vivid.UGens.Dynamics
-    , Vivid.UGens.Envelopes
-    , Vivid.UGens.Examples
-    , Vivid.UGens.FFT
-    , Vivid.UGens.Filters
-    , Vivid.UGens.Filters.BEQSuite
-    , Vivid.UGens.Filters.Linear
-    , Vivid.UGens.Filters.Nonlinear
-    , Vivid.UGens.Filters.Pitch
-    , Vivid.UGens.Generators.Chaotic
-    , Vivid.UGens.Generators.Deterministic
-    , Vivid.UGens.Generators.Granular
-    , Vivid.UGens.Generators.SingleValue
-    , Vivid.UGens.Generators.Stochastic
-    , Vivid.UGens.Info
-    , Vivid.UGens.InOut
-    , Vivid.UGens.Maths
-    , Vivid.UGens.Multichannel
-    , Vivid.UGens.Random
-    , Vivid.UGens.Reverbs
-    , Vivid.UGens.SynthControl
-    , Vivid.UGens.Triggers
-    , Vivid.UGens.Undocumented
-    , Vivid.UGens.UserInteraction
-  -- other-modules:       
-  build-depends:
-   -- These package bounds are to comply with the PVP
-   -- (https://wiki.haskell.org/Package_versioning_policy).
-   -- Most/all of these upper bounds will be able to be bumped
-   -- forevermore: if you're having trouble building this because
-   -- of an upper bound, you can probably just bump it up.
-   -- I'll try to bump version bounds whenever new compatible
-   -- versions come out.
-
-      -- Auto bounds from 'cabal init':
-      base > 3 && < 5
-
-      -- 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
-      --    0.2 is the oldest version on Hackage
-      -- Upper bound:
-      --    0.9 doesn't exist yet
-    , binary > 0.5.0.2 && < 0.9
-
-      -- 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
-      --    0.9 is the oldest version on Hackage
-      -- Upper bound:
-      --    0.11 doesn't exist yet
-    , bytestring > 0.9.1.8 && < 0.11
-
-      -- Lower bound:
-      --    Just a guess -- 0.4.0.0 is >5 years old
-      --    I don't have a reason to think it needs a lower bound
-      --    0.1.0.0 is the oldest version on Hackage
-      -- Upper bound:
-      --    0.6 doesn't exist yet
-    , containers > 0.4.0.0 && < 0.6
-
-      -- Lower bound:
-      --    1.0 is the oldest version with 'takeExtension'
-      --    (It's from 2007-05)
-      -- Upper bound:
-      --    1.5 doesn't exist yet
-    , filepath >= 1.0 && < 1.5
-
-     -- Lower bound:
-     --    1.1.1.0 is the first version with 'hashWithSalt'
-     --    (It's from 2011-02)
-     --    (Also betw 1.2 and 1.2.0.5 are marked as broken!)
-     -- Upper bound:
-     --    1.3 doesn't exist yet
-    , hashable >= 1.2.0.6 && < 1.3
-
-      -- Lower bound:
-      --    0.1 is the oldest version on Hackage
-      -- Upper bound:
-      --    0.5 doesn't exist yet
-    , MonadRandom >= 0.1 && < 0.5
-
-      -- Lower bound:
-      --    Just a guess -- 0.2.0.0 is >5 years old
-      --    I don't have a reason to think it needs a lower bound
-      --    1.0 is the oldest version on Hackage
-      -- Upper bound:
-      --    2.3 doesn't exist yet
-    , mtl >= 2.0.0.0 && < 2.3
-
-      -- Lower bound:
-      --    Just a guess -- 2.3 is >5 years old
-      --    I don't have a reason to think it needs a lower bound
-      --    2.0 is the oldest version on Hackage
-      -- Upper bound:
-      --    2.7 doesn't exist yet
-    , network >= 2.3 && < 2.7
-
-
-      -- Lower bound:
-      --    Just a guess -- 1.0.1.4 is >5 years old
-      --    I don't have a reason to think it needs a lower bound
-      --    1.0.0.0 is the oldest version on Hackage
-      -- Upper bound:
-      --    1.5 doesn't exist yet
-    , process >= 1.0.1.4 && < 1.5
-
-      -- Lower bound:
-      --    Just a guess -- 1.0.0.3 is >5 years old
-      --    I don't have a reason to think it needs a lower bound
-      --    1.0.0.0 is the oldest version on Hackage
-      -- Upper bound:
-      --    1.2 doesn't exist yet
-      -- /= :  1.0.1.3 is deprecated
-    , random (>= 1.0.0.3 && <= 1.0.1.1) || (>= 1.1 && < 1.2)
-
-      -- Lower bound:
-      --    0.0.3 is the first version with 'shuffleM'
-      -- Upper bound:
-      --    0.1 doesn't exist yet (will it ever?)
-    , random-shuffle >= 0.0.3 && < 0.1
-
-      -- Lower bound:
-      --    0.2.0.0 is the first version with 'chunksOf'
-      -- Upper bound:
-      --    0.3 doesn't exist yet
-    , split >= 0.2.0.0 && < 0.3
-
-      -- Lower bound:
-      --    Just a guess -- 2.2.0.1 is >5 years old
-      --    I don't have a reason to think it needs a lower bound
-      --    2.1 is the oldest version on Hackage
-      -- Upper bound:
-      --    2.5 doesn't exist yet
-    , stm >= 2.2.0.1 && < 2.5
-
-      -- Lower bound:
-      --    Just a guess -- 1.2 is >5 years old
-      --    I don't have a reason to think it needs a lower bound
-      --    (Although check out 'old-time' and those changes -- but
-      --    that's before 1.2)
-      --    1.0 is the oldest version on Hackage
-      -- Upper bound:
-      --    1.7 doesn't exist yet
-    , time >= 1.2 && < 1.7
-
-      -- Lower bound:
-      --    Only need it for 'MonadIO' which came in 0.2.0.0
-      --    (0.2.0.0 is from 2010-03)
-      -- Upper bound:
-      --    0.6 doesn't exist yet
-      -- Note there are lots of deprecated versions but I'm taking
-      -- a guess for now that 'liftIO' is fine in all of them
-    , transformers >= 0.2.0.0 && < 0.6
-
-  ghc-options:
-    -O2
+name:                vivid+version:             0.3.0.0+synopsis:            Sound synthesis with SuperCollider+description:         +  Music and sound synthesis with SuperCollider.+  .+  Example usage:+  .+  @+  &#123;&#45;\# LANGUAGE DataKinds \#&#45;&#125;+  @+  .+  > 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 = do+  >    fork $ do+  >       s0 <- synth theSound (36 ::I "note")+  >       wait 1+  >       free s0+  >    s1 <- synth theSound (60 ::I "note")+  >    forM_ [62,66,64] $ \note -> do+  >       wait (1/4)+  >       set s1 (note ::I "note")+  >    wait (1/4)+  >    free s1+  >+  > main = do+  >    putStrLn "Simplest:"+  >    playSong+  >+  >    putStrLn "With precise timing:"+  >    doScheduledIn 0.1 playSong+  >    wait 1+  >+  >    putStrLn "Written to a file, non-realtime synthesis:"+  >    putStrLn "(Need to quit the running server for NRT)"+  >    quitSCServer+  >    writeNRT "/tmp/song.wav" playSong+author:              Tom Murphy+maintainer:          Tom Murphy+category:            Audio, Music, Sound+build-type:          Simple+cabal-version:       >=1.8+stability:           experimental+license:             GPL++library+  exposed-modules:+      Vivid+    , Vivid.Actions+    , Vivid.Actions.Class+    , Vivid.Actions.IO+    , Vivid.Actions.NRT+    , Vivid.Actions.Scheduled+    , Vivid.ByteBeat+    , Vivid.Envelopes+    , Vivid.NoPlugins+    , Vivid.OSC.Bundles+    , Vivid.Randomness+    , Vivid.SCServer+    , Vivid.SCServer.Connection+    , Vivid.SCServer.State+    , Vivid.SCServer.Types+    , Vivid.SynthDef+    , Vivid.SynthDef.FromUA+    , Vivid.SynthDef.ToSig+    , Vivid.SynthDef.Types+    , Vivid.SynthDef.TypesafeArgs+    , Vivid.UGens+    , Vivid.UGens.Algebraic+    , Vivid.UGens.Analysis+    , Vivid.UGens.Args+    , Vivid.UGens.Buffer+    , Vivid.UGens.Conversion+    , Vivid.UGens.Convolution+    , Vivid.UGens.Delays+    , Vivid.UGens.Demand+    , Vivid.UGens.Dynamics+    , Vivid.UGens.Envelopes+    , Vivid.UGens.Examples+    , Vivid.UGens.FFT+    , Vivid.UGens.Filters+    , Vivid.UGens.Filters.BEQSuite+    , Vivid.UGens.Filters.Linear+    , Vivid.UGens.Filters.Nonlinear+    , Vivid.UGens.Filters.Pitch+    , Vivid.UGens.Generators.Chaotic+    , Vivid.UGens.Generators.Deterministic+    , Vivid.UGens.Generators.Granular+    , Vivid.UGens.Generators.SingleValue+    , Vivid.UGens.Generators.Stochastic+    , Vivid.UGens.Info+    , Vivid.UGens.InOut+    , Vivid.UGens.Maths+    , Vivid.UGens.Multichannel+    , Vivid.UGens.Random+    , Vivid.UGens.Reverbs+    , Vivid.UGens.SynthControl+    , Vivid.UGens.Triggers+    , Vivid.UGens.Undocumented+    , Vivid.UGens.UserInteraction+  -- other-modules:       +  build-depends:+   -- These package bounds are to comply with the PVP+   -- (https://wiki.haskell.org/Package_versioning_policy).+   -- Most/all of these upper bounds will be able to be bumped+   -- forevermore: if you're having trouble building this because+   -- of an upper bound, you can probably just bump it up.+   -- I'll try to bump version bounds whenever new compatible+   -- versions come out.++      -- Auto bounds from 'cabal init':+      base > 3 && < 5++      -- 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+      --    0.2 is the oldest version on Hackage+      -- Upper bound:+      --    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+      --    0.9 is the oldest version on Hackage+      -- Upper bound:+      --    0.11 doesn't exist yet+      -- Try: "> 0.9.1.8 && < 0.11"+    , bytestring++      -- Lower bound:+      --    Just a guess -- 0.4.0.0 is >5 years old+      --    I don't have a reason to think it needs a lower bound+      --    0.1.0.0 is the oldest version on Hackage+      -- Upper bound:+      --    0.6 doesn't exist yet+      -- Try: "> 0.4.0.0 && < 0.6"++    -- , cereal++    , containers++    , directory++      -- Lower bound:+      --    1.0 is the oldest version with 'takeExtension'+      --    (It's from 2007-05)+      -- Upper bound:+      --    1.5 doesn't exist yet+      -- Try: "&& < 1.5"+    , filepath >= 1.0++     -- Lower bound:+     --    1.1.1.0 is the first version with 'hashWithSalt'+     --    (It's from 2011-02)+     --    (Also betw 1.2 and 1.2.0.5 are marked as broken!)+     -- Upper bound:+     --    1.3 doesn't exist yet+     -- Try: "&& < 1.3"+    , hashable >= 1.2.0.6++      -- Lower bound:+      --    0.1 is the oldest version on Hackage+      -- Upper bound:+      --    0.5 doesn't exist yet+      -- Try: ">= 0.1 && < 0.5"+    , MonadRandom++      -- Lower bound:+      --    Just a guess -- 0.2.0.0 is >5 years old+      --    I don't have a reason to think it needs a lower bound+      --    1.0 is the oldest version on Hackage+      -- Upper bound:+      --    2.3 doesn't exist yet+      -- Try: ">= 2.0.0.0 && < 2.3"+    , mtl++      -- Lower bound:+      --    Just a guess -- 2.3 is >5 years old+      --    I don't have a reason to think it needs a lower bound+      --    2.0 is the oldest version on Hackage+      -- Upper bound:+      --    2.7 doesn't exist yet+      -- Try: ">= 2.3 && < 2.7"+    , network+++      -- Lower bound:+      --    Just a guess -- 1.0.1.4 is >5 years old+      --    I don't have a reason to think it needs a lower bound+      --    1.0.0.0 is the oldest version on Hackage+      -- Upper bound:+      --    1.5 doesn't exist yet+      -- Try: ">= 1.0.1.4 && < 1.5"+    , process++      -- Lower bound:+      --    Just a guess -- 1.0.0.3 is >5 years old+      --    I don't have a reason to think it needs a lower bound+      --    1.0.0.0 is the oldest version on Hackage+      -- Upper bound:+      --    1.2 doesn't exist yet+      -- /= :  1.0.1.3 is deprecated+      -- Try:  (>= 1.0.0.3 && <= 1.0.1.1) || (>= 1.1 && < 1.2)+    , random >= 1.1++      -- Lower bound:+      --    0.0.3 is the first version with 'shuffleM'+      -- Upper bound:+      --    0.1 doesn't exist yet (will it ever?)+      -- Try: "&& < 0.1"+    , random-shuffle >= 0.0.3++      -- Lower bound:+      --    0.2.0.0 is the first version with 'chunksOf'+      -- Upper bound:+      --    0.3 doesn't exist yet+      -- Try: "&& < 0.3"+    , split >= 0.2.0.0++      -- Lower bound:+      --    Just a guess -- 2.2.0.1 is >5 years old+      --    I don't have a reason to think it needs a lower bound+      --    2.1 is the oldest version on Hackage+      -- Upper bound:+      --    2.5 doesn't exist yet+      -- Try: ">= 2.2.0.1 && < 2.5"+    , stm++      -- Lower bound:+      --    Just a guess -- 1.2 is >5 years old+      --    I don't have a reason to think it needs a lower bound+      --    (Although check out 'old-time' and those changes -- but+      --    that's before 1.2)+      --    1.0 is the oldest version on Hackage+      -- Upper bound:+      --    1.7 doesn't exist yet+      -- Try: "&& < 1.7"+    , time >= 1.2++      -- Lower bound:+      --    Only need it for 'MonadIO' which came in 0.2.0.0+      --    (0.2.0.0 is from 2010-03)+      -- Upper bound:+      --    0.6 doesn't exist yet+      -- Note there are lots of deprecated versions but I'm taking+      -- a guess for now that 'liftIO' is fine in all of them+      -- Try: "&& < 0.6" (and maybe disallow deprecated)+    , transformers >= 0.2.0.0++      -- We only need 'fromString' from here:+    , utf8-string++    -- Pinned to vivid's version:+    , vivid-osc == 0.3.*+    , vivid-supercollider == 0.3.*++  -- TODO: constraint solver iterations only for the GHC that needs it+  ghc-options:+    -O2+    -fconstraint-solver-iterations=0++-- TODO:+-- testsuite +--   build-depends:+--       vivid+--     , microspec+--     -- , quickcheck