packages feed

vivid 0.1.0.3 → 0.2.0.0

raw patch · 57 files changed

+7572/−1140 lines, 57 filesdep +MonadRandomdep +filepathdep +processdep −deepseqdep ~basedep ~binarydep ~bytestring

Dependencies added: MonadRandom, filepath, process, random, random-shuffle, time, transformers

Dependencies removed: deepseq

Dependency ranges changed: base, binary, bytestring, containers, hashable, mtl, network, split, stm

Files

Vivid.hs view
@@ -1,19 +1,7 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- | For an intro to all this, check out <http://amindfv.com/vivid> or the "Vivid.SynthDef" module+{-# LANGUAGE NoMonomorphismRestriction #-}  module Vivid (-     sleep-   , module Vivid.SynthDef-   , module Vivid.UGens-   , module Vivid.SCServer+     module Vivid.NoPlugins    ) where -import Vivid.SCServer-import Vivid.SynthDef-import Vivid.UGens--import Control.Concurrent (threadDelay)--sleep :: Float -> IO ()-sleep t = threadDelay . fromEnum $ t * 1e6+import Vivid.NoPlugins
+ Vivid/Actions.hs view
@@ -0,0 +1,238 @@+-- | Actions. 'Vivid.Actions.Class.VividAction' has 3 instances:+-- +--   - "Vivid.Actions.IO" : happens right here, right now+--   - "Vivid.Actions.Scheduled" : happens at some point in the (maybe near) future.+--        The timing is precise, unlike IO+--   - "Vivid.Actions.NRT" : non-realtime. Writes to an audio file++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++-- For 'MonoOrPoly':+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}++module Vivid.Actions (+     synth+   , synthG+   , synthNamed+   , synthNamedG+   , set+   , play+   , free+   , freeBuf+   , quitSCServer+   , module Vivid.Actions.Class+   -- , module Vivid.Actions.IO+   , module Vivid.Actions.NRT+   , module Vivid.Actions.Scheduled++   , makeSynth+   , synthWAction+   ) where++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.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 Data.Int+import Data.Monoid++-- for "play":+import qualified Data.Map as Map+-- import Data.Map (Map)++-- for "play":+import Vivid.SynthDef (makeSynthDef)+-- import Vivid.SynthDef.FromUA (NoDefaults(..))+import Vivid.SynthDef.Types+import Vivid.UGens.InOut (out)++-- | Given a UGen graph, just start playing it right away.+-- +--   e.g.+-- +--   > play $ do+--   >    s <- 0.2 ~* lpf (in_ whiteNoise, freq_ 440)+--   >    out 0 [s, s]+-- +--   The "out" is optional, too -- so you can write+-- +--   > 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 monoOrPolyVersion = do+   let polyVersion = getPoly monoOrPolyVersion+   let sdUGens :: [(UGenName, CalculationRate)]+       sdUGens =+          map (\x -> (_ugenName x, _ugenCalculationRate x)) $+             Map.elems $ _sdUGens $ makeSynthDef SDName_Hash () polyVersion+       -- Note this doesn't check that it's the last one that's+       --   the "Out":+   let sdWithOut = sd () $+          if any (==(UGName_S "Out", AR)) sdUGens+             then polyVersion+             else do+                foo <- polyVersion+                out (0::Int) $ foo+   synth sdWithOut ()++class MonoOrPoly s where+   getPoly :: SDBody' a s -> SDBody' a [Signal]++instance MonoOrPoly [Signal] where+   getPoly :: SDBody' a [Signal] -> SDBody' a [Signal]+   getPoly = id++instance MonoOrPoly Signal where+   getPoly :: SDBody' a Signal -> SDBody' a [Signal]+   -- getPoly s = (:[]) <$> s+   -- should this be stereo? a lot of uses call for something else+   getPoly s = do+      s' <- s+      return [s', s']++-- | 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 ]++-- | Set the given parameters of a running synth+-- +--   e.g.+-- +--   >>> let setTest = sd (0.05 ::I "pan") $ out 0 =<< pan2 (in_ $ 0.1 ~* whiteNoise, pos_ (A::A "pan"))+--   >>> s <- synth setTest ()+--   >>> set s (-0.05 ::I "pan")+-- +--   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+   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++-- | Create a real live music-playing synth from a boring, dead SynthDef.+-- +--   If you haven't defined the SynthDef on the server, this will do it automatically+--   (Note that this may cause jitters in musical timing)+-- +--   Given...+-- +--   >>> let foo = sd () $ out 0 [0.1 ~* whiteNoise]+-- +--   ...you can create a synth with...+-- +--   >>> synth foo ()+-- +--   Careful!: The SC server doesn't keep track of your nodes for you,+--   so if you do something like...+-- +--   >>> s <- synth someSynth ()+--   >>> s <- synth oops ()           -- 's' is overwritten+-- +--   ...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)+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++-- | 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:+--   >>>         Could not deduce (Elem "ignore" '[]) arising from a use of ‘synth’+--   >>>  synthG s (4::I "ok", 5::I "throwaway")+--   >>>   (works)+synthG :: (VividAction m, VarList params) => SynthDef a -> params -> m NodeId+synthG theSD params = do+   defineSD theSD -- 'defineSD' only defines it if it hasn't been yet++   let synthName = case theSD of+        SynthDef (SDName_Named n) _ _ -> n+        SynthDef SDName_Hash _ _ -> getSDHashName theSD+   makeSynth synthName params 0+++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++   let synthName = case theSD of+        SynthDef (SDName_Named n) _ _ -> n+        SynthDef SDName_Hash _ _ -> getSDHashName theSD+   makeSynth synthName params actionNum+++synthNamed :: (VividAction m, VarList params) => String -> params -> m (Node a)+synthNamed name params = Node <$> makeSynth (BS8.pack name) params 0++synthNamedG :: (VividAction m, VarList params) => String -> params -> m NodeId+synthNamedG name params = makeSynth (BS8.pack name) params 0++-- | 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++   return nodeId+ where+   paramList :: [OSCDatum]+   paramList = concatMap (\(k, v) -> [OSC_S k, OSC_F v]) $+      map (first BS8.pack) (fst $ makeTypedVarList params)++-- | Stop the SuperCollider server+quitSCServer :: IO ()+quitSCServer = do+   callOSC $ OSC "/quit" []+   closeSCServerConnection++freeBuf :: VividAction m => BufferId -> m ()+freeBuf (BufferId bufId) =+   callOSC $ OSC "/b_free" [OSC_I bufId]
+ Vivid/Actions/Class.hs view
@@ -0,0 +1,76 @@+-- | A @VividAction m => m a@ can either be run immediately, be scheduled to run at a+--   precise future time, or be used for non-realtime synthesis.+-- +--   Note that at the moment VividAction has MonadIO, but this won't be true in+--   upcoming versions (as early as the next release) - so don't get used+--   to it!++{-# LANGUAGE KindSignatures #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.Actions.Class (+     VividAction(..)+   , callOSCAndSync+   ) where++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)++class (Monad m , MonadIO m) => VividAction (m :: * -> *) where++   -- | Send an 'OSC' message to the SuperCollider server+   callOSC :: OSC -> m ()+   callOSC = callBS . encodeOSC++   -- | Send a ByteString to the SuperCollider server.+   --   You usually want to use 'call' instead.+   callBS :: ByteString -> m ()++   -- | Blocks until the server finishes processing commands+   sync :: m ()++   -- | As the user, you probably don't want to use this:+   -- +   --   Many commands already include a \"sync\" -- e.g.+   --   'makeBuffer' already syncs.+   -- +   --   When you do want to do an+   --   explicit sync you probably want to use 'sync' instead, or+   --   'callOSCAndSync'+   waitForSync :: SyncId -> m ()++   -- | Wait, in seconds+   wait :: RealFrac n => n -> m ()++   getTime :: m Timestamp++   newBufferId :: m BufferId++   newNodeId :: m NodeId++   newSyncId :: m SyncId++   fork :: m () -> m ()++   -- | Send a synth definition to be loaded on the SC server+   -- +   --   Note that this is sort of optional -- if you don't call it, it'll be called the first time+   --   you call 'synth' with the SynthDef+   defineSD :: SynthDef a -> m ()++-- | Send an OSC message and wait for it to complete before returning+callOSCAndSync :: VividAction m => OSC -> m ()+callOSCAndSync message = do+   now <- getTime+   sid@(SyncId syncId) <- newSyncId+   callBS $ encodeOSCBundle $+      OSCBundle now [Right message, Right $ OSC (BS8.pack "/sync") [OSC_I syncId]]+   waitForSync sid
+ Vivid/Actions/IO.hs view
@@ -0,0 +1,118 @@+-- | This is unscheduled - the server will do what you tell it to+--   as soon as it can. That can mean there'll be slight delays+--   because of time it took to compute what to do or because of+--   network latency. If you want more precise timing look at+--   "Scheduled"+-- +--   Doing \"VividAction\"s in IO can be like a sketchpad:+--   it's the quickest way to get an idea out.+--   The cool thing is you can take an action that you're sketching+--   and put a function in front of it to get more precise timing+--   E.g. if you have the function:+--+--   @+--   playTone = do+--      synth <- play $ 0.1 ~* sinOsc (freq_ 440)+--      wait 1+--      free synth+--   @+-- +--   You can play it quickly with just:+-- +--   > playTone+-- +--   But if you want precise timing all you need to do is say e.g.:+-- +--   > playScheduledIn 0.01 playTone++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.Actions.IO (+   ) where++import Vivid.Actions.Class+import Vivid.OSC (OSC(..), OSCDatum(..), encodeOSC, Timestamp(..), utcToTimestamp)+import Vivid.SCServer.State (BufferId(..), NodeId(..), SyncId(..), getNextAvailable, scServerState, SCServerState(..))+import Vivid.SCServer.Connection ({-getMailboxForSyncId,-} getSCServerSocket, waitForSync_io)+import Vivid.SynthDef++import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent.STM (readTVarIO, atomically, modifyTVar)+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8 (pack)+import Data.Hashable+import qualified Data.Set as Set+import Data.Time (getCurrentTime)++import Network.Socket (withSocketsDo) -- We add this everywhere for Windows compat+import Network.Socket.ByteString (send)++instance VividAction IO where+   callOSC :: OSC -> IO ()+   callOSC message = callBS (encodeOSC message)++   callBS :: ByteString -> IO ()+   callBS message = do+      let !_ = scServerState+      sock <- getSCServerSocket+      _ <- withSocketsDo $ send sock message+      return ()++   sync :: IO ()+   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]+      waitForSync sid++   waitForSync :: SyncId -> IO ()+   waitForSync = waitForSync_io++   wait :: (RealFrac n) => n -> IO ()+   wait t = threadDelay $ round (t * 10^(6::Int))++   getTime :: IO Timestamp+   getTime = utcToTimestamp <$> getCurrentTime++   newBufferId :: IO BufferId+   newBufferId = do+      maxBufIds <- readTVarIO (_scServerState_maxBufIds scServerState)+      BufferId nn <- getNextAvailable _scServerState_availableBufferIds+      return . BufferId $ nn `mod` maxBufIds++   newNodeId :: IO NodeId+   newNodeId = getNextAvailable _scServerState_availableNodeIds++   newSyncId :: IO SyncId+   newSyncId =+      getNextAvailable _scServerState_availableSyncIds++   fork :: IO () -> IO ()+   fork action = do+      _ <- forkIO action+      return ()++   defineSD :: SynthDef a -> IO ()+   defineSD synthDef@(SynthDef name _ _) = do+      let !_ = scServerState+      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+         atomically $ modifyTVar (_scServerState_definedSDs scServerState) $+            ((name, hash synthDef) `Set.insert`)
+ Vivid/Actions/NRT.hs view
@@ -0,0 +1,180 @@+-- | Non-realtime synthesis. Create a sound file from the same instructions+--   you use to perform live!+-- +--   **Note** we don't currently support redefining Synthdefs midway -- e.g.+--   you can't explicitly define a SynthDef "foo" (with 'defineSD'), then make a+--   synth from it, then explicitly define it again with a new definition, and+--   then make a new synth with the new definition+++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeSynonymInstances #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.Actions.NRT (+     NRT -- (..) -- ^ May not be exported in the future+   , writeNRT+   , writeNRTScore+   , runNRT++   , writeNRTWith+   , NRTArgs(..)+   , defaultNRTArgs+   ) where++import Vivid.Actions.Class+import Vivid.Actions.IO () -- maybe not in the future+import Vivid.OSC+import Vivid.SCServer+-- import Vivid.SCServer.State+import Vivid.SynthDef (encodeSD)+import Vivid.SynthDef.Types++import Control.Applicative+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 Data.Char (toLower)+import Data.Hashable (hash)+import qualified Data.Map as Map+import Data.Map (Map)+import Data.Monoid+import qualified Data.Set as Set+import System.Exit+import System.FilePath (takeExtension)+import System.Process (system)+import Prelude++type NRT = StateT (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]))++   callBS :: ByteString -> NRT ()+   callBS message = do+      now <- getTime+      modify (second (Map.insertWith (<>) now [Left message]))++   sync :: NRT ()+   sync = return ()++   waitForSync :: SyncId -> NRT ()+   waitForSync _ = return ()++   wait :: (RealFrac n) => n -> NRT ()+   wait t = modify (first (`addSecs` realToFrac t))++   getTime :: NRT Timestamp+   getTime = fst <$> get++   newBufferId :: NRT BufferId+   newBufferId = liftIO newBufferId++   newNodeId :: NRT NodeId+   newNodeId = liftIO newNodeId++   newSyncId :: NRT SyncId+   newSyncId = liftIO newSyncId++   fork :: NRT () -> NRT ()+   fork action = do+      (timeOfFork, _) <- get+      action+      modify (first (\_ -> timeOfFork))++   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+              ]+         ]+    where+      mappendIfNeeded :: (Ord a) {- , Monoid m)-} => [a] -> [a] -> [a]+      mappendIfNeeded maybeSubset maybeSuperset =+         if Set.fromList maybeSubset `Set.isSubsetOf` Set.fromList maybeSuperset+            then maybeSuperset+            else maybeSubset <> maybeSuperset++runNRT :: NRT a -> IO [OSCBundle]+runNRT action = do+   (_, protoBundles) <- execStateT action (Timestamp 0, Map.empty)+   return [ OSCBundle t as | (t, as) <- Map.toList protoBundles ]+++-- | Generate a file of actions that SC can use to do NRT with.+-- +--   __If you just want the .aiff file, you probably want 'writeNRT' instead.__+-- +--   Usage: this will create a file at "/tmp/NRTout.aiff" with your @sound :: NRT a@:+-- +--   > writeNRT "/tmp/foo.osc" test+--   > scsynth -N /tmp/foo.osc _ /tmp/NRTout.aiff 44100 AIFF int16+writeNRTScore :: FilePath -> NRT a -> IO ()+writeNRTScore path action =+   (BS.writeFile path . encodeOSCBundles) =<< runNRT action+++-- | Generate an audio file from an NRT action -- this can write songs far faster+--   than it would take to play them.+-- +--   The file type is detected from its extension.+--   The extensions supported at the moment are .aif, .aiff, and .wav+-- +--   (Mac OS X users will need to make sure 'scsynth' is in their $PATH)+-- +--   (And I apologize, but I really don't know what Windows users will need to do)+-- +--   Currently doesn't work with single quotes in the filename+writeNRT :: FilePath -> NRT a -> IO ()+writeNRT = writeNRTWith defaultNRTArgs++writeNRTWith ::  NRTArgs -> FilePath -> NRT a -> IO ()+writeNRTWith nrtArgs fPath nrtActions = do+   when ('\'' `elem` fPath) $ error "Didnt have time to implement filepaths with single quotes"+   contents <- encodeOSCBundles <$> runNRT nrtActions++   --  ${SHELL}+   system "/bin/sh -c 'which scsynth > /dev/null'" >>= \case+      ExitSuccess -> return ()+      ExitFailure _ -> error "No 'scsynth' found! Be sure to put it in your $PATH"+   let tempFile = "/tmp/vivid_nrt_" <> (show . hash) contents <> ".osc"+       !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"++   BS.writeFile tempFile contents+   ExitSuccess <- system $ mconcat [+        --  ${SHELL}+        "/bin/sh -c \"scsynth -N "+      , tempFile+      , " _ '", fPath, "' "+      , show $ _nrtArgs_sampleRate nrtArgs," ", fileType, " int16\""+      ]+   return ()+++data NRTArgs+   = NRTArgs {+    _nrtArgs_sampleRate :: Int+   }+ deriving (Show, Read, Eq, Ord)++defaultNRTArgs :: NRTArgs+defaultNRTArgs = NRTArgs 44100
+ Vivid/Actions/Scheduled.hs view
@@ -0,0 +1,101 @@+-- | This is for timing of actions that's more precise than IO+-- +--   It tells the server when to perform the actions, so musical timing won't+--   be affected by e.g. network latency or the time it took to compute a value+-- +--   If you're running vivid on a different computer than the SC synth, make+--   sure the clocks agree++-- {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeSynonymInstances #-}+-- {-# LANGUAGE ViewPatterns #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.Actions.Scheduled (+     Scheduled+   , doScheduledIn+   , doScheduledAt+   , doScheduledNow+   ) where++import Vivid.Actions.Class+import Vivid.Actions.IO () -- Just until we remove MonadIO+import Vivid.OSC+import Vivid.SCServer+import Vivid.SynthDef (SynthDef)++import Control.Concurrent+import Control.Monad+import Control.Monad.IO.Class (liftIO)+import Control.Monad.State (evalStateT, put, get, modify, StateT)+import Data.ByteString (ByteString)+import Prelude++type Scheduled = StateT Timestamp IO+++instance VividAction Scheduled where+   callOSC :: OSC -> Scheduled ()+   callOSC message = do+      now <- getTime+      liftIO . callBS . encodeOSCBundle $ OSCBundle now [Right message]++   callBS :: ByteString -> Scheduled ()+   callBS message = do+      now <- getTime+      liftIO . callBS . encodeOSCBundle $ OSCBundle now [Left message]++   sync :: Scheduled ()+   sync = return () -- always right?++   waitForSync :: SyncId -> Scheduled ()+   waitForSync _ = return () -- always right?++   wait :: (RealFrac n) => n -> Scheduled ()+   wait t = modify (`addSecs` realToFrac t)++   getTime :: Scheduled Timestamp+   getTime = get++   newBufferId :: Scheduled BufferId+   newBufferId = liftIO newBufferId++   newNodeId :: Scheduled NodeId+   newNodeId = liftIO newNodeId++   newSyncId :: Scheduled SyncId+   newSyncId = liftIO newSyncId++   fork :: Scheduled () -> Scheduled ()+   fork action = do+      timeOfFork <- get+      action+      put timeOfFork++   defineSD :: SynthDef a -> Scheduled ()+   defineSD = liftIO . void . forkIO . defineSD++-- | Schedule an action to happen at the given time+doScheduledAt :: Timestamp -> Scheduled a -> IO a+doScheduledAt startTime action =+   evalStateT action startTime++-- | Schedule an action to happen n seconds from now+doScheduledIn :: Double -> Scheduled a -> IO a+doScheduledIn numSecs action = do+   now <- getTime+   doScheduledAt (addSecs now numSecs) action++-- | Schedule an action to happen right now. Because of server latency this+--   could arrive late, so you might want to do something like+--   @doScheduledIn 0.01@ instead:+doScheduledNow :: Scheduled a -> IO a+doScheduledNow action = do+   now <- getTime+   doScheduledAt now action
+ Vivid/ByteBeat.hs view
@@ -0,0 +1,52 @@+-- | Not exported by default because many of these have the same+--   names as in "Control.Arrow"++{-# LANGUAGE NoMonomorphismRestriction #-}++module Vivid.ByteBeat (+     (&&&)+   , (|||)+   , (>>>)+   , (<<<)+     -- Reexported from Vivid.UGens.Algebraic:+   , xor++   , byteBeatFromHelpFile+   , baseThing+   ) where++import Vivid.SynthDef+import Vivid.UGens.Algebraic+import Vivid.UGens.Args+import Vivid.UGens.Generators.Deterministic (impulse)+import Vivid.UGens.Triggers (pulseCount)++(&&&), (|||), (>>>), (<<<)+   :: (ToSig s0 a, ToSig s1 a) => s0 -> s1 -> SDBody' a Signal+(&&&) = biOp BitAnd+(|||) = biOp BitOr+(>>>) = biOp ShiftRight+(<<<) = biOp ShiftLeft+-- Also 'xor' from Vivid.UGens.Algebraic+++-- | E.g.+-- +--   > play byteBeatFromHelpFile+byteBeatFromHelpFile :: SDBody' a Signal+byteBeatFromHelpFile = baseThing $ \t ->+   (((t ~* 15) &&& (t >>> 5)) |||+    ((t ~* 5)  &&& (t >>> 3)) |||+    ((t ~* 2)  &&& (t >>> 9)) |||+    ((t ~* 8)  &&& (t >>> 11)))+   ~- 3++-- | E.g.+-- +--   > play $ baseThing $ \t -> t &&& (t >>> 8)+baseThing :: (Signal -> SDBody' a Signal) -> SDBody' a Signal+baseThing f = do+   t <- pulseCount (trig_ $ impulse (freq_ 8e3))+   sig0 <- f t+   sig1 <- biOp Mod sig0 256+   ((sig1 ~/ 127) ~- 1) ~* 0.1
+ Vivid/Envelopes.hs view
@@ -0,0 +1,167 @@+-- | Envelopes. **This module is the least mature in vivid and is likely to+--   change a lot in the future!**++{-# OPTIONS_HADDOCK show-extensions #-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE KindSignatures #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++{-# LANGUAGE FlexibleContexts #-}++module Vivid.Envelopes (+     EnvLiterally(..)+   , envLiterallyToSignals+   , env++   , EnvCurve(..)+   , EnvSegment(..)+   , shapeNumber+   , curveNumber+   ) where++import Vivid.SynthDef.ToSig (ToSig(..)) -- , SDBody)+import Vivid.SynthDef.Types+-- import Vivid.SynthDef.FromUA (fromUA, Args)++-- import Data.Int+import Data.Monoid+import GHC.TypeLits+import Prelude -- BBP++data EnvLiterally (args :: [Symbol])+   = forall initial. (ToSig initial args) =>+     EnvLiterally {+    _envLiterally_initialVal :: initial+   -- ,_envLiterally_numSegments :: Int -- i know this is a 'Literally' but it's so computable...+  , _envLiterally_releaseNode :: Maybe Int+  , _envLiterally_offset :: Float -- ?? -- only used for 'IEnvGen', which i dont have+    -- invariant: releasenode must be larger (or equal?) to/than loopnode+    -- also, if one is Just, i think the other must be -- so if that's true, use+    -- a different data structure+    -- at least for the non-'Literally' one+  , _envLiterally_loopNode :: Maybe Int+  , _envLiterally_curveSegments :: [EnvSegment]+  }+ -- deriving (Show, Eq)++{-+  InputSpec_UGen {_inputSpec_uGen_index = 2, _inputSpec_uGen_outputIndex = 0}+  Constant: 2.0 (index 2) -- length segments+  Constant: 1.0 (index 1) -- release node+  Constant: -99.0 (index 3) -- loop node++signals?:+  Constant: 1.0 (index 1)+  Constant: 1.0 (index 1)+  Constant: 3.0 (index 4)+  Constant: 0.0 (index 0)+  Constant: 0.0 (index 0)+  Constant: 1.0 (index 1)+  Constant: 3.0 (index 4)+  Constant: 0.0 (index 0)+-}++-- i think this is (only) for the arguments to EnvGen:+envLiterallyToSignals :: EnvLiterally (b::[Symbol]) -> SDBody' b [Signal]+envLiterallyToSignals envLiterally@(EnvLiterally a _ _ _ _) = do+   {-+  foo <- case _envLiterally_initialVal envLiterally of+    x -> toSigM $ x+-}+  foo <- toSig a+  return $ [+     foo+   , Constant . toEnum . (length::[a]->Int) $ _envLiterally_curveSegments envLiterally+   , Constant $ case _envLiterally_releaseNode envLiterally of+        Just x -> toEnum x+        Nothing -> (-99)+   , Constant $ case _envLiterally_loopNode envLiterally of+        Just x -> toEnum x+        Nothing -> (-99)+   ] <> concatMap envSegmentToSignals (_envLiterally_curveSegments envLiterally)+ where+   envSegmentToSignals :: EnvSegment -> [Signal]+   envSegmentToSignals envSegment = [+        _envSegment_targetVal envSegment+      , _envSegment_timeToGetThere envSegment+      , Constant $ envCurveNumber $ _envSegment_curve envSegment+      , Constant $ envCurveFloatNumber $ _envSegment_curve envSegment+      ]++data EnvSegment+   = EnvSegment {+    _envSegment_targetVal :: Signal+  , _envSegment_timeToGetThere :: Signal+  , _envSegment_curve :: EnvCurve+  }+ deriving (Show, Eq)++data EnvCurve+   = Curve_Step+   | Curve_Linear+   | Curve_Lin+   | Curve_Exponential+   | Curve_Exp+   | Curve_Sine+   | Curve_Sin+   | Curve_Welch+   | Curve_Wel+   | Curve_Squared+   | Curve_Sqr+   | Curve_Cubed+   | Curve_Cub+   | Curve_Curve Float -- ^ 0 is linear, positive curves up, negative curves down+ deriving (Show, Eq)++-- | Same as \"Env.shapeNumber\" in SC.+-- +--   This is useful if you want to set a the env shape of a running synth+shapeNumber :: EnvCurve -> Float+shapeNumber = envCurveNumber++-- | "shapeNumber" with a name I like better+curveNumber :: EnvCurve -> Float+curveNumber = shapeNumber++envCurveNumber :: EnvCurve -> Float+envCurveNumber Curve_Step = 0+envCurveNumber Curve_Linear = 1+envCurveNumber Curve_Lin = 1+envCurveNumber Curve_Exponential = 2+envCurveNumber Curve_Exp = 2+envCurveNumber Curve_Sine = 3+envCurveNumber Curve_Sin = 3+envCurveNumber Curve_Welch = 4+envCurveNumber Curve_Wel = 4+envCurveNumber Curve_Squared = 6+envCurveNumber Curve_Sqr = 6+envCurveNumber Curve_Cubed = 7+envCurveNumber Curve_Cub = 7+envCurveNumber (Curve_Curve _) = 5++envCurveFloatNumber :: EnvCurve -> Float+envCurveFloatNumber (Curve_Curve f) = f+envCurveFloatNumber _ = 0+++env :: Float -> [(Float, Float)] -> EnvCurve -> EnvLiterally a+env firstPoint pointsAndLengths curve = EnvLiterally {+     _envLiterally_initialVal = firstPoint+   , _envLiterally_releaseNode = Nothing+   , _envLiterally_offset = 0+   , _envLiterally_loopNode = Nothing+   , _envLiterally_curveSegments = map foo pointsAndLengths+   }+ where+   foo :: (Float, Float) -> EnvSegment+   foo (point, dur) = EnvSegment {+        _envSegment_targetVal = Constant point+      , _envSegment_timeToGetThere = Constant dur+         -- this is, of course, limiting:+      , _envSegment_curve = curve+      }
+ Vivid/NoPlugins.hs view
@@ -0,0 +1,59 @@+-- | Exports everything from Vivid (and some helpful reexports) except 'Vivid.UGens.Plugins'++{-# OPTIONS_HADDOCK show-extensions #-}++{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoRebindableSyntax #-}+{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.NoPlugins (+   -- * Vivid Reexports+     module Vivid.Actions+   , module Vivid.Envelopes+   , module Vivid.SynthDef+   , module Vivid.UGens++   , module Vivid.SCServer+   , module Vivid.Randomness+   , addSecs+   , Timestamp(..)++   , module Vivid.SynthDef.TypesafeArgs+   , module Vivid.SynthDef.FromUA++   -- * 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++   ) where++import Vivid.Actions+import Vivid.Envelopes+import Vivid.SCServer+import Vivid.Randomness+import Vivid.SynthDef+import Vivid.SynthDef.FromUA (Args, SDBodyArgs, UA, NoDefaults, none) -- To make type sigs not have qualified names+import Vivid.SynthDef.TypesafeArgs (AddParams)++import Vivid.UGens+import Vivid.OSC (addSecs)++import Control.Applicative+import Control.Monad+import Control.Monad.Random+import Data.ByteString (ByteString)+import Data.Int+import Data.Monoid+import System.Random++import Control.Monad.IO.Class
Vivid/OSC.hs view
@@ -4,10 +4,15 @@  {-# OPTIONS_HADDOCK show-extensions #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ScopedTypeVariables #-}+ {-# LANGUAGE NoRebindableSyntax #-}+{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}  module Vivid.OSC (      OSC(..)@@ -15,35 +20,65 @@     , 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+-- import Control.DeepSeq (NFData, rnf) import Data.Binary (encode, decode)-import qualified Data.ByteString as BS import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS8-import qualified Data.ByteString.Lazy as BSL-import Data.Int (Int32) -- , Int16, Int8)+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)+ 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':@@ -57,12 +92,14 @@     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)@@ -81,23 +118,27 @@    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 $ "unknown character " <> show c <> ": " <> show 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)@@ -105,7 +146,7 @@    let n = numBytesWithoutPadding 'b' b    in n + align n + 4 numBytesWithPadding c b =-   error $ "unknown character " <> show c <> ": " <> show b+   error $ "vivid: unknown OSC character " <> show c <> ": " <> show b  decodeOSCData :: [Char] -> ByteString -> [OSCDatum] decodeOSCData [] "" = []@@ -134,6 +175,78 @@     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@@ -143,3 +256,7 @@    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]
− Vivid/OSC/Util.hs 
@@ -1,31 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}--{-# LANGUAGE NoRebindableSyntax #-}--module Vivid.OSC.Util (-     align-   , floatToWord-   , wordToFloat-   ) 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--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
+ Vivid/Randomness.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE NoMonomorphismRestriction #-}++module Vivid.Randomness (+     pick+   , picks+   , module System.Random.Shuffle+   ) where++import Control.Monad.Random (getRandomR, getRandomRs, MonadRandom)+import System.Random.Shuffle++-- | Picks a random element from the provided list+pick :: MonadRandom m => [a] -> m a+pick l = (l !!) <$> getRandomR (0, (length::[a]->Int) l - 1)++-- | Returns an infinite list of randomly-chosen elements from the provided list+-- +--   e.g.+-- +--   >> > take 5 <$> picks [1,2,3,4]+--   >> [2,3,1,1,3]+picks :: (MonadRandom m) => [a] -> m [a]+picks l =+   (map (l !!)) <$> getRandomRs (0, (length::[a]->Int) l - 1)
Vivid/SCServer.hs view
@@ -2,283 +2,148 @@  {-# LANGUAGE NoRebindableSyntax #-} -{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++ -- | Library for interacting with the SuperCollider server. --  --   You don't need to use much of this day-to-day --  --   There's a toplevel 'scServerState' that stores the current state of the SC server module Vivid.SCServer (-     call-   , callBS-   , quit-   , cmdPeriod+     cmdPeriod+   , freeAll+   , Timestamp(..)+     +   -- * Nodes     , NodeId(..)-   , newNodeId+   , Node(..) +   -- * Buffers+    , BufferId(..)-   , newBufferId-   , setMaxBufferIds    , makeBuffer    , makeBufferFromFile+   , newBuffer+   , newBufferFromFile    , saveBuffer +   -- * Manual management of SC server connection+    , createSCServerConnection-   , callAndWaitForDone+   , closeSCServerConnection+   , SCConnectConfig(..)+   , defaultConnectConfig -   , SCServerState(..)-   , scServerState+   , module Vivid.SCServer.State++   , shrinkNodeArgs+    ) where +import Vivid.Actions.Class import Vivid.OSC-import Vivid.SynthDef.Types--import Network.Socket (SocketType(Datagram), defaultProtocol, socket, AddrInfo(..), getAddrInfo, Socket, HostName, ServiceName, connect)-import Network.Socket.ByteString+import Vivid.SCServer.Connection+import Vivid.SCServer.State+import Vivid.SCServer.Types -import Control.Concurrent (threadDelay)---import qualified Data.ByteString as B hiding (find, elem)-import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8 (pack) import Data.Int (Int32)-import Control.Concurrent.STM as STM--{--import qualified Data.Map as Map-import Data.Map (Map)--}-import qualified Data.Set as Set-import Data.Set (Set)-import qualified Data.ByteString.Char8 as BS8---- We use this only for "the unsafePerformIO hack"--- (https://wiki.haskell.org/Top_level_mutable_state) so that functions can--- refer to the state without being passed the state explicitly. This should--- still be safe:-import System.IO.Unsafe (unsafePerformIO)---- SETTINGS:-defaultSCServerPort :: String-defaultSCServerPort = "57110"--- defaultSCLangPort   = "57120"+-- BBP hack:+import Prelude  -{-# NOINLINE scServerState #-}-scServerState :: SCServerState--- see the above note about this use of unsafePerformIO:-scServerState = unsafePerformIO makeEmptySCServerState--newtype NodeId-      = NodeId { unNodeId :: Int32 }-   deriving (Show, Eq)--newtype BufferId-      = BufferId { unBufferId :: Int32 }-   deriving (Show, Eq)--data SCServerState-   = SCServerState-     { scServer_socket :: !(TVar (Maybe Socket))-     , scServer_availableBufferIds :: !(TVar [BufferId])-     , scServer_maxBufIds :: !(TVar Int32)-     , scServer_availableNodeIds :: !(TVar [NodeId])-     , scServer_availableSyncIds :: !(TVar [SyncId])-     , scServer_definedSDs :: !(TVar (Set (SDName, Int))) -- Int is the hash-     }---- | Stop the SuperCollider server-quit :: IO ()-quit = call $ OSC "/quit" []---- | __You usually don't need to call this function__--- ---   Use this if to connect on a non-default port or to a server not at localhost--- ---   Otherwise the connection is created when it's needed.---   You can also use this to explicitly create the connection, so the---   computation is done upfront--- ---   The 'HostName' is the ip address or "localhost". The 'ServiceName' is the port-createSCServerConnection :: HostName -> ServiceName -> IO Socket-createSCServerConnection hostName port = do-   let !_ = scServerState-   readTVarIO (scServer_socket scServerState) >>= \case-      Nothing -> do-         s <- connectToSCServer hostName port-         (atomically . (writeTVar $ scServer_socket scServerState) . Just) s-         return s-      Just _ -> error "Too late -- connection already established. Disconnect first."--connectToSCServer :: HostName -> ServiceName -> IO Socket-connectToSCServer hostName port = do-   (serverAddr:_) <- getAddrInfo Nothing (Just hostName) (Just port)-   s <- socket (addrFamily serverAddr) Datagram defaultProtocol-   connect s (addrAddress serverAddr)-   _ <- send s $ encodeOSC $ OSC "/dumpOSC" [OSC_I 1]-   _ <- send s $ encodeOSC $ OSC "/g_new" [OSC_I 1, OSC_I 0, OSC_I 0]-   threadDelay $ fromEnum 1e3-   return s--getSCServerSocket :: IO Socket-getSCServerSocket = getSCServerSocket' scServerState--getSCServerSocket' :: SCServerState -> IO Socket-getSCServerSocket' scServerState' = do-   let !_ = scServerState'-   readTVarIO (scServer_socket scServerState') >>= \case-      Nothing -> do-         s <- connectToSCServer "localhost" defaultSCServerPort-         (atomically . (writeTVar $ scServer_socket scServerState') . Just) s-         return s-      Just s -> return s--makeEmptySCServerState :: IO SCServerState-makeEmptySCServerState = do-   sockTVar <- newTVarIO Nothing-   availBufIds <- newTVarIO $ drop 512 $ map BufferId $ cycle [0..]-   availNodeIds <- newTVarIO $ map NodeId [10000..] -- sclang starts at 2000-   maxBufIds <- newTVarIO 1024-   syncIds <- newTVarIO $ drop 10000 $ map SyncId $ cycle [0..]-   definedSDs <- newTVarIO $ Set.empty--   return $ SCServerState-          { scServer_socket = sockTVar-          , scServer_availableBufferIds = availBufIds-          , scServer_maxBufIds = maxBufIds-          , scServer_availableNodeIds = availNodeIds-          , scServer_availableSyncIds = syncIds-          , scServer_definedSDs = definedSDs-          }---- | Send an 'OSC' message to the SuperCollider server-call :: OSC -> IO ()-call message = do-   let !_ = scServerState-   callBS (encodeOSC message)---- | Async messages to the sc server get responded to with \"\/done\" -- so this calls those functions and waits for the \"\/done\" before continuing-callAndWaitForDone :: OSC -> IO ()-callAndWaitForDone message@(OSC _cmd _) = do-   s <- getSCServerSocket-   call message-   threadDelay $ fromEnum 1e4-   sid@(SyncId syncId) <- newSyncId-   call $ OSC "/sync" [OSC_I syncId]-   getDoneMessage s sid- where-   getDoneMessage :: Socket -> SyncId -> IO ()-   getDoneMessage s sid@(SyncId syncId) = recvFrom s 1024 >>= \(msg, _) ->-      case decodeOSC msg of-         -- OSC "/done" [OSC_S cmdFinished] | cmd == cmdFinished -> return ()-         OSC "/synced" [OSC_I syncFinished] | syncFinished == syncId -> return ()-         _ -> getDoneMessage s sid--newtype SyncId-      = SyncId Int32-   deriving (Show, Read, Eq, Ord)---- | Send a ByteString to the SuperCollider server.---   You usually want to use 'call' instead. May be removed in future versions.-callBS :: ByteString -> IO ()-callBS message = do-   let !_ = scServerState--   sock <- getSCServerSocket--   _ <- send sock message-   return ()--{--call' :: SCServerState -> OSC -> IO ()-call' scServerState' message = do-   let !_ = scServerState'--   sock <- getSCServerSocket' scServerState'--   _ <- send sock (encodeOSC message)-   return ()--}- -- | Your \"emergency\" button. Run this and everything playing on the SC server --   will be freed -- silence! --  --   Corresponds to the cmd-. \/ ctrl-.  key command in the SuperCollider IDE-cmdPeriod :: IO ()+cmdPeriod :: (VividAction m) => m () cmdPeriod = do-   call $ OSC "/g_freeAll" [OSC_I 0]-   call $ OSC "/clearSched" []-   call $ OSC "/g_new" [OSC_I 1, OSC_I 0, OSC_I 0]--newBufferId :: IO BufferId-newBufferId = do-   maxBufIds <- readTVarIO (scServer_maxBufIds scServerState)-   BufferId nn <- getNextAvailable scServer_availableBufferIds-   return . BufferId $ nn `mod` maxBufIds--getNextAvailable :: (SCServerState -> TVar [a]) -> IO a-getNextAvailable getter = do-   let !_ = scServerState-   atomically $ do-      let avail = getter scServerState-      (n:rest) <- readTVar avail-      writeTVar avail rest-      return n--newNodeId :: IO NodeId-newNodeId =-   getNextAvailable scServer_availableNodeIds--newSyncId :: IO SyncId-newSyncId =-   getNextAvailable scServer_availableSyncIds+   callOSC $ OSC "/g_freeAll" [OSC_I 0]+   callOSC $ OSC "/clearSched" []+   initTree+   +-- | Alias of 'cmdPeriod'+freeAll :: VividAction m => m ()+freeAll = cmdPeriod --- | If you've started the SC server with a non-default number of buffer ids,---   (e.g. with the \"-b\" argument), you can reflect that here--- ---   Note that the buffer ids start at 512, to not clash with any that---   sclang has allocated-setMaxBufferIds :: Int32 -> IO ()-setMaxBufferIds newMax = atomically $-   writeTVar (scServer_maxBufIds scServerState) newMax+initTree :: (VividAction m) => m ()+initTree = callOSC initTreeCommand  -- | Make an empty buffer --  --   The Int32 is the buffer length /in samples/. Multiply seconds by --   the default sample rate of the server (usually 48000) to get the number --   of samples-makeBuffer :: Int32 -> IO BufferId-makeBuffer bufferLength = do+-- +--   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 bufferLength = do    bufId@(BufferId bufIdInt) <- newBufferId-   call $ OSC "/b_alloc" [+   syncId@(SyncId syncIdInt) <- newSyncId+   callOSC $ OSC "/b_alloc" [        OSC_I bufIdInt       ,OSC_I bufferLength       ,OSC_I 1-      ,OSC_I 0+      , OSC_B . encodeOSC $ OSC "/sync" [OSC_I syncIdInt]       ]+   waitForSync syncId    return bufId  -- | Make a buffer and fill it with sound data from a file-makeBufferFromFile :: FilePath -> IO BufferId-makeBufferFromFile fPath = do+-- +--   The file path should be absolute (not relative), and if you're connecting to+--   a non-localhost server don't expect it to be able to read files from your+--   hard drive!+-- +--   Note that like "makeBuffer" this is synchronous+newBufferFromFile :: (VividAction m) => FilePath -> m BufferId+newBufferFromFile fPath = do    bufId@(BufferId bufIdInt) <- newBufferId-   call $ OSC  "/b_allocRead" [+   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    return bufId +makeBufferFromFile :: (VividAction m) => FilePath -> m BufferId+makeBufferFromFile = newBufferFromFile++makeBuffer :: (VividAction m) => Int32 -> m BufferId+makeBuffer = newBuffer+ -- | Write a buffer to a file-saveBuffer :: BufferId -> FilePath -> IO ()-saveBuffer (BufferId theBufId) fPath =-      call $ OSC "/b_write" [-         OSC_I theBufId-        ,OSC_S (BS8.pack fPath)-        ,OSC_S "wav"-        ,OSC_S "float"-        ]+-- +--   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]+     ]
+ Vivid/SCServer/Connection.hs view
@@ -0,0 +1,257 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.SCServer.Connection (+     createSCServerConnection+   , defaultConnectConfig+   , defaultMessageFunction+   , ignoreMessagesFunction+   , SCConnectConfig(..)+   , closeSCServerConnection+   , ConnProtocol(..)+   , getMailboxForSyncId+   , getSCServerSocket+   , waitForSync_io+   , waitForSync_io_noGC+   ) where++import Vivid.OSC+import Vivid.SCServer.State++import Network.Socket (+     SocketType(Datagram {- , Stream -}), defaultProtocol, socket+   , AddrInfo(..), getAddrInfo+   -- , AddrInfoFlag(..), defaultHints+   , Socket, HostName, ServiceName, connect, close -- , listen, bind+   -- , bindSocket, accept+                                                            +    -- We put this everywhere we do socket actions for Windows compatibility:+   , withSocketsDo+   )++import Network.Socket.ByteString (send, recv)++import Control.Concurrent (forkIO, ThreadId, killThread)+import Control.Concurrent.MVar+import Control.Concurrent.STM -- (readTVar, modifyTVar', atomically, writeTVar, {- readTVarIO, -} swapTVar)+import Control.Monad (forever)+import Data.Int (Int32)+-- import Data.IORef+import qualified Data.Map as Map+import Data.Monoid++-- | __You usually don't need to call this function__+-- +--   Use this if to connect on a non-default port or to a server not at localhost+-- +--   Otherwise the connection is created when it's needed.+--   You can also use this to explicitly create the connection, so the+--   computation is done upfront+-- +--   The 'HostName' is the ip address or "localhost". The 'ServiceName' is the port+createSCServerConnection :: SCConnectConfig -> IO Socket+createSCServerConnection connConfig = do+   let !_ = scServerState+   shouldMakeSock scServerState >>= \case+      True -> do+         makeSock scServerState connConfig+      False -> error "Too late -- connection already established. Disconnect first."++-- | Explicitly close Vivid's connection to a SC server.+-- +--   Day-to-day, you can usually just let your program run without using this.+-- +--   For example though, if you're running code that uses Vivid in ghci, and+--   you ":r", you'll want to disconnect first -- there are processes running+--   which can step on the toes of your new instance+-- +--   Also if you want to change the params of your connection (e.g. to connect+--   to a different server), you'll want to disconnect from the other+--   connection first+closeSCServerConnection :: IO ()+closeSCServerConnection = do+   let !_ = scServerState+   ish <- atomically $ do+      writeTVar (_scServerState_socketConnectStarted scServerState) False+{-+      (,) <$> swapTVar (_scServerState_socket scServerState) Nothing+          <*> swapTVar (_scServerState_listener scServerState) Nothing+-}+      (,) <$> tryTakeTMVar (_scServerState_socket scServerState)+          <*> tryTakeTMVar (_scServerState_listener scServerState)++{-+   ish <- (,) <$> readIORef (_scServerState_socket scServerState)+              <*> readIORef (_scServerState_listener scServerState)+   writeIORef (_scServerState_socket scServerState) Nothing+   writeIORef (_scServerState_listener scServerState) Nothing+-}+   case ish of+      (Just sock, Just listener) -> do+         killThread listener+         withSocketsDo $ close sock+      (Nothing, Nothing) -> return ()+      _ -> error "well that's weird"++++data ConnProtocol+   = ConnProtocol_UDP+   -- ConnProtocol_TCP+ deriving (Show, Read, Eq, Ord)++data SCConnectConfig+   = SCConnectConfig {+    _scConnectConfig_hostName :: HostName+  , _scConnectConfig_port :: ServiceName+  , _scConnectConfig_clientId :: Int32+     -- ^ To prevent NodeId clashes when multiple clients are connected to+     --   the same server, each client should have a separate clientId, which+     --   keeps the nodeId separate. Sclang's default clientId is 0, and ours+     --   is 1, so you can run both at the same time without config.+  , _scConnectConfig_connProtocol :: ConnProtocol+  , _scConnectConfig_serverMessageFunction :: OSC -> IO ()+  -- max # of synthdefs -- and clear em out+  }+-- deriving (Show, Read, Eq)+++-- | The default _scConnectConfig_clientId is 1, and sclang's is 0, so you should+--   be able to run vivid side-by-side with the SC IDE out of the box.+defaultConnectConfig :: SCConnectConfig+defaultConnectConfig = SCConnectConfig {+     _scConnectConfig_hostName = "127.0.0.1"+   , _scConnectConfig_port = "57110"+   , _scConnectConfig_clientId = 1+   , _scConnectConfig_connProtocol = ConnProtocol_UDP+   , _scConnectConfig_serverMessageFunction = defaultMessageFunction+   }++-- Internal -- this is what gets called after we check a socket doesn't+-- already exist:+connectToSCServer :: SCConnectConfig -> IO (Socket, ThreadId)+connectToSCServer scConnectConfig = withSocketsDo $ do+   let hostName = _scConnectConfig_hostName scConnectConfig+       port = _scConnectConfig_port scConnectConfig+       connType = case _scConnectConfig_connProtocol scConnectConfig of+          ConnProtocol_UDP -> Datagram+--          ConnProtocol_TCP -> Stream+   (serverAddr:_) <- getAddrInfo Nothing {- (Just (defaultHints {addrFlags = [AI_PASSIVE]})) -} (Just hostName) (Just port)+   s <- socket (addrFamily serverAddr) connType defaultProtocol+   {-+   if (connType == Stream)+      then do+         print 0+         bindSocket s (addrAddress serverAddr)+         print 1+         listen s 1+         -- _ <- accept s+         return ()+   else connect s (addrAddress serverAddr)+-}+   setClientId (_scConnectConfig_clientId scConnectConfig)+   connect s (addrAddress serverAddr)+--   accept s++   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 $ initTreeCommand+      , Right $ OSC "/sync" [OSC_I firstSyncID]+      ]+   waitForSync_io (SyncId firstSyncID)+   return (s, listener)++waitForSync_io :: SyncId -> IO ()+waitForSync_io syncId = do+   _ <- readMVar =<< getMailboxForSyncId syncId+   -- We garbage-collect these so the Map stays small -- but it means you can only wait+   -- for a sync from one place:+   atomically $ modifyTVar' (_scServerState_syncIdMailboxes scServerState) $+      Map.delete syncId++waitForSync_io_noGC :: SyncId -> IO ()+waitForSync_io_noGC syncId = do+   _ <- readMVar =<< getMailboxForSyncId syncId+   return ()++startMailbox :: (OSC -> IO ()) -> Socket -> IO ()+startMailbox otherMessageFunction s = forever $ recv {- From -} s 1024 >>= \(msg{- , _ -}) ->+   case decodeOSC msg of+      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++-- | Print all messages other than \"/done\"s+defaultMessageFunction :: OSC -> IO ()+defaultMessageFunction = \case+   -- Some examples you might want to handle individually:+   {-+   OSC "/fail" [OSC_S "/blah", OSC_S "Command not found"] -> return ()+   OSC "/fail" [OSC_S "/s_new", OSC_S "wrong argument type"] -> return ()+   OSC "/fail" [OSC_S "/b_allocRead", OSC_S "File 'blah.ogg' could not be opened: Error : flac decoder lost sync.\n",OSC_I 2]+   -}+   OSC "/done" [OSC_S _] -> return ()+   OSC "/done" [OSC_S _, OSC_I _] -> return ()+   x -> putStrLn $ "Msg from server: " <> show x++-- | If you don't want to hear what the server has to say+ignoreMessagesFunction :: OSC -> IO ()+ignoreMessagesFunction _ = return ()++-- This is a nice example of when STM can be really helpful -+-- It's impossible! (right?) to have 2 threads create mailboxes and have em overwrite each+-- other -- so we can make a guarantee about recieving a sync that you register for+getMailboxForSyncId :: SyncId -> IO (MVar ())+getMailboxForSyncId syncId = do+   mvarThatIMightWannaUse <- newEmptyMVar+   atomically $ do+      allMailboxes <- readTVar (_scServerState_syncIdMailboxes scServerState)+      case Map.lookup syncId allMailboxes of+         Just syncBox -> return syncBox+         Nothing -> do+            writeTVar (_scServerState_syncIdMailboxes scServerState)+              (Map.insert syncId mvarThatIMightWannaUse allMailboxes)+            return mvarThatIMightWannaUse++getSCServerSocket :: IO Socket+getSCServerSocket = getSCServerSocket' scServerState++getSCServerSocket' :: SCServerState -> IO Socket+getSCServerSocket' scServerState' = do+   let !_ = scServerState'+   shouldMakeSock scServerState' >>= \case+      True -> do+         makeSock scServerState' defaultConnectConfig+      -- Just s -> return s+      False -> atomically . readTMVar $ _scServerState_socket scServerState'++shouldMakeSock :: SCServerState -> IO Bool+shouldMakeSock serverState = atomically $ do+   let theVar = _scServerState_socketConnectStarted serverState+   alreadyBeingMade <- readTVar theVar+   case alreadyBeingMade of+      True -> return False+      False -> do+         writeTVar theVar True+         return True++makeSock :: SCServerState -> SCConnectConfig -> IO Socket+makeSock serverState connConfig = do+         (sock, listener) <- connectToSCServer connConfig+         atomically $ do+            -- writeTVar (_scServerState_socket serverState) $ Just sock+            -- writeTVar (_scServerState_listener serverState) $ Just listener+            True <- tryPutTMVar (_scServerState_socket serverState) sock+            True <- tryPutTMVar (_scServerState_listener serverState) listener+            return sock
+ Vivid/SCServer/State.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.SCServer.State (+     BufferId(..)+   , NodeId(..)+   , SyncId(..)++   , scServerState+   , SCServerState(..)++   , setClientId+   , setMaxBufferIds++   , getNextAvailable+   , numberOfSyncIdsToDrop+   ) where++import Vivid.OSC (OSC)+import Vivid.SCServer.Types+import Vivid.SynthDef.Types++import Network.Socket (Socket)++import Control.Concurrent (ThreadId)+import Control.Concurrent.MVar+import Control.Concurrent.STM -- (readTVar, atomically, writeTVar, newTVar, TVar, TMVar)+import Control.Monad (when)+import Data.Bits+import Data.Int (Int32)+-- import Data.IORef+import qualified Data.Map as Map+import Data.Map (Map)+import qualified Data.Set as Set+import Data.Set (Set)+import Prelude++-- We use this only for "the unsafePerformIO hack"+-- (https://wiki.haskell.org/Top_level_mutable_state) so that functions can+-- refer to the state without being passed the state explicitly. This should+-- still be safe:+import System.IO.Unsafe (unsafePerformIO)++{-# NOINLINE scServerState #-}+scServerState :: SCServerState+-- Currently you can only be connected to one SC server at a time. Future+--   versions plan to remove this.+-- See the above note about this use of unsafePerformIO:+scServerState = unsafePerformIO makeEmptySCServerState++data SCServerState+   = SCServerState+   -- We use 'IORef Maybe's instead of MVars so we can use weak pointer+   --   finalizers with older versions of GHC:+  { _scServerState_socketConnectStarted :: TVar Bool+  , _scServerState_socket :: !(TMVar Socket) -- !(TVar (Maybe Socket))+  , _scServerState_listener :: !(TMVar ThreadId) -- !(TVar (Maybe ThreadId))++  , _scServerState_availableBufferIds :: !(TVar [BufferId])+  , _scServerState_maxBufIds :: !(TVar Int32)+  , _scServerState_availableNodeIds :: !(TVar [NodeId])+  , _scServerState_availableSyncIds :: !(TVar [SyncId])+  , _scServerState_syncIdMailboxes :: !(TVar (Map SyncId (MVar ())))+  , _scServerState_serverMessageFunction :: !(TVar (OSC -> IO ()))+  , _scServerState_definedSDs :: !(TVar (Set (SDName, Int))) -- Int is the hash+  }++setClientId :: Int32 -> IO ()+setClientId clientId = do+   when (clientId < 0 || clientId > 31) $+      error "client id must be betw 0 and 31"+   atomically $ writeTVar (_scServerState_availableNodeIds scServerState) $+      -- The client id is the first 5 bits of a positive int:+      -- Note the incrementing gets weird once we hit the (.&.) -- should+      -- fix if anyone plans to use more than 33 million nodes+      (flip map) [1000..] $ \nodeNum -> NodeId $+         ((clientId `shiftL` ((finiteBitSize nodeNum-5)-1)) .|.) $+            ((maxBound `shiftR` 5) .&. nodeNum)++numberOfSyncIdsToDrop :: Int+numberOfSyncIdsToDrop = 10000++makeEmptySCServerState :: IO SCServerState+makeEmptySCServerState = atomically $ do+   sockConnectStarted <- newTVar False+   sockIORef <- newEmptyTMVar -- newTVar Nothing -- newIORef Nothing+   listenerIORef <- newEmptyTMVar -- newTVar Nothing -- newIORef Nothing++   availBufIds <- newTVar $ drop 512 $ map BufferId [0..]+   -- these'll be allocated when we connect (and get a clientId):+   availNodeIds <- newTVar $ map (NodeId . ((1 `shiftL` 26) .|.)) [1000..]+   maxBufIds <- newTVar 1024+   syncIds <- newTVar $ drop numberOfSyncIdsToDrop $ map SyncId [0..]+   syncMailboxes <- newTVar $ Map.empty+   serverMessageFunction <- newTVar $ \_ -> return ()+   definedSDs <- newTVar $ Set.empty++   return $ SCServerState+          { _scServerState_socketConnectStarted = sockConnectStarted+          , _scServerState_socket = sockIORef+          , _scServerState_listener = listenerIORef+          , _scServerState_availableBufferIds = availBufIds+          , _scServerState_maxBufIds = maxBufIds+          , _scServerState_availableNodeIds = availNodeIds+          , _scServerState_availableSyncIds = syncIds+          , _scServerState_syncIdMailboxes = syncMailboxes+          , _scServerState_serverMessageFunction = serverMessageFunction+          , _scServerState_definedSDs = definedSDs+          }++-- | If you've started the SC server with a non-default number of buffer ids,+--   (e.g. with the \"-b\" argument), you can reflect that here+-- +--   Note that the buffer ids start at 512, to not clash with any that+--   another client (e.g. sclang) has allocated+setMaxBufferIds :: Int32 -> IO ()+setMaxBufferIds newMax = atomically $+   writeTVar (_scServerState_maxBufIds scServerState) newMax++getNextAvailable :: (SCServerState -> TVar [a]) -> IO a+getNextAvailable getter =+   getNextAvailables 1 getter >>= \case+      [x] -> return x+      _ -> error "i don't even - 938"++getNextAvailables :: Int -> (SCServerState -> TVar [a]) -> IO [a]+getNextAvailables numToGet getter = do+   let !_ = scServerState+   atomically $ do+      let avail = getter scServerState+      (ns, rest) <- splitAt numToGet <$> readTVar avail+      writeTVar avail rest+      return ns
+ Vivid/SCServer/Types.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.SCServer.Types (+     Node(..)+   , shrinkNodeArgs+   , NodeId(..)+   , BufferId(..)+   , SyncId(..)+   , HasNodeId(..)+   ) where++import Data.Int+import GHC.TypeLits+import Vivid.SynthDef.TypesafeArgs+++-- | This enforces type safety of the arguments -- e.g. if you have a synthdef+-- +--   >> let x = sd (3 ::I "foo") bar+--   >> s <- synth x ()+-- +--   Then this won't typecheck (because "bar" isn't an argument to x):+-- +--   >> set s (4 ::I "bar")+-- +--   Note that if you don't want this type safety, you can e.g.+-- +--   >> Node n <- synth foo ()+--   >> setG n (0.1 ::I "vol")+-- +--   Or:+-- +--   >> ns <- mapM (flip synth ()) [foo, bar, baz]+--   >> map (setG (0::I "asdf") . unNode) ns+-- +--   Or:+-- +--   >> n <- synthG foo ()+-- +--   (You also may want to look at 'shrinkNodeArgs' if you want to construct a list+--   which has synthdefs or nodes of different types)+data Node (args :: [Symbol])+   = Node { unNode :: NodeId }++-- | So let's say you have a node:+-- +--   > foo :: Node '["amp", "freq", "phase"]+-- +--   and you want to add it to a list of nodes:+-- +--   > ns :: [Node '["freq", "phase"]]+-- +--   If you don't plan on setting the \"amp\" argument, you can \"shrink\" to+--   the compatible arguments:+-- +--   > ns' = shrinkNodeArgs 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++instance HasNodeId NodeId where+   getNodeId n = n++instance HasNodeId (Node a) where+   getNodeId (Node n) = n++newtype BufferId+      = BufferId { _unBufferId :: Int32 }+   deriving (Show, Eq, Ord, Read)++newtype SyncId+      = SyncId Int32+   deriving (Show, Read, Eq, Ord)
Vivid/SynthDef.hs view
@@ -5,12 +5,12 @@ --   they're playing --  --   Usually, you shouldn't be making 'SynthDef's explicitly -- there's a state monad---   'SDState' which lets you construct synthdefs like so:+--   'SDBody' which lets you construct synthdefs like so: --  --   @ --   test :: SynthDef---   test = 'sdNamed' \"testSynthDef\" [(\"note\", 0)] $ do---      s <- 0.1 'Vivid.UGens.~*' 'Vivid.UGens.sinOsc' (Freq $ 'Vivid.UGens.midiCPS' \"note\")+--   test = 'sd' (0 ::I \"note\") $ do+--      s <- 0.1 'Vivid.UGens.~*' 'Vivid.UGens.sinOsc' (freq_ $ 'Vivid.UGens.midiCPS' (V::V \"note\")) --      out 0 [s, s] --   @ -- @@ -20,60 +20,56 @@ --  --   You then create a synth from the synthdef like: -- ---   >>> s <- synth "testSynthDef" [("note", 45)]--- ---   Or, alternately:--- ---   >>> s <- synth test [("note", 45)]+--   >>> s <- synth test (45 ::I "note") --  --   This returns a 'NodeId' which is a reference to the synth, which you can --   use to e.g. change the params of the running synth with e.g. -- ---   >>> set s [("note", 38)]+--   >>> set s (38 ::I "note") --  --   Then you can free it (stop its playing) with --  --   >>> free s+-- +--   (If you want interop with SClang, use "sdNamed" and "synthNamed")  {-# OPTIONS_HADDOCK show-extensions #-}  {-# LANGUAGE NoRebindableSyntax #-} --- {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}+ module Vivid.SynthDef (   -- * Synth actions -    synth-  , set-  , free-   -- * Synth Definition Construction--  , SynthDef(..)+    SynthDef(..)   , UGen(..)   , addUGen   , addMonoUGen   , addPolyUGen   , ToSig(..)-  , ToSigM(..)   , Signal(..)---  , SDState   , encodeSD-  , defineSD+--  , defineSD   , sd   , sdNamed   , sdPretty   , (?)-  , play-  , cmdPeriod+--  , play+--  , cmdPeriod   , DoneAction(..)   , doneActionNum   , sdLitPretty-  , HasSynthRef   , sdToLiteral   -- literalToSD @@ -81,19 +77,6 @@    , getCalcRate -{--  -- * Type-defaulting stuff-  , fromInteger-  , fromString-  , fromRational-  , int-  , integer-  , i8-  , i16-  , i32-  , string--}-   -- * Built-in Unit Generator Operations    , UnaryOp(..)@@ -105,92 +88,57 @@   , specialIToBiOp    , module Vivid.SynthDef.Types++  , getSDHashName++  , makeSynthDef++  , shrinkSDArgs++  , SDBody   ) where -import Vivid.OSC (OSC(..), OSCDatum(..))-import Vivid.SCServer-import Vivid.SynthDef.CrazyTypes+import Vivid.SynthDef.ToSig import Vivid.SynthDef.Literally as Literal import Vivid.SynthDef.Types+import Vivid.SynthDef.FromUA (SDBody) -import Control.Applicative-import Control.Arrow (first, second)-import Control.Concurrent.STM-import Control.Monad.State-import qualified Data.ByteString.Char8 as BS8+-- import Control.Applicative+import Control.Arrow (first{-, second-})+import Control.Monad.State (get, put, modify, execState) import Data.ByteString (ByteString)-import Data.Hashable+import qualified Data.ByteString.Char8 as BS8 (pack)+import Data.Hashable (Hashable, hashWithSalt, hash) import Data.Int import Data.List (nub, elemIndex, find) -- , sortBy) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe import Data.Monoid-import qualified Data.Set as Set---- once upon a time, we used -XRebindableSyntax to do Float defaulting instead of -XIncoherentInstances -- this is the machinery for that to work:-{--import Prelude hiding (Num(..), fromRational) -- so i can do Float defaulting-import qualified Prelude as N-import qualified Data.String (fromString)--fromInteger :: Integer -> Float-fromInteger = realToFrac--fromRational :: Rational -> Float-fromRational = N.fromRational--int :: Float -> Int-int = fromEnum--integer :: Float -> Integer-integer = toInteger . fromEnum--i8 :: Float -> Int8-i8 = fromIntegral . int--i16 :: Float -> Int16-i16 = fromIntegral . int--i32 :: Float -> Int32-i32 = fromIntegral . int--fromString :: String -> ByteString-fromString = Data.String.fromString--string :: ByteString -> String-string = BS8.unpack--}+-- import qualified Data.Set as Set+import Prelude -sdPretty :: SynthDef -> String+sdPretty :: SynthDef a -> String sdPretty synthDef = unlines $ [      "Name: " <> show (_sdName synthDef)    , "Args: " <> show (_sdParams synthDef)    , "UGens: "    ] <> map show (Map.toAscList (_sdUGens synthDef)) -+-- | Action to take with a UGen when it's finished+-- +--   This representation will change in the future data DoneAction    = DoNothing    | FreeEnclosing+   | DoneAction_AsNum Int  deriving (Show, Eq)  doneActionNum :: DoneAction -> Float doneActionNum = \case    DoNothing -> 0    FreeEnclosing -> 2--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+   DoneAction_AsNum n -> toEnum n  --invariants (to check): -- param names don't clash@@ -199,39 +147,69 @@ -- params are all used, and the ones that're used in the graph all exist  -sdToLiteral :: SynthDef -> Literal.LiteralSynthDef-sdToLiteral theSD@(SynthDef name params ugens) =+sdToLiteral :: SynthDef a -> Literal.LiteralSynthDef+sdToLiteral theSD@(SynthDef name params ugens) = fixAndSimplify $    LiteralSynthDef       (case name of          SDName_Named s -> s          SDName_Hash -> getSDHashName theSD          )-      (gatherConstants $ Map.toAscList ugens)+      (gatherConstants $ Map.toAscList ugens )       (map snd params)       (zipWith (\s i -> ParamName s i) (map fst params) [0..])       (makeUGenSpecs params $ Map.toAscList ugens)       [] -getSDHashName :: SynthDef -> ByteString+fixAndSimplify :: Literal.LiteralSynthDef -> Literal.LiteralSynthDef+fixAndSimplify =+   replaceBitNot+++-- Can unit test this by making a complex SD graph that uses+-- multiple "bitNot"s and checking that it's exactly equal to if+-- we'd used '& . bitXor 0xFFFFFF'++-- silent:+-- play $ (0.1 ~* sinOsc (freq_ 440)) >>= \x -> uOp BitNot x >>= \y -> biOp BitAnd y x >>= \z -> out 0 [z,z]++-- | Fix for github.com/supercollider/supercollider/issues/1749+replaceBitNot :: Literal.LiteralSynthDef -> Literal.LiteralSynthDef+replaceBitNot lsd@(Literal.LiteralSynthDef name oldConsts params paramNames ugens variants) =+   case any isBitNot ugens of+      False -> lsd+      True ->+         Literal.LiteralSynthDef name newConsts params paramNames (map replaceIt ugens) variants+ where+   -- newConsts :: [Float];  newOneLoc :: Int32+   (newConsts, toEnum -> negOneLoc) =+      case elemIndex (-1) oldConsts of+         Nothing -> (oldConsts <> [(-1)], (length::[a]->Int) oldConsts)+         Just i -> (oldConsts, i)+   isBitNot :: UGenSpec -> Bool+   isBitNot ug =+         (Literal._uGenSpec_name ug == "UnaryOpUGen")+      && (Literal._uGenSpec_specialIndex ug == uOpToSpecialI BitNot)+   replaceIt :: UGenSpec -> UGenSpec+   replaceIt ugspec = if isBitNot ugspec+      then 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  {---- Write it if you wanna:+-- Anyone, write it for me if you wanna!: literalToSD :: Literal.SynthDef -> SD-literalToSD = undefined+literalToSD = -} -encodeSD :: SynthDef -> ByteString-encodeSD = encodeSynthDefFile . SynthDefFile . (:[]) . sdToLiteral---- | This is the hash of the UGen graph and params, but not the name!---   So (re)naming a SynthDef will not change its hash.-instance Hashable SynthDef where-   hashWithSalt salt (SynthDef _name params ugens) =-      hashWithSalt salt . encodeSD $-         SynthDef (SDName_Named "VIVID FTW") params ugens- gatherConstants :: [(Int, UGen)] -> [Float] gatherConstants ugens =    nub [ x | Constant x <- concatMap (_ugenIns . snd) ugens]@@ -245,7 +223,7 @@       (BS8.pack "Control")       KR       []-      (replicate (length params) (OutputSpec KR))+      (replicate ((length::[a]->Int) params) (OutputSpec KR))       0     rest = map makeSpec ugens@@ -263,10 +241,10 @@                 Constant x -> InputSpec_Constant $ fromIntegral $ fromJust $                    elemIndex x $ gatherConstants ugens                 UGOut ugenId outputNum ->-                   let inputPosition = toEnum ugenId + case params of-                          [] -> 0-                          _ -> 1 -- if there are any params, there's a "Control" in-                                 -- the 0th position+                   let inputPosition =+                           -- If there are any params, there's a "Control" in+                           -- the 0th position:+                          toEnum ugenId + case params of { [] -> 0 ; _ -> 1 }                    in InputSpec_UGen inputPosition outputNum                 Param s -> InputSpec_UGen 0 (indexOfName params s)                 )@@ -275,76 +253,59 @@   -- invariant: strings are unique: indexOfName :: (Eq a) => [(ByteString, a)] -> ByteString -> Int32--- in the future: add levens(t|h)ein distance "did you mean?:"+-- In the future: add levens(t|h)ein distance "did you mean?:" indexOfName haystack key =    let foo = case find ((==key) . fst) haystack of          Nothing -> error $ "missing param: " <> show key          Just x -> x    in fromIntegral $ fromJust $ (flip elemIndex) haystack $ foo --- | Send a synth definition to be loaded on the SC server--- ---   Note that this is sort of optional -- if you don't call it, it'll be called the first time---   you call 'synth' with the SynthDef-defineSD :: SynthDef -> IO ()-defineSD synthDef =-   defineSDIfNeeded synthDef--defineSDIfNeeded :: SynthDef -> IO ()-defineSDIfNeeded synthDef@(SynthDef name _ _) = do-   let !_ = scServerState-   hasBeenDefined <- (((name, hash synthDef) `Set.member`) <$>) $-      readTVarIO (scServer_definedSDs scServerState)-   unless hasBeenDefined $ do-      callAndWaitForDone $ OSC (BS8.pack "/d_recv") [-           OSC_B $ encodeSD synthDef-         , OSC_I 0-         ]-      atomically $ modifyTVar (scServer_definedSDs scServerState) $-         ((name, hash synthDef) `Set.insert`)--getFreshUGenGraphId :: SDState Int+getFreshUGenGraphId :: SDBody' args Int getFreshUGenGraphId = do-   (i:ds, synthDef) <- get-   put (ds, synthDef)+   (i:ds, synthDef, argList) <- get+   put (ds, synthDef, argList)    return i  -- | Alias for 'addMonoUGen'-addUGen :: UGen -> SDState Signal+addUGen :: UGen -> SDBody' args Signal addUGen = addMonoUGen  -- | Add a unit generator with one output-addMonoUGen :: UGen -> SDState Signal+addMonoUGen :: UGen -> SDBody' args Signal addMonoUGen ugen = addPolyUGen ugen >>= \case    [x] -> return x-   foo -> error $ "that ugen's not mono!: " <> show ugen <> show foo+   foo -> error $ "that ugen's not mono!: " <>   show ugen <>  show foo  -- | Polyphonic -- returns a list of 'Signal's. --   In the future this might be a tuple instead of a list-addPolyUGen :: UGen -> SDState [Signal]-addPolyUGen ugen = do+addPolyUGen :: UGen -> SDBody' args [Signal]+addPolyUGen ugen = addPolyUGen' $ ugen++addPolyUGen' :: UGen -> SDBody' args [Signal]+addPolyUGen' ugen = do    anId <- getFreshUGenGraphId-   modify . second $ \synthDef -> synthDef { _sdUGens =+   modify . (\f (a,b,c)->(a,f b,c)) $ \synthDef -> synthDef { _sdUGens =       Map.unionWith (\_ -> error "dammit keying broken") (_sdUGens synthDef) $          Map.singleton anId ugen       }    return $ map (UGOut anId) [0.. toEnum (_ugenNumOuts ugen - 1)]  -- | Define a Synth Definition-sd :: [(String, Float)] -> SDState x -> SynthDef+sd :: VarList argList => argList -> SDBody' (InnerVars argList) [Signal] -> SynthDef (InnerVars argList) sd params theState =    makeSynthDef SDName_Hash params theState  -- | Define a Synth Definition and give it a name you can refer to from e.g. sclang-sdNamed :: String -> [(String, Float)] -> SDState x -> SynthDef+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 -> [(String, Float)] -> SDState x -> SynthDef+makeSynthDef :: VarList argList => SDName -> argList -> SDBody' (InnerVars argList) [Signal] -> SynthDef (InnerVars argList) makeSynthDef name params theState =-   let theSD = SynthDef name (map (first BS8.pack) params) Map.empty-   in snd $ execState theState ({- id supply: -} [0 :: Int ..], theSD)-+   let theSD = SynthDef name (map (first BS8.pack) paramList) Map.empty+       (paramList, argSet) = makeTypedVarList params+   in (\(_,b,_)->b) $ execState theState $+         ({- id supply: -} [0 :: Int ..], theSD, argSet)  -- | Set the calculation rate of a UGen -- @@ -352,19 +313,19 @@ --  --   @ -- play $ do---    s0 <- 1 ~+ (lfSaw (Freq 1) ? KR)---    s1 <- 0.1 ~* lfSaw (Freq $ 220 ~* s0)+--    s0 <- 1 ~+ (lfSaw (freq_ 1) ? KR)+--    s1 <- 0.1 ~* lfSaw (freq_ $ 220 ~* s0) --    out 0 [s1, s1] -- @ --  --   Mnemonic: \"?\" is like thinking -- ---   In the future, the representation of calculation rates definitely may change-(?) :: SDState Signal -> CalculationRate -> SDState Signal+--   In the future, the representation of calculation rates may change+(?) :: SDBody' args Signal -> CalculationRate -> SDBody' args Signal (?) i calcRate = do    i' <- i    case i' of-      UGOut ugId _o -> modify $ second $ \synthDef ->+      UGOut ugId _o -> modify $ (\f (a,b,c)->(a,f b,c)) $ \synthDef ->          let ugs = _sdUGens synthDef              updatedUGens :: Map Int UGen              updatedUGens = case Map.lookup ugId ugs of@@ -375,128 +336,31 @@       _ -> return ()    return i' -getCalcRate :: Signal -> SDState CalculationRate+getCalcRate :: Signal -> SDBody' args CalculationRate getCalcRate (Constant _) = return IR getCalcRate (Param _) = return KR getCalcRate (UGOut theUG _) = do    -- Note: this assumes updates to the ugen graph are only appends    -- (so don't break that invariant if you build your own graph by hand!):-   (_, ugenGraph) <- get+   (_, ugenGraph, _) <- get    case Map.lookup theUG (_sdUGens ugenGraph) of       Just ug -> return $ _ugenCalculationRate ug       Nothing -> error "that output isn't in the graph!" --- | Given a UGen graph, just start playing it right away.--- ---   e.g.--- ---   > play $ do---   >    s <- 0.2 ~* lpf (In whiteNoise) (Freq 440)---   >    out 0 [s, s]-play :: SDState a -> IO NodeId-play x = do-   let graphWithOut = x-   let sdWithOut = sd [] graphWithOut-   synth sdWithOut [] -sdLitPretty :: Literal.LiteralSynthDef -> String-sdLitPretty synthDef = mconcat [-    "Constants: ", show $ _synthDefConstants synthDef-  , "\n"-  , mconcat$-      (flip map) (zip [0..] (Literal._synthDefUGens synthDef)) $ \(i,ug) -> mconcat [-                show i <> " " <> show (_uGenSpec_name ug) <> " - " <> show (_uGenSpec_calcRate ug)-               ,"\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"+-- | Like 'Vivid.SCServer.shrinkNodeArgs' but for 'SynthDef's+shrinkSDArgs :: Subset new old => SynthDef old -> SynthDef new+shrinkSDArgs (SynthDef a b c) = SynthDef a b c -                   _ -> ""-               ]-  ]- where-   showInputSpec :: InputSpec -> String-   showInputSpec (InputSpec_Constant constantIndex) = mconcat [-       "Constant: "-      ,show $ (_synthDefConstants synthDef) !! fromEnum constantIndex-      ," (index ", show constantIndex, ")"-      ]-   showInputSpec x = show x --- | 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'-free :: NodeId -> IO ()-free (NodeId nodeId) =-   call $ OSC (BS8.pack "/n_free") [ OSC_I nodeId ] --- | Set the given parameters of a running synth--- ---   e.g.--- ---   >>> let setTest = sd [("pan", 0.5)] $ out 0 =<< pan2 (In $ 0.1 ~* whiteNoise) (Pos "pan")---   >>> s <- synth setTest []---   >>> set s [("pan", -0.5)]--- ---   Any parameters not referred to will be unaffected, and any you specify that don't exist---   will be (silently) ignored-set :: NodeId -> [(String, Float)] -> IO ()-set (NodeId nodeId) params =-   call $ OSC (BS8.pack "/n_set") $ OSC_I nodeId : paramList- where-   paramList :: [OSCDatum]-   paramList = concatMap (\(k,v)->[OSC_S k,OSC_F v]) $-      map (first BS8.pack) params---- | Create a real live music-playing synth from a boring, dead SynthDef.--- ---   If you haven't defined the SynthDef on the server, this will do it automatically---   (Note that this may cause jitters in musical timing)--- ---   Uses 'HasSynthRef' so that given...--- ---   >>> let foo = sdNamed "foo" [] $ out 0 [0.1 ~* whiteNoise]--- ---   ...you can create a synth either with...--- ---   >>> synth "foo" []--- ---   ...or...--- ---   >>> synth foo []--- ---   Careful!: The SC server doesn't keep track of your nodes for you,---   so if you do something like...--- ---   >>> s <- synth "someSynth" []---   >>> s <- synth "oops" []           -- 's' is overwritten--- ---   ...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'-synth :: (HasSynthRef a) => a -> [(String, Float)] -> IO NodeId-synth refHolder params = do-   case getSynthRef refHolder of-      Left _ -> return ()-      Right aSD -> defineSDIfNeeded aSD+encodeSD :: SynthDef a -> ByteString+encodeSD =+   encodeSynthDefFile . SynthDefFile . (:[]) . sdToLiteral -   nodeId@(NodeId nn) <- newNodeId-   let synthName = case getSynthRef refHolder of-        Left sn -> sn-        Right (SynthDef (SDName_Named n) _ _) -> n-        Right theSD@(SynthDef SDName_Hash _ _) -> getSDHashName theSD-   call $ OSC (BS8.pack "/s_new") $ [-        OSC_S $ synthName, OSC_I nn-      , OSC_I 0-      , OSC_I 1-      ] <> paramList-   return nodeId- where-   paramList :: [OSCDatum]-   paramList = concatMap (\(k, v) -> [OSC_S k, OSC_F v]) $-      map (first BS8.pack) params+-- | This is the hash of the UGen graph and params, but not the name!+--   So (re)naming a SynthDef will not change its hash.+instance Hashable (SynthDef a) where+   hashWithSalt salt (SynthDef _name params ugens) =+      hashWithSalt salt . encodeSD $+         SynthDef (SDName_Named "VIVID FTW") params ugens
− Vivid/SynthDef/CrazyTypes.hs 
@@ -1,66 +0,0 @@--- | Our IncoherentInstances + UndecidableInstances sin bin, for everything that needs---   crazy type hacks--- ---   Most of this is just to get numbers defaulting to Floats in a useful way in---   SynthDefs--- ---   We keep these separated so everything that doesn't need IncoherentInstances---   can live in Sanity Land--{-# OPTIONS_HADDOCK show-extensions #-}--{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE IncoherentInstances #-}--module Vivid.SynthDef.CrazyTypes where---- import Vivid.SynthDef ()-import Vivid.SynthDef.Types--import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS8----class ToSig s where-  toSig :: s -> Signal--instance ToSig Signal where-   toSig = id---- | For 'Constant' (Float) values-instance (Num a, Real a) => ToSig a where-   toSig = Constant . fromRational . toRational--instance ToSig String where-   toSig = Param . BS8.pack-------class ToSigM s where-   toSigM :: s -> SDState Signal--instance (ToSig i) => ToSigM i where-   toSigM = return . toSig--instance ToSigM (SDState Signal) where-   toSigM = id-------class HasSynthRef a where-   getSynthRef :: a -> Either ByteString SynthDef---- for some reason this needs -XFlexibleInstances:-instance HasSynthRef String where-   getSynthRef = Left . BS8.pack--instance HasSynthRef SynthDef where-   getSynthRef = Right---- can also do:-{--instance HasSynthRef (SDState Input) where-   getSynthRef = Right . sd []--}
+ Vivid/SynthDef/FromUA.hs view
@@ -0,0 +1,524 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs, NoMonoLocalBinds #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+-- {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-- Needed for nested type family application:+{-# LANGUAGE UndecidableInstances #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+++--{-# LANGUAGE RankNTypes #-}++module Vivid.SynthDef.FromUA (+     FromUA(..)+   , fromUAWithDefaults+   , uaArgVal+   , uaArgValWDefault+   , DefaultArgs(..)+   , OverwritingArgs(..)+   , UA(..)+   , NoDefaults(..)+   , none+   , Args+   , SDBody++   , AllEqual+   ) where++-- import Vivid.SynthDef+import Vivid.SynthDef.ToSig+import Vivid.SynthDef.Types+-- import Vivid.SynthDef.TypesafeArgs++import qualified Data.List as L+import qualified Data.Map as Map+import Data.Monoid+import Data.Proxy+import GHC.Exts+import GHC.TypeLits++type SDBody a = SDBody' (SDBodyArgs a)++class FromUA (a :: *) where+   type UAsArgs a :: [Symbol]+   type SDBodyArgs a :: [Symbol]+   fromUA :: a -> SDBody a [(String, Signal)]++fromUAWithDefaults :: (+     FromUA a, FromUA b+   , SDBodyArgs a ~ SDBodyArgs b+   ) => DefaultArgs a -> OverwritingArgs b -> SDBody a [(String, Signal)]+fromUAWithDefaults (DefaultArgs defaultArgs) (OverwritingArgs overwritingArgs) = do+   defaultArgs' <- fromUA defaultArgs+   overwritingArgs' <- fromUA overwritingArgs+   return . Map.toList $+      Map.unionWith+         (\_defaultArg overwritingArg -> overwritingArg)+         (Map.fromList defaultArgs')+         (Map.fromList overwritingArgs')++-- Newtypes so we don't accidentally flip argument order:+newtype DefaultArgs a = DefaultArgs a+newtype OverwritingArgs a = OverwritingArgs a++data NoDefaults (args :: [Symbol])+   = NoDefaults+ deriving (Show, Eq, Ord, Read)++none :: NoDefaults args+none = NoDefaults++uaArgVal :: (FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) => as -> proxy aToLookUp -> SDBody as Signal+uaArgVal uaArgs proxy = do+   allSigs <- fromUA uaArgs+   return $ case L.lookup (symbolVal proxy) (allSigs::[(String,Signal)]) of+      Just x -> x+      Nothing -> error $ "whaaaaaaaat?: " ++ symbolVal proxy++-- Note a typo in this one won't be caught -- it'll just use the default value+uaArgValWDefault :: (FromUA as, KnownSymbol aToLookUp, ToSig defaultVal (SDBodyArgs as)) => defaultVal -> as -> proxy aToLookUp -> SDBody as Signal+uaArgValWDefault defaultVal uaArgs proxy = do+   allSigs <- fromUA uaArgs+   case L.lookup (symbolVal proxy) (allSigs::[(String,Signal)]) of+      Just x -> return x+      Nothing -> toSig defaultVal++-- instance (args0 ~ args1) => FromUA (NoDefaults args0) args1 where+instance FromUA (NoDefaults args0) where+   type UAsArgs (NoDefaults args0) = '[]+   type SDBodyArgs (NoDefaults args0) = args0+   fromUA _ = return []++instance FromUA (UA a args0) where+   type UAsArgs (UA a sdArgs) = '[a]+   type SDBodyArgs (UA a args) = args+   fromUA :: UA a args -> SDBody (UA a args) [(String, Signal)]+   fromUA (UA x) = do+      y <- x+      return [(symbolVal (Proxy::Proxy a), y)]+      -- The LHS is like "freq" and the RHS is the value -- lhs isn't the 'foo' in 'A::A "foo"' ^^++instance (args0 ~ args1, KnownSymbol a {-, KnownSymbol b -}) => FromUA (UA a args0, UA b args1) where+   type UAsArgs (UA a args0, UA b args1) = '[a, b]+   type SDBodyArgs (UA a args0, UA b args1) = args0+   fromUA (a, b) = (<>) <$> fromUA a <*> fromUA b++instance (AllEqual '[as0,as1,as2], KnownSymbol a, KnownSymbol b)+         => FromUA (UA a as0, UA b as1, UA c as2) where+   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)+++instance (AllEqual '[as0,as1,as2,as3,as4], AllKnownSymbols '[a, b, c])+         => FromUA (UA a as0, UA b as1, UA c as2, UA d as3) where+   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)++++instance (AllEqual '[as0,as1,as2,as3,as4], AllKnownSymbols '[a,b,c,d] -- , KnownSymbol e --,+--     (SDBodyArgs (UA a as0)) ~ (UghRename (UA b as1, UA c as2, UA d as3, UA e as4))+          )+         => 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)++-- 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)++-- 7:+instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6], AllKnownSymbols '[a,b,c,d,e,f,g])+         => FromUA (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5, UA g as6) where+   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)+++-- 8+instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7]+         , AllKnownSymbols '[a,b,c,d,e,f,g,h])+         => FromUA (UA a as0, UA b as1, UA c as2, UA d as3, UA e as4, UA f as5+                   ,UA g as6,UA h as7) where+   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)+++-- 9:+instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i])+         => FromUA (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) where+   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)+++instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j])+         => FromUA (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) where+   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,UA j as9) =+          '[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)+++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])+         => FromUA (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) where+   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,UA j as9,UA k as10) =+          '[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)+++instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l])+         => FromUA (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) where+   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,UA j as9,UA k as10,UA l as11) =+          '[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)+++instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m])+         => FromUA (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+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12) =+          '[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)+++instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n])+         => FromUA (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+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13) =+          '[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)+++instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o])+         => FromUA (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,UA o as14+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14+                ) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o]+   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,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)+++instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p])+         => FromUA (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,UA o as14,UA p as15+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15+                ) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p]+   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,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)+++instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16+                ) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q]+   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,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)+++instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ,UA r as17+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17+                ) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r]+   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,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)+++instance (AllEqual '[as0,as1,as2,as3,as4,as5,as6,as7,as8,as9,as10,as11,as12,as13,as14,as15,as16,as17,as18]+         ,AllKnownSymbols '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ,UA r as17, UA s as18+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17+                ,UA s as18) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s]+   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,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)+++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])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ,UA r as17, UA s as18,UA t as19+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17+                ,UA s as18,UA t as19) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t]+   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,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)++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])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ,UA r as17, UA s as18,UA t as19,UA u as20+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17+                ,UA s as18,UA t as19,UA u as20+                ) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u]+   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,UA o as14,UA p as15,UA q as16,UA r as17+                  ,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)++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])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ,UA r as17, UA s as18,UA t as19,UA u as20,UA v as21+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17+                ,UA s as18,UA t as19,UA u as20,UA v as21+                ) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v]+   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,UA o as14,UA p as15,UA q as16,UA r as17+                  ,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)++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])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ,UA r as17, UA s as18,UA t as19,UA u as20,UA v as21+                   ,UA w as22+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17+                ,UA s as18,UA t as19,UA u as20,UA v as21,UA w as22+                ) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w]+   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,UA o as14,UA p as15,UA q as16,UA r as17+                  ,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)++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])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ,UA r as17, UA s as18,UA t as19,UA u as20,UA v as21+                   ,UA w as22,UA x as23+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17+                ,UA s as18,UA t as19,UA u as20,UA v as21,UA w as22,UA x as23+                ) =+          '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x]+   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,UA o as14,UA p as15,UA q as16,UA r as17+                  ,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)++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])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ,UA r as17, UA s as18,UA t as19,UA u as20,UA v as21+                   ,UA w as22,UA x as23,UA y as24+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17+                ,UA s as18,UA t as19,UA u as20,UA v as21,UA w as22,UA x as23+                ,UA y as24) =+          '[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]+   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,UA o as14,UA p as15,UA q as16,UA r as17+                  ,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)++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])+         => FromUA (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,UA o as14,UA p as15,UA q as16+                   ,UA r as17, UA s as18,UA t as19,UA u as20,UA v as21+                   ,UA w as22,UA x as23,UA y as24,UA z as25+                   ) where+   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,UA j as9,UA k as10,UA l as11+                ,UA m as12,UA n as13,UA o as14,UA p as15,UA q as16,UA r as17+                ,UA s as18,UA t as19,UA u as20,UA v as21,UA w as22,UA x as23+                ,UA y as24,UA z as25) =+          '[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]+   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,UA o as14,UA p as15,UA q as16,UA r as17+                  ,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)+++-- | \"UGen Arg\"+data UA (name :: Symbol) (args :: [Symbol]) where+   UA :: KnownSymbol name => SDBody' args Signal -> UA name args+++type family AllEqual (a :: [[Symbol]]) :: Constraint where+   AllEqual '[] = ()+   AllEqual (a ': '[b]) = (a ~ b)+   AllEqual (a ': b ': cs) = (a ~ b, (AllEqual (a ': cs)))++type family AllKnownSymbols (a :: [ks]) :: Constraint where+   AllKnownSymbols '[] = ()+   AllKnownSymbols (ks0 ': kss) = (KnownSymbol ks0, AllKnownSymbols kss)++type family EachElems (forEach :: [Symbol]) args :: Constraint where+   EachElems (x ': xs) args = (Elem x args, EachElems xs args)+   EachElems '[] args = ()++type family Args (required :: [Symbol])+                 (optional :: [Symbol])+                 args+            :: Constraint where+   Args required optional args =+      ( Subset required (UAsArgs args)+      , Subset (UAsArgs args) (SetUnion required optional)+      , FromUA args+      -- , EachElems required (UAsArgs args)+      -- , EachElems optional (UAsArgs args)+      )+
Vivid/SynthDef/Literally.hs view
@@ -8,8 +8,13 @@ {-# OPTIONS_HADDOCK show-extensions #-}  {-# LANGUAGE NoRebindableSyntax #-}-{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}+ module Vivid.SynthDef.Literally (      LiteralSynthDef(..)    , encodeSynthDefFile@@ -20,6 +25,13 @@    , ParamName(..)    , SynthDefFile(..)    , OutputSpec(..)++   , uOpToSpecialI+   , biOpToSpecialI+   , specialIToUOp+   , specialIToBiOp++   , sdLitPretty    ) where  import Vivid.SynthDef.Types@@ -28,11 +40,10 @@ import Control.Arrow (first) import Control.Monad (when) import Data.Binary (decode, encode)-import qualified Data.ByteString as B-import qualified Data.ByteString as BS import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS8-import qualified Data.ByteString.Lazy as BSL+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@@ -51,6 +62,7 @@ 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@@ -83,11 +95,11 @@ encodeSynthDefFile (SynthDefFile synthDefs) = mconcat [      "SCgf"    , BSL.toStrict $ encode (2 :: Int32)-   , BSL.toStrict $ encode (toEnum (length synthDefs) :: Int16)+   , 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 me.+-- 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@@ -134,15 +146,15 @@ encodeSynthDef :: LiteralSynthDef -> ByteString encodeSynthDef (LiteralSynthDef name constants params paramNames uGenSpecs variants) = mconcat [      encodePString name-   , BSL.toStrict $ encode (toEnum (length constants) :: Int32)+   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) constants) :: Int32)    , mconcat $ map (BSL.toStrict . encode . floatToWord) constants-   , BSL.toStrict $ encode (toEnum (length params) :: Int32)+   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) params) :: Int32)    , mconcat $ map (BSL.toStrict . encode . floatToWord) params-   , BSL.toStrict $ encode (toEnum (length paramNames) :: Int32)+   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) paramNames) :: Int32)    , mconcat $ map encodeParamName paramNames-   , BSL.toStrict $ encode (toEnum (length uGenSpecs) :: Int32)+   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) uGenSpecs) :: Int32)    , mconcat $ map encodeUGenSpec uGenSpecs-   , BSL.toStrict $ encode (toEnum (length variants) :: Int16)+   , BSL.toStrict $ encode (toEnum ((length::[a]->Int) variants) :: Int16)    , mconcat $ map encodeVariantSpec variants    ] @@ -193,7 +205,7 @@    let (name, rest) = getPString blob        (calcRate :: CalculationRate, rest2) =           first ((toEnum) . (fromEnum :: Int8 -> Int) . decode . BSL.fromStrict) $-             B.splitAt 1 rest+             BS.splitAt 1 rest        (numInputs :: Int32, rest3) = getInt32 rest2        (numOutputs :: Int32, rest4) = getInt32 rest3 @@ -207,8 +219,8 @@ encodeUGenSpec (UGenSpec name calcRate inputSpecs outputSpecs specialIndex) = mconcat [     encodePString name    ,BSL.toStrict $ encode $ (toEnum (fromEnum calcRate) :: Int8)-   ,BSL.toStrict $ encode $ (toEnum (length inputSpecs) :: Int32)-   ,BSL.toStrict $ encode $ (toEnum (length outputSpecs) :: Int32)+   ,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@@ -306,12 +318,60 @@    in (head1 : head2, rest3)     getInt32 :: ByteString -> (Int32, ByteString)-getInt32 blob = first (decode . BSL.fromStrict) $ B.splitAt 4 blob+getInt32 blob = first (decode . BSL.fromStrict) $ BS.splitAt 4 blob  getInt16 :: ByteString -> (Int16, ByteString)-getInt16 blob = first (decode . BSL.fromStrict) $ B.splitAt 2 blob+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) $-             B.splitAt (4 * fromEnum numBlocks) blob+             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
+ Vivid/SynthDef/ToSig.hs view
@@ -0,0 +1,60 @@+{-# OPTIONS_HADDOCK show-extensions #-}++{-# LANGUAGE FlexibleInstances #-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE GADTs, NoMonoLocalBinds #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{-# LANGUAGE NoMonomorphismRestriction #-}++module Vivid.SynthDef.ToSig (+     ToSig(..)+   ) where++import Vivid.SynthDef.Types+import Vivid.SCServer.Types++import qualified Data.ByteString.Char8 as BS8 (pack)+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++instance (KnownSymbol a, Subset '[a] args) => ToSig (Variable a) args where+   toSig a = (return . Param . BS8.pack . 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:++-- | For 'Constant' (Float) values+instance {-# INCOHERENT #-} (Num n, Real n) => ToSig n args where+   toSig :: n -> SDBody' args Signal+   toSig = return . Constant . realToFrac++-- This way instead of e.g.+-- > BufferId b <- makeBuffer 1+-- > playBuf (buf_ $ toEnum $ fromEnum b+--+-- we can say:+-- > b <- makeBuffer 1+-- > playBuf (buf_ b+instance ToSig BufferId args where+   toSig :: BufferId -> SDBody' args Signal+   toSig (BufferId n) = (return . Constant . realToFrac) n++instance (a ~ args) => ToSig (SDBody' a Signal) args where+   toSig :: SDBody' args Signal -> SDBody' args Signal+   toSig x = x
Vivid/SynthDef/Types.hs view
@@ -1,35 +1,58 @@ -- | Internal. Just use "Vivid.SynthDef"  {-# OPTIONS_HADDOCK show-extensions #-}+-- {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs, NoMonoLocalBinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}+ module Vivid.SynthDef.Types (      Signal(..)    , CalculationRate(..)    , SynthDef(..)    , SDName(..)-   , SDState+   , SDBody'+   , zoomSDBody+   , zoomSynthDef    , UGen(..)    , UGenName(..)    , UnaryOp(..)    , BinaryOp(..)+   , module Vivid.SynthDef.TypesafeArgs    ) where -import Control.Monad.State+import Vivid.SynthDef.TypesafeArgs -- (VarSet(..), Subset, Parameter)++import Control.Monad.State (State, get, runState, put) import Data.ByteString (ByteString)+-- import Data.Hashable import Data.Int (Int32)+-- import qualified Data.Map as Map import Data.Map (Map)+-- import Data.Monoid+import GHC.TypeLits+import Prelude  data Signal-   = Constant Float -- constant-   | Param ByteString -- parameter-   | UGOut Int Int32 -- the name of the ugen, and its output #- deriving (Show, Eq)+   = Constant Float+   | Param ByteString+   | UGOut Int Int32  -- the name of the ugen, and its output #+  deriving (Show, Eq) +-- instance Hashable Signal+ -- | Internal representation of Synth Definitions. Usually, use 'Vivid.SynthDef.sd' instead of --   making these by hand. --  --   This representation (especially '_sdUGens') might change in the future.-data SynthDef = SynthDef {+data SynthDef (args :: [Symbol]) = SynthDef {     _sdName :: SDName    ,_sdParams :: [(ByteString, Float)]    ,_sdUGens :: Map Int UGen@@ -42,9 +65,12 @@    | SDName_Hash  deriving (Show, Eq, Read, Ord) +-- instance Hashable SDName+ -- | Representation of Unit Generators. You usually won't be creating these --   by hand, but instead using things from the library in 'Vivid.UGens'-data UGen = UGen {+data UGen+   = UGen {     _ugenName :: UGenName    ,_ugenCalculationRate :: CalculationRate    ,_ugenIns :: [Signal]@@ -52,14 +78,18 @@    -- ugen's calculation rate, so we don't need to represent them:    ,_ugenNumOuts :: Int    }- deriving (Show, Eq)+  deriving (Show, Eq) +-- instance Hashable UGen+ data UGenName    = UGName_S ByteString    | UGName_U UnaryOp    | UGName_B BinaryOp  deriving (Show, Eq) +-- instance Hashable UGenName+ -- The order of these is important for the enum instance: -- | The rate that a UGen computes at data CalculationRate@@ -69,12 +99,47 @@    | 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 --   The [Int] is the id supply. Its type definitely could change in the future-type SDState = State ([Int], SynthDef)+type SDBody' (args :: [Symbol])+   = State ([Int], SynthDef args, VarSet args) +zoomSynthDef :: (Subset a b) => SynthDef a -> SynthDef b+zoomSynthDef (SynthDef a b c) = SynthDef a b c++-- | Given+-- +--   > good0 :: SDBody '["2"] ()+--   > good0 = return ()+-- +--   > good1 :: SDBody '["3","1","3","1"] ()+--   > good1 = return ()+-- +--   > bad0 :: SDBody '["bwahaha"] ()+--   > bad0 = return ()+-- +--   > outer :: SDBody '[ "1", "2", "3"]()+--   > outer = do+--   >    zoomSDBody good0 -- works+--   >    zoomSDBody good1 -- works+--   >    -- zoomSDBody bad0 -- doesn't work - great!+zoomSDBody :: (Subset inner outer) => SDBody' inner a -> SDBody' outer a+zoomSDBody x = do+   (initA,initB,_) <- get+   -- We call this "cheat" cause it actually goes from outer+   -- to inner -- it's only safe cause we already restricted+   -- the input to this outer function ('zoomSDBody'):+   let cheatSD :: SynthDef a -> SynthDef b+       cheatSD (SynthDef a b c) = SynthDef a b c+   let (val,(a,b,_)) = runState x (initA, cheatSD initB,VarSet)+   put (a, zoomSynthDef b, VarSet)+   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@@ -99,12 +164,16 @@    | SqrSum -- ^ (a + b) ^ 2    | SqrDif -- ^ (a - b) ^ 2    | AbsDif -- ^ abs(a - b)-   | Thresh | AMClip | ScaleNeg | Clip2 | Excess+   | 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@@ -114,7 +183,11 @@ --  --   This type might not be exposed in the future. data UnaryOp-   = Neg | Not | IsNil | NotNil | BitNot | Abs | AsFloat | AsInt | Ciel | Floor+   = 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@@ -127,3 +200,5 @@    | Silence | Thru | RectWindow | HanWindow | WelchWindow | TriWindow | Ramp    | SCurve | NumUnarySelectors  deriving (Show, Eq, Ord, Enum)++-- instance Hashable UnaryOp
+ Vivid/SynthDef/TypesafeArgs.hs view
@@ -0,0 +1,838 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE NoIncoherentInstances #-}++-- {-# LANGUAGE ConstraintKinds -}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs, NoMonoLocalBinds #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+-- {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-- Needed for a nested type family instance:+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++{-# LANGUAGE NoMonomorphismRestriction #-}++module Vivid.SynthDef.TypesafeArgs (++   -- * Type Set Operations+     SubsetBoolToBool -- (..)+   , ElemBoolToBool+   , SetInsert --(..)+   , SetEqual --(..)+   , SetUnion --(..)++   , IsSubsetOf --(..)+   , Bool_IsSubsetOf(..)+   , Subset -- (..)++   , IsElemOf+   , Bool_IsElemOf(..)+   , Elem++   -- * Type arguments+   , TagList(..)+   , VarList(..)+   , V+   , Vs(..)+      -- | This is aliased as 'V':+   , Variable(..)+   , I(..)+   , VarSet(..)+   , TypedVarList -- (..)+   , emptyVarSet+   , iToLiteralVar+   , iToVar+   , AddParams(..)++   -- * Other+--    , (?>) -- not exporting so it doesn't pollute namespace+   , toI+   , toF+   , GetSymbolVals(..)+   ) where++import Control.Arrow (first, second)+import GHC.Exts+import GHC.TypeLits+import qualified Data.Map as Map+import Data.Proxy+import Data.Type.Bool+import System.Random -- For a Random instance++type family SubsetBoolToBool (a :: Bool_IsSubsetOf) :: Bool where+   SubsetBoolToBool 'True_IsSubsetOf = 'True+   SubsetBoolToBool 'False_IsSubsetOf = 'False+++type family ElemBoolToBool (a :: Bool_IsElemOf) :: Bool where+   ElemBoolToBool 'True_IsElemOf = 'True+   ElemBoolToBool 'False_IsElemOf = 'False++-- | So for example if you have:+-- +--   @+--   foo = sd (440 ::I "freq") $ do+--      s <- sinOsc (freq_ (A::A "freq!!!"))+--      out 0 [s,s]+--   @+--+--   It'll tell you that you have an invalid synthdef with the error:+-- +--   @+--     Couldn't match type ‘'False_IsSubsetOf’ with ‘'True_IsSubsetOf’+--                             In the first argument of ‘sinOsc’, namely+--       ‘(freq_ (V :: A "freq!!!"))’+--   @+data Bool_IsSubsetOf+   = True_IsSubsetOf+   | False_IsSubsetOf++type family SetInsert (s :: x) (sSet :: [x]) :: [x] where+   SetInsert e (e ': xs) = (e ': xs)+   SetInsert e xs = e ': xs++type family SetUnion (a :: [x]) (b :: [x]) :: [x] where+   SetUnion '[] bs = bs+   SetUnion (anA ': as) bs = SetUnion as (SetInsert anA bs)++type family SetUnions (a :: [[x]]) :: [x] where+   SetUnions '[] = '[]+   SetUnions (x ': xs) = SetUnion x (SetUnions xs)++-- | >>  .  :kind! SetIntersection '[4,3,4,5] '[7,5,3]+--   >> SetIntersection '[4,3,4,5] '[7,5,3] :: [GHC.TypeLits.Nat]+--   >> = '[3, 5]+type family SetIntersection (a :: [x]) (b :: [x]) :: [x] where+   SetIntersection a b = SetIntersectionPrime a b b++type family SetIntersectionPrime (a :: [x]) (b :: [x]) (allB :: [x]) :: [x] where+   SetIntersectionPrime '[] b allB = '[]+   SetIntersectionPrime (a ': as) '[] allB =+      SetIntersectionPrime as allB allB+   SetIntersectionPrime (a ': as) (a ': bs) allB =+      a ': SetIntersectionPrime as allB allB+   SetIntersectionPrime (a ': as) (b ': bs) allB =+      SetIntersectionPrime (a ': as) bs allB++type family IsSubsetOf (a :: [x]) (b :: [x]) :: Bool_IsSubsetOf where+   IsSubsetOf a b = IsSubsetOfPrime a b b++type family IsSubsetOfPrime (a :: [x]) (b :: [x]) (fullBs :: [x]) :: Bool_IsSubsetOf where+   IsSubsetOfPrime '[] b fullBs = 'True_IsSubsetOf+   IsSubsetOfPrime (a ': as) (a ': bs) fullBs =+      IsSubsetOfPrime as fullBs fullBs+   IsSubsetOfPrime (a ': as) (b ': bs) fullBs =+      IsSubsetOfPrime (a ': as) bs fullBs+   IsSubsetOfPrime as '[] fullBs = 'False_IsSubsetOf++data Bool_IsElemOf+   = True_IsElemOf+   | False_IsElemOf++-- Can rewrite in terms of IsSubsetOf+-- (And have 'Elem' vs 'IsElemOf' -- first is the constraint)+type family IsElemOf (a :: x) (l :: [x]) :: Bool_IsElemOf where+   IsElemOf a '[] = 'False_IsElemOf+   IsElemOf a (a ': b) = 'True_IsElemOf+   IsElemOf a (notA ': b) = IsElemOf a b++-- | >>  >  :kind! SetEqual '["bye", "hi","bye","bye"] '["bye","hi","hi"]+--   >> SetEqual '["bye","hi","bye","bye"] '["bye","hi","hi"] :: Bool+--   >> = 'True+type family SetEqual (a :: [x]) (b :: [x]) :: Bool where+   SetEqual a b = SubsetBoolToBool (IsSubsetOf a b) && SubsetBoolToBool (IsSubsetOf b a)++++data Variable a  where+   V :: KnownSymbol a => Variable a++data Vs (a :: [Symbol]) = Vs++instance Show (Variable a) where+   show V = "(V::V " ++ show (symbolVal (Proxy::Proxy a)) ++ ")"++type V = Variable++{-+ >  getSymbolVals (Vs::Vs '["yes", "yes", "yall"])+["yes","yes","yall"]+-}++class GetSymbolVals x where+   getSymbolVals :: x -> [String]++instance GetSymbolVals (proxy '[]) where+   getSymbolVals _ = []++instance (KnownSymbol x, GetSymbolVals (Proxy (xs::[Symbol]))) =>+      GetSymbolVals (proxy (x ': xs)) where+   getSymbolVals _ =+      symbolVal (Proxy::Proxy x) : getSymbolVals (Proxy::Proxy xs)++++data VarSet (s :: [Symbol]) = VarSet++instance (GetSymbolVals (VarSet xs)) => Show (VarSet xs) where+   show argSet =+      "(VarSet::VarSet "++show (getSymbolVals argSet)++")"++addVarToSet :: Variable sym -> VarSet syms -> VarSet (sym ': syms)+addVarToSet _ _ = VarSet++emptyVarSet :: VarSet '[]+emptyVarSet = VarSet++data I (x :: Symbol) where+   I :: (KnownSymbol x) => Float -> I x++instance (KnownSymbol s) => Show (I s) where+   show (I f) =+      "(" ++ show f ++ "::I " ++ show (symbolVal (Proxy::Proxy s)) ++ ")"+deriving instance (KnownSymbol s) => Eq (I s)+deriving instance (KnownSymbol s) => Read (I s)+deriving instance (KnownSymbol s) => Ord (I s)++toI :: (Real n, KnownSymbol a) => n -> I a+toI = I . realToFrac++toF :: (Real n) => n -> Float+toF = realToFrac++instance (KnownSymbol s) => Num (I s) where+   fromInteger = I . fromInteger+   (+) (I a) (I b) = I (a + b)+   (-) (I a) (I b) = I (a - b)+   abs (I a) = I (abs a)+   (*) (I a) (I b) = I (a * b)+   signum (I a) = I (signum a)++{-+ .  map (* 20) [3..5] :: [I "note"]+[(60.0::I "note"),(80.0::I "note"),(100.0::I "note")]-}+-- etc++instance (KnownSymbol s) => Fractional (I s) where+   fromRational = I . fromRational+   (/) (I a) (I b) = I (a / b)++instance (KnownSymbol s) => Enum (I s) where+   fromEnum (I f) = fromEnum f+   toEnum = I . toEnum++instance (KnownSymbol s) => Real (I s) where+   toRational (I f) = toRational f++instance (KnownSymbol s) => RealFrac (I s) where+   properFraction (I f) = second I $ properFraction f+   truncate (I f) = truncate f+   round (I f) = round f+   ceiling (I f) = ceiling f+   floor (I f) = floor f++instance (KnownSymbol s) => Floating (I s) where+   pi = I pi+   exp (I i) = I (exp i)+   log (I i) = I (log i)+   sin (I i) = I (sin i)+   cos (I i) = I (cos i)+   asin (I i) = I (asin i)+   acos (I i) = I (acos i)+   atan (I i) = I (atan i)+   sinh (I i) = I (sinh i)+   cosh (I i) = I (cosh i)+   asinh (I i) = I (asinh i)+   acosh (I i) = I (acosh i)+   atanh (I i) = I (atanh i)++instance (KnownSymbol s) => RealFloat (I s) where+   floatRadix (I i) = floatRadix i+   floatDigits (I i) = floatDigits i+   floatRange (I i) = floatRange i+   decodeFloat (I i) = decodeFloat i+   encodeFloat a b = I $ encodeFloat a b+   isNaN (I i) = isNaN i+   isInfinite (I i) = isInfinite i+   isDenormalized (I i) = isDenormalized i+   isNegativeZero (I i) = isNegativeZero i+   isIEEE (I i) = isIEEE i++instance (KnownSymbol s) => Random (I s) where+   randomR :: RandomGen g => (I s, I s) -> g -> (I s, g)+   randomR (I rangeLo, I rangeHi) gen =+      first I $ randomR (rangeLo, rangeHi) gen++   random :: RandomGen g => g -> (I s, g)+   random gen = first I (random gen)++type TypedVarList (c :: [Symbol]) = ([(String, Float)], VarSet c)++iToLiteralVar :: KnownSymbol s => I s -> (String, Float)+iToLiteralVar i@(I f) = (symbolVal i, f)++iToVar :: KnownSymbol s => I s -> V s+iToVar _ = V++infixr ?>+(?>) :: (KnownSymbol a, VarList b) => I a -> b -> TypedVarList (a ': InnerVars b)+(?>) a b =+   let (re, name) = makeTypedVarList b+   in (iToLiteralVar a : re, addVarToSet {- (iToArg a) -} V name)++class VarList from where+   type InnerVars from :: [Symbol]+   makeTypedVarList :: from -> TypedVarList (InnerVars from)++infixl `AddParams`++class TagList from where+   type AllTags from :: [Symbol]+   tagStrings :: from -> [String]++-- | Lets you combine sets of arguments. e.g.+-- +--   > (1 ::I "foo", 2 ::I "bar") `AddParams` (3 ::I "baz")+-- +--   means the same thing as+-- +--   > (1 ::I "foo", 2 ::I "bar", 3 ::I "baz")+--   +-- +--   This is left-biased, just like 'Map.union'+-- +--   i.e. if you say:+-- +--   > (99 ::I "same") `AddParams` (0 ::I "same")+-- +--   It'll mean the same as+-- +--   > (99 ::I "same")+data AddParams a b+   = (VarList a, VarList b) => AddParams a b++deriving instance (Show a, Show b) => Show (AddParams a b)++instance VarList (AddParams a b) where+   type InnerVars (AddParams a b) = SetUnion (InnerVars a) (InnerVars b)+   makeTypedVarList (a `AddParams` b) =+        let (Map.fromList -> fooA, _) = makeTypedVarList a+            (Map.fromList -> fooB, _) = makeTypedVarList b+            args = Map.toList $ fooA `Map.union` fooB+        in (args, VarSet :: VarSet (InnerVars (AddParams a b)))++{-+type family Subset (a :: [Symbol]) (b :: [Symbol]) :: Constraint where+   Subset a b = IsSubsetOf a b ~ 'True_IsSubsetOf++type family Elem (a :: Symbol) (b :: [Symbol]) :: Constraint where+   Elem a b = IsElemOf a b ~ 'True_IsElemOf+-}+++type family Subset (as :: [Symbol]) (bs :: [Symbol]) :: Constraint where+   Subset '[] bs = ()+   Subset (a ': as) bs = (Elem a bs, Subset as bs)++type family Elem (a :: Symbol) (xs :: [Symbol]) :: Constraint where+   Elem a (a ': xs) = ()+   Elem a (x ': xs) = Elem a xs+++-- INSTANCES:++-- | Wheeeeeeeeeeeeeeee!++instance VarList (TypedVarList a) where+   type InnerVars (TypedVarList a) = a+   makeTypedVarList = id++instance VarList () where+   type InnerVars () = '[]+   makeTypedVarList () = ([], emptyVarSet)++instance+   (KnownSymbol a) =>+   VarList (I a)+   where+      type InnerVars (I a) = '[a]+      makeTypedVarList x =+         ([iToLiteralVar (x)], VarSet::VarSet '[a])++instance+   (KnownSymbol a, KnownSymbol b) =>+   VarList (I a, I b)+   where+      type InnerVars (I a, I b) =+         '[a, b]+      makeTypedVarList (a,b) =+         a ?> b++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c) =>+   VarList (I a, I b, I c)+   where+      type InnerVars (I a, I b, I c) =+         '[a,b,c]+      makeTypedVarList (a,b,c) =+         a ?> b ?> c++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d) =>+   VarList (I a, I b, I c, I d)+   where+      type InnerVars (I a, I b, I c, I d) =+         '[a,b,c,d]+      makeTypedVarList (a,b,c,d) =+         a ?> b ?> c ?> d++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e) =>+   VarList+     (I a, I b, I c, I d, I e)+   where+      type InnerVars (I a, I b, I c, I d, I e) =+         '[a,b,c,d,e]+      makeTypedVarList (a,b,c,d,e) =+         a ?> b ?> c ?> d ?> e++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f) =+         '[a,b,c,d,e,f]+      makeTypedVarList (a,b,c,d,e,f) =+         a ?> b ?> c ?> d ?> e ?> f++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g) =+         '[a,b,c,d,e,f,g]+      makeTypedVarList (a,b,c,d,e,f,g) =+         a ?> b ?> c ?> d ?> e ?> f ?> g++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h) =+         '[a,b,c,d,e,f,g,h]+      makeTypedVarList (a,b,c,d,e,f,g,h) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i) =+         '[a,b,c,d,e,f,g,h,i]+      makeTypedVarList (a,b,c,d,e,f,g,h,i) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j) =+         '[a,b,c,d,e,f,g,h,i,j]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k) =+         '[a,b,c,d,e,f,g,h,i,j,k]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l) =+         '[a,b,c,d,e,f,g,h,i,j,k,l]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n++-- 15:+instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o ?> p++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o ?> p ?> q+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q,KnownSymbol r+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o ?> p ?> q ?> r++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o ?> p ?> q ?> r ?> s+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s,KnownSymbol t+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o ?> p ?> q ?> r ?> s ?> t+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s,KnownSymbol t+   ,KnownSymbol u+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o ?> p ?> q ?> r ?> s ?> t ?> u+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s,KnownSymbol t+   ,KnownSymbol u,KnownSymbol v+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o ?> p ?> q ?> r ?> s ?> t ?> u ?> v+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s,KnownSymbol t+   ,KnownSymbol u,KnownSymbol v,KnownSymbol w+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v,I w)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v,I w) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o ?> p ?> q ?> r ?> s ?> t ?> u ?> v ?> w+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s,KnownSymbol t+   ,KnownSymbol u,KnownSymbol v,KnownSymbol w,KnownSymbol x+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v,I w,I x)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v,I w,I x) =+         '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x]+      makeTypedVarList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) =+         a ?> b ?> c ?> d ?> e ?> f ?> g ?> h ?> i ?> j ?> k ?> l ?> m ?> n ?> o ?> p ?> q ?> r ?> s ?> t ?> u ?> v ?> w ?> x+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s,KnownSymbol t+   ,KnownSymbol u,KnownSymbol v,KnownSymbol w,KnownSymbol x,KnownSymbol y+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v,I w,I x,I y)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v,I w,I x,I y) =+         '[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]+      makeTypedVarList (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) =+         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+++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ,KnownSymbol p,KnownSymbol q,KnownSymbol r,KnownSymbol s,KnownSymbol t+   ,KnownSymbol u,KnownSymbol v,KnownSymbol w,KnownSymbol x,KnownSymbol y+   ,KnownSymbol z+   ) =>+   VarList+     (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v,I w,I x,I y,I z)+   where+      type InnerVars (I a, I b, I c, I d, I e, I f, I g, I h, I i, I j, I k, I l, I m, I n, I o,I p,I q,I r,I s,I t,I u,I v,I w,I x,I y,I z) =+         '[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]+      makeTypedVarList (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) =+         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+++++(##) :: (KnownSymbol a, TagList b) => V a -> b -> [String]+(##) (_::V a) b = symbolVal (Proxy::Proxy a) : tagStrings b++instance TagList () where+   type AllTags () = '[]+   tagStrings () = []++instance (KnownSymbol a) => TagList (V a) where+   type AllTags (V a) = '[a]+   tagStrings (_ :: V a) = [symbolVal (Proxy::Proxy a)]++instance (KnownSymbol a, KnownSymbol b) => TagList (V a, V b) where+   type AllTags (V a, V b) = '[a, b]+   tagStrings (a,b) = a ## b++-- Also works:+-- instance (KnownSymbol a , TagList (V b,V c)) => TagList (V a, V b, V c) where+instance (KnownSymbol a, KnownSymbol b, KnownSymbol c) => TagList (V a, V b, V c) where+   type AllTags (V a, V b, V c) = '[a, b, c]+   tagStrings (a,b,c) = a ## (b,c)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d) =>+      TagList (V a,V b,V c,V d) where+   type AllTags (V a,V b,V c,V d) =+      '[a,b,c,d]+   tagStrings (a,b,c,d) = a ## (b,c,d)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e) =>+      TagList (V a,V b,V c,V d,V e) where+   type AllTags (V a,V b,V c,V d,V e) =+      '[a,b,c,d,e]+   tagStrings (a,b,c,d,e) = a ## (b,c,d,e)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f+   ) =>+      TagList (V a,V b,V c,V d,V e,V f) where+   type AllTags (V a,V b,V c,V d,V e,V f) =+      '[a,b,c,d,e,f]+   tagStrings (a,b,c,d,e,f) = a ## (b,c,d,e,f)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g+   ) =>+      TagList (V a,V b,V c,V d,V e,V f,V g) where+   type AllTags (V a,V b,V c,V d,V e,V f,V g) =+      '[a,b,c,d,e,f,g]+   tagStrings (a,b,c,d,e,f,g) = a ## (b,c,d,e,f,g)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h+   ) =>+      TagList (V a,V b,V c,V d,V e,V f,V g,V h) where+   type AllTags (V a,V b,V c,V d,V e,V f,V g,V h) =+      '[a,b,c,d,e,f,g,h]+   tagStrings (a,b,c,d,e,f,g,h) = a ## (b,c,d,e,f,g,h)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i+   ) =>+      TagList (V a,V b,V c,V d,V e,V f,V g,V h,V i) where+   type AllTags (V a,V b,V c,V d,V e,V f,V g,V h,V i) =+      '[a,b,c,d,e,f,g,h,i]+   tagStrings (a,b,c,d,e,f,g,h,i) = a ## (b,c,d,e,f,g,h,i)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j+   ) =>+      TagList (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j) where+   type AllTags (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j) =+      '[a,b,c,d,e,f,g,h,i,j]+   tagStrings (a,b,c,d,e,f,g,h,i,j) = a ## (b,c,d,e,f,g,h,i,j)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k+   ) =>+      TagList (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k) where+   type AllTags (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k) =+      '[a,b,c,d,e,f,g,h,i,j,k]+   tagStrings (a,b,c,d,e,f,g,h,i,j,k) = a ## (b,c,d,e,f,g,h,i,j,k)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l+   ) =>+      TagList (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k,V l) where+   type AllTags (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k,V l) =+      '[a,b,c,d,e,f,g,h,i,j,k,l]+   tagStrings (a,b,c,d,e,f,g,h,i,j,k,l) = a ## (b,c,d,e,f,g,h,i,j,k,l)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m+   ) =>+      TagList (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k,V l,V m) where+   type AllTags (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k,V l,V m) =+      '[a,b,c,d,e,f,g,h,i,j,k,l,m]+   tagStrings (a,b,c,d,e,f,g,h,i,j,k,l,m) = a ## (b,c,d,e,f,g,h,i,j,k,l,m)++instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n+   ) =>+      TagList (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k,V l,V m,V n) where+   type AllTags (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k,V l,V m,V n) =+      '[a,b,c,d,e,f,g,h,i,j,k,l,m,n]+   tagStrings (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = a ## (b,c,d,e,f,g,h,i,j,k,l,m,n)++-- 15:+instance+   (KnownSymbol a, KnownSymbol b, KnownSymbol c, KnownSymbol d, KnownSymbol e,+    KnownSymbol f, KnownSymbol g, KnownSymbol h, KnownSymbol i, KnownSymbol j,+    KnownSymbol k, KnownSymbol l, KnownSymbol m, KnownSymbol n, KnownSymbol o+   ) =>+      TagList (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k,V l,V m,V n,V o) where+   type AllTags (V a,V b,V c,V d,V e,V f,V g,V h,V i,V j,V k,V l,V m,V n,V o) =+      '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o]+   tagStrings (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = a ## (b,c,d,e,f,g,h,i,j,k,l,m,n,o)
Vivid/UGens.hs view
@@ -1,445 +1,108 @@ -- | Unit Generators, which are the signal-generating/processing components of synths. -- ---   Most of your time reading documentation will probably be in this module+--   Most of your time reading documentation will probably be in these modules -- ---   Most of these take named arguments with types like 'In', 'Freq', etc.---   This just means you construct them with the same data constructor.---   The data constructor is the same as its type ('In' and 'In', etc.).---   So e.g. to make a lowpass filter which filters whitenoise at 440hz, you'd write:+--   **In ghci, get the type with \":i\" instead of \":t\"** -- ---   > lpf (In whiteNoise) (Freq 440)+--   In \"Args '[foos] '[bars]\", \"foos\" are the required arguments, \"bars\" are the+--   optional ones (ones which have a default value provided) -- ---   This is far from all the ones in SC, so I've exposed the internals so you can make---   your own when you want. Some exports may disappear in future versions.+--   E.g. to make a lowpass filter which filters whitenoise at 440hz, you'd write:+-- +--   > lpf (in_ whiteNoise, freq_ 440)+-- +--   Not all UGens from SC are here, so I've exposed the internals so you can make+--   your own. Some exports may disappear in future versions.+-- +--   These modules are organized in the same way as the "Browse UGens" pages are+-- +--   You can find them in:+-- +--      - The SC IDE: In the Help Browser, click \"Browse\" -> \"UGens\"+--      - Linux: ~/.local/share/SuperCollider/Help/Browse.html#UGens+--      - Other OSes: tbd!  {-# OPTIONS_HADDOCK show-extensions #-} +{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoRebindableSyntax #-}+{-# LANGUAGE NoUndecidableInstances #-}+{-# LANGUAGE NoIncoherentInstances #-}  {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE OverloadedStrings #-}  module Vivid.UGens (--   -- * Generators-   -- | Generate signals, which can then be processed--   -- ** Audio or control rate-   -- | These can be used as direct sound sources or as control parameters--     lfTri-   , lfSaw-   , sinOsc-   , fSinOsc-   , whiteNoise-   , pinkNoise-   , brownNoise---   -- ** Control rate-   -- | These wouldn't be useful as direct sound sources, but instead as-   --   parameters to other UGens--   , xLine-   , line--   -- * User input-   -- | Generators which get signals from user input--   -- ** Audio rate--   , soundIn0--   -- ** Control rate--   , mouseX-   , mouseY---   -- * Filters-   -- | Filter signals--   , bpf-   , lpf-   , hpf-   , clip---   -- * Buffers--   , playBuf1-   , recordBuf1---   -- * FFT-   -- | Stuff for Fast Fourier Transforms. Very incomplete atm.--   , localBuf-   , fft-   , ifft-   , pv_binScramble-   , pv_randComb---   -- * Signal math-   -- | Add, multiply, etc.--   -- ** Operators-   -- | Mnemonic: the ~ looks like a sound wave--   , (~*)-   , (~+)-   , (~/)-   , (~-)-   , (~>)--   -- ** Functions--   , midiCPS-   , cpsMIDI-   , abs'-   , neg-   , binaryOp-   , biOp-   , unaryOp-   , uOp--   -- * Uncategorized-   -- | Haven't organized yet-   , varSaw-   , syncSaw-   , impulse-   , pan2-   , out-   , lfPar-   , lfCub-   , lfPulse-   , mix-   , freeVerb-   , pitchShift-   , lag+     module Vivid.UGens.Args -   , module Vivid.UGens.Args+   , module Vivid.UGens.Algebraic+   , module Vivid.UGens.Analysis+   , module Vivid.UGens.Buffer+   , module Vivid.UGens.Conversion+   , module Vivid.UGens.Convolution+   , module Vivid.UGens.Delays+   , module Vivid.UGens.Demand+   , module Vivid.UGens.Dynamics+   , module Vivid.UGens.Envelopes+   , module Vivid.UGens.FFT+   , module Vivid.UGens.Filters+{-+   , module Vivid.UGens.Filters.BEQSuite+   , module Vivid.UGens.Filters.Linear+   , module Vivid.UGens.Filters.Nonlinear+   , module Vivid.UGens.Filters.Pitch+-}+   , module Vivid.UGens.Info+   , module Vivid.UGens.Generators.Chaotic+   , module Vivid.UGens.Generators.Deterministic+   -- , module Vivid.UGens.Generators.Granular+   --, module Vivid.UGens.Generators.PhysicalModels+   , module Vivid.UGens.Generators.SingleValue+   , module Vivid.UGens.Generators.Stochastic+   , module Vivid.UGens.InOut+   , module Vivid.UGens.Maths+   , module Vivid.UGens.Multichannel+--   , module Vivid.UGens.Multichannel.Panners+   , module Vivid.UGens.Random+   , module Vivid.UGens.Reverbs+   -- , module Vivid.UGens.SynthControl+   , module Vivid.UGens.Triggers+   -- , module Vivid.UGens.Undocumented+   , module Vivid.UGens.UserInteraction    ) where -import Vivid.SynthDef import Vivid.UGens.Args -import Control.Applicative-import Data.ByteString (ByteString)-import Data.List.Split (chunksOf)---- | \"A non-band-limited triangle oscillator. Output ranges from -1 to +1.\"-lfTri :: Freq -> SDState Signal-lfTri (Freq freq) = do-   freq' <- toSigM freq-   addUGen $ UGen (UGName_S "LFTri") AR [freq', Constant 0] 1---- | \"A non-band-limited sawtooth oscillator. Output ranges from -1 to +1.\"-lfSaw :: Freq -> SDState Signal-lfSaw (Freq freq) = do-   freq' <- toSigM freq-   addUGen $ UGen (UGName_S "LFSaw") AR [freq', Constant 0] 1---- | \"Generates noise whose spectrum has equal power at all frequencies.\"-whiteNoise :: SDState Signal-whiteNoise = addUGen $ UGen (UGName_S "WhiteNoise") AR [] 1---- | \"Generates noise whose spectrum falls off in power by 3 dB per octave. This gives equal power over the span of each octave. This version gives 8 octaves of pink noise.\"-pinkNoise :: SDState Signal-pinkNoise = addUGen $ UGen (UGName_S "PinkNoise") AR [] 1---- | \"Generates noise whose spectrum falls off in power by 6 dB per octave.\"-brownNoise :: SDState Signal-brownNoise = addUGen $ UGen (UGName_S "BrownNoise") AR [] 1---- | Sine wave-sinOsc :: Freq -> SDState Signal-sinOsc (Freq i) = do-   i' <- toSigM i-   addUGen $ UGen (UGName_S "SinOsc") AR [i'] 1---- | Band-pass filter-bpf :: In -> Freq -> Rq -> SDState Signal--- Rq: bandwidth / cutofffreq-bpf (In i) (Freq freq) (Rq rq) = do-   i' <- toSigM i-   freq' <- toSigM freq-   rq' <- toSigM rq-   addUGen $ UGen (UGName_S "BPF") AR [i', freq', rq'] 1---- also look at RLPF:--- | Low-pass filter-lpf :: In -> Freq -> SDState Signal-lpf = passFilter "LPF"---- | High-pass filter-hpf :: In -> Freq -> SDState Signal-hpf = passFilter "HPF"--passFilter :: ByteString -> In -> Freq -> SDState Signal-passFilter filterName (In inP) (Freq freq) = do-   in' <- toSigM inP-   freq' <- toSigM freq-   addUGen $ UGen (UGName_S filterName) AR [in', freq'] 1---- | Unlike in SuperCollider, you don't specify a \"lo\" parameter -- \"lo\" is always---   negative \"hi\"-clip :: In -> {- Lo -> -} Hi -> SDState Signal-clip (In i) {- (Lo lo) -} (Hi hi) = do-   i' <- toSigM i-   -- lo' <- toSigM lo-   hi' <- toSigM hi-   lo' <- neg hi'-   addUGen $ UGen (UGName_S "Clip") AR [i', lo', hi'] 1---- | Bus input (usually mic). \"0\" because it's from the 0th bus-soundIn0 :: SDState Signal -- this can easily be expressed now. oh also -- this is a good case where i might want to specify a ton of outputs-soundIn0 = do-   nob <- addUGen $ UGen (UGName_S "NumOutputBuses") IR [] 1-   addUGen $ UGen (UGName_S "In") AR [nob] 1--(~*) :: (ToSigM sig0, ToSigM sig1) => sig0 -> sig1 -> SDState Signal-(~*) = binaryOp Mul--(~+) :: (ToSigM i0, ToSigM i1) => i0 -> i1 -> SDState Signal-(~+) = binaryOp Add--(~/) :: (ToSigM i0, ToSigM i1) => i0 -> i1 -> SDState Signal-(~/) = binaryOp FDiv--(~>) :: (ToSigM i0, ToSigM i1) => i0 -> i1 -> SDState Signal-(~>) = binaryOp Gt--(~-) :: (ToSigM i0, ToSigM i1) => i0 -> i1 -> SDState Signal-(~-) = binaryOp Sub---- | Build your own!-binaryOp :: (ToSigM s0, ToSigM s1) => BinaryOp -> s0 -> s1 -> SDState Signal-binaryOp theBiOp s0 s1 = do-   s0' <- toSigM s0-   s1' <- toSigM s1-   let sigs = [s0', s1']-   calcRate <- maximum <$> mapM getCalcRate sigs-   addUGen $ UGen (UGName_B theBiOp) calcRate sigs 1---- | Alias of 'binaryOp'. Shorter, fer livecodin-biOp :: (ToSigM s0, ToSigM s1) => BinaryOp -> s0 -> s1 -> SDState Signal-biOp = binaryOp---- | Build your own, from 'UnaryOp's-unaryOp :: (ToSigM sig) => UnaryOp -> sig -> SDState Signal-unaryOp theUOp sig = do-   sig' <- toSigM sig-   calcRate <- getCalcRate sig'-   addUGen $ UGen (UGName_U theUOp) calcRate [sig'] 1---- | Alias of 'unaryOp'-uOp :: (ToSigM sig) => UnaryOp -> sig -> SDState Signal-uOp = unaryOp---- | Convert from a midi note number (0-127, each representing a musical half step) to a---   frequency in hz (cycles per second)-midiCPS :: (ToSigM i) => i -> SDState Signal-midiCPS = unaryOp MIDICPS---- | Inverse of 'midiCPS'-cpsMIDI :: (ToSigM i) => i -> SDState Signal-cpsMIDI = unaryOp CPSMIDI---- | The prime is to not conflict with \"abs\" in the prelude. May just use---   \"uOp Abs\" in the future-abs' :: (ToSigM i) => i -> SDState Signal-abs' = unaryOp Abs--neg :: ToSigM i => i -> SDState Signal-neg = unaryOp Neg--out :: (ToSigM i) => Float -> [i] -> SDState [Signal]-out busNum is = do-   is' <- mapM toSigM is-   addPolyUGen $ UGen (UGName_S "Out") AR (Constant busNum : is') (length is)--lfPar :: Freq -> SDState Signal-lfPar (Freq freq) = do-   freq' <- toSigM freq-   addUGen $ UGen (UGName_S "LFPar") AR [freq', Constant 0] 1---- | \"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 :: Start -> End -> Dur -> DoneAction -> SDState Signal-xLine (Start start) (End end) (Dur dur) doneAction = do-   start' <- toSigM start-   end' <- toSigM end-   dur' <- toSigM dur-   addUGen $ UGen (UGName_S "XLine") KR [start', end', dur', Constant $ doneActionNum doneAction] 1---- | \"Generates a line from the start value to the end value.\"--- --- Defaults to KR-line :: Start -> End -> Dur -> DoneAction -> SDState Signal-line (Start start) (End end) (Dur dur) doneAction = do-   start' <- toSigM start-   end' <- toSigM end-   dur' <- toSigM dur-   addUGen $ UGen (UGName_S "Line") KR [start', end', dur', Constant $ doneActionNum doneAction] 1--lfCub :: Freq -> SDState Signal-lfCub (Freq freq) = do-   freq' <- toSigM freq-   addUGen $ UGen (UGName_S "LFCub") AR [freq'] 1--impulse :: Freq -> SDState Signal-impulse (Freq freq) = do-   freq' <- toSigM freq-   addUGen $ UGen (UGName_S "Impulse") AR [freq', Constant 0] 1--lfPulse :: Freq -> Width -> SDState Signal-lfPulse (Freq freq) (Width width) = do-   freq' <- toSigM freq-   width' <- toSigM width-   addUGen $ UGen (UGName_S "LFPulse") AR [freq', Constant 0, width'] 1----- other options:--- warp -- Mapping curve. 0 is linear, 1 is exponential (e. g. for freq or times). Alternatively you can specify: 'linear' or 'exponential'.--- lag -- Lag factor to dezpipper cursor movement.-mouseY :: MinVal -> MaxVal -> SDState Signal-mouseY = mouseGeneral "MouseY"--mouseX :: MinVal -> MaxVal -> SDState Signal-mouseX = mouseGeneral "MouseX"--mouseGeneral :: ByteString -> (MinVal -> MaxVal -> SDState Signal)-mouseGeneral ugenName (MinVal minVal) (MaxVal maxVal) = do-   minVal' <- toSigM minVal-   maxVal' <- toSigM maxVal-   addUGen $ UGen (UGName_S ugenName) KR [minVal', maxVal', Constant 0, Constant 0.2] 1---varSaw :: Freq -> Width -> SDState Signal-varSaw (Freq freq) (Width width) = do-   freq' <- toSigM freq-   width' <- toSigM width-   addUGen $ UGen (UGName_S "VarSaw") AR [freq', Constant 0, width'] 1--syncSaw :: SyncFreq -> SawFreq -> SDState Signal-syncSaw (SyncFreq syncFreq) (SawFreq sawFreq) = do-   syncFreq' <- toSigM syncFreq-   sawFreq' <- toSigM sawFreq-   addUGen $ UGen (UGName_S "SyncSaw") AR [syncFreq', sawFreq'] 1---- | Add a single LocalBuf for FFT-localBuf :: NumFrames -> NumChans -> SDState Signal-localBuf (NumFrames numFrames) (NumChans numChannels) = do-   -- don't know what the "1" is here:-   mlb <- addUGen $ UGen (UGName_S "MaxLocalBufs") IR [Constant 1] 1-   numChannels' <- toSigM numChannels-   numFrames' <- toSigM numFrames-   addUGen $ UGen (UGName_S "LocalBuf") IR [numChannels', numFrames', mlb] 1--fft :: Buf -> In -> SDState Signal-fft (Buf buf) (In inp) = do-   buf' <- toSigM buf-   inp' <- toSigM inp-      -- might want to change some of these args:-   let args = [buf', inp', Constant 0.5, Constant 0, Constant 1, Constant 0]-   addUGen $ UGen (UGName_S "FFT") KR args 1--ifft :: Buf -> SDState Signal-ifft (Buf buf) = do-   buf' <- toSigM buf-   addUGen $ UGen (UGName_S "IFFT") AR [buf', Constant 0, Constant 0] 1---   -- FFT FUNCTIONS: ----pv_binScramble :: Buf -> Wipe -> Width -> Trigger -> SDState Signal-pv_binScramble (Buf buf) (Wipe wipe) (Width width) (Trigger trigger) = do-   buf' <- toSigM buf-   wipe' <- toSigM wipe-   width' <- toSigM width-   trigger' <- toSigM trigger-   addUGen $ UGen (UGName_S "PV_BinScramble") KR [buf', wipe', width', trigger'] 1--pv_randComb :: Buf -> Wipe -> Trigger -> SDState Signal-pv_randComb (Buf buf) (Wipe wipe) (Trigger trigger) = do-   buf' <- toSigM buf-   wipe' <- toSigM wipe-   trigger' <- toSigM trigger-   addUGen $ UGen (UGName_S "PV_RandComb") KR [buf', wipe', trigger'] 1----   -- END FFT -------- | Mixes down a list of audio rate inputs to one. ---   The list can't be empty.--- ---   This is more efficient than e.g. @foldl1 (~+)@-mix :: (ToSigM s) => [s] -> SDState Signal-mix [] = error "empty mix"-mix [x] = toSigM x-mix xs = mix =<< (mapM mix' . chunksOf 4) =<< mapM toSigM xs- where-   mix' :: [Signal] -> SDState Signal-   mix' [] = error "something's broken"-   mix' [x] = return x-   mix' [a,b] = a ~+ b-   mix' ins@[_,_,_]   = addUGen $ UGen (UGName_S "Sum3") AR ins 1-   mix' ins@[_,_,_,_] = addUGen $ UGen (UGName_S "Sum4") AR ins 1-   mix' _ = error "that would be weird"---- can i compute numchans?--- also e.g. w reverb you dont want the doneaction to be 2--- | Play a 1-channel buffer-playBuf1 :: {- NumChans -> -} Buf -> SDState Signal- -- numchans "must be a fixed integer"-   -- args are in sc order, not osc:-playBuf1 {- (NumChans numChans) -} (Buf buf) = do-   -- numChans' <- toSigM numChans-   buf' <- toSigM buf-   addUGen $ UGen (UGName_S "PlayBuf") AR [buf', {- rate: -} Constant 1, {- trigger -} Constant 1, {- startPos -} Constant 0, {- loop: -} Constant 0, {- doneAction -} Constant 2] 1 -- numChans', ---- | Record a 1-channel buffer-recordBuf1 :: In -> Buf -> SDState Signal-   -- args are in sc order, not osc:-recordBuf1 (In inp) (Buf buf) = do-   in' <- toSigM inp-   buf' <- toSigM buf-   addUGen $ UGen (UGName_S "RecordBuf") AR [buf', {- offset -} Constant 0, {- recLevel -} Constant 1, {- prelevel-} Constant 0, {- run -} Constant 1, {- loop -} Constant 0, {- trigger -} Constant 1, {- doneAction -} Constant 2, in'] 1--freeVerb :: In -> Mix -> Room -> Damp -> SDState Signal-freeVerb (In inp) (Mix mixS) (Room room) (Damp damp) = do-   in' <- toSigM inp-   mix' <- toSigM mixS-   room' <- toSigM room-   damp' <- toSigM damp-   addUGen $ UGen (UGName_S "FreeVerb") AR [in', mix', room', damp'] 1--pitchShift :: In -> Ratio -> SDState Signal-pitchShift (In inp) (Ratio ratio) = do-   in' <- toSigM inp-   ratio' <- toSigM ratio-   addUGen $ UGen (UGName_S "PitchShift") AR [in', {- windowSize: -} Constant 0.2, ratio', {-pitchDispersion -} Constant 0, {- timeDispersion -} Constant 0] 1--fSinOsc :: Freq -> SDState Signal-fSinOsc (Freq freq) = do-   freq' <- toSigM freq-   addUGen $ UGen (UGName_S "FSinOsc") AR [freq'] 1---- | 'pos' is -1 to 1-pan2 :: In -> Pos -> SDState [Signal]-pan2 (In inp) (Pos pos) = do-   in' <- toSigM inp-   pos' <- toSigM pos-   addPolyUGen $ UGen (UGName_S "Pan2") AR [in', pos'] 2---- | The \"Secs\" arg is the same as the \"lagTime\" arg in SC-lag :: In -> Secs -> SDState Signal-lag (In inp) (Secs secs) = do-   in' <- toSigM inp-   secs' <- toSigM secs-   addUGen $ UGen (UGName_S "Lag") AR [in', secs'] 1+import Vivid.UGens.Algebraic+import Vivid.UGens.Analysis+import Vivid.UGens.Buffer+import Vivid.UGens.Conversion+import Vivid.UGens.Convolution+import Vivid.UGens.Delays+import Vivid.UGens.Demand+import Vivid.UGens.Dynamics+import Vivid.UGens.Envelopes+import Vivid.UGens.FFT+import Vivid.UGens.Filters+{-+import Vivid.UGens.Filters.BEQSuite+import Vivid.UGens.Filters.Linear+import Vivid.UGens.Filters.Nonlinear+import Vivid.UGens.Filters.Pitch+-}+import Vivid.UGens.Generators.Chaotic+import Vivid.UGens.Generators.Deterministic+-- import Vivid.UGens.Generators.Granular+--import Vivid.UGens.Generators.PhysicalModels+import Vivid.UGens.Generators.SingleValue+import Vivid.UGens.Generators.Stochastic+import Vivid.UGens.Info+import Vivid.UGens.InOut+import Vivid.UGens.Maths+import Vivid.UGens.Multichannel+--import Vivid.UGens.Multichannel.Panners+import Vivid.UGens.Random+import Vivid.UGens.Reverbs+-- import Vivid.UGens.SynthControl+import Vivid.UGens.Triggers+-- import Vivid.UGens.Undocumented+import Vivid.UGens.UserInteraction
+ Vivid/UGens/Algebraic.hs view
@@ -0,0 +1,148 @@+-- | The fixities of the operators ("~+", "~*", "~<", etc) are the same as those of+--   their non-'~' equivalents (+, *, < etc)+--+--   (So you can e.g. multiply then add without parens!)++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Algebraic (+     (~+)+   , (~-)+   , (~*)+   , (~**)+   , (~/)+   , (~>)+   , (~>=)+   , (~<)+   , (~<=)+   , binaryOp+   , biOp+   , unaryOp+   , uOp+   , midiCPS+   , cpsMIDI+   , abs'+   , neg+   , tanh'+   , clip2+   , xor+   ) where++import Vivid.SynthDef+-- import Vivid.UGens.Args++import Prelude++infixl 7 ~*+-- | Multiply signals+(~*) :: (ToSig i0 a, ToSig i1 a) => i0 -> i1 -> SDBody' a Signal+(~*) = binaryOp Mul++infixr 8 ~**+-- | Exponentiation of signals+(~**) :: (ToSig i0 a, ToSig i1 a) => i0 -> i1 -> SDBody' a Signal+(~**) = binaryOp Pow++infixl 6 ~++-- | Add signals+(~+) :: (ToSig i0 a, ToSig i1 a) => i0 -> i1 -> SDBody' a Signal+(~+) = binaryOp Add++infixl 7 ~/+-- | Divide signals+(~/) :: (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+(~>) = binaryOp Gt++infix 4 ~>=+-- | Test signals for left greater than or equal to right+(~>=) :: (ToSig i0 a, ToSig i1 a) => i0 -> i1 -> SDBody' a Signal+(~>=) = binaryOp Ge++infix 4 ~<+-- | Test signals for left less than right+(~<) :: (ToSig i0 a, ToSig i1 a) => i0 -> i1 -> SDBody' a Signal+(~<) = binaryOp Lt++infix 4 ~<=+-- | 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+(~-) :: (ToSig i0 a, ToSig i1 a) => i0 -> i1 -> SDBody' a Signal+(~-) = binaryOp Sub++-- | Build your own!+-- +--   The calculation rate of the result is the larger (more frequent) of the 2 input+--   signals+--   (So you shouldn't need to use "?" very much!)+binaryOp :: (ToSig s0 a, ToSig s1 a) => BinaryOp -> s0 -> s1 -> SDBody' a Signal+binaryOp theBiOp s0 s1 = do+   s0' <- toSig s0+   s1' <-  toSig s1+   calcRate <- max <$> getCalcRate s0' <*> getCalcRate s1'+   let sigs = [s0', s1']+   addUGen $ UGen (UGName_B theBiOp) calcRate sigs 1++-- | Alias of 'binaryOp'. Shorter, fer livecodin+biOp :: (ToSig s0 a, ToSig s1 a) => BinaryOp -> s0 -> s1 -> SDBody' a Signal+biOp = binaryOp++-- | Build your own, from 'UnaryOp's+unaryOp :: (ToSig sig a) => UnaryOp -> sig -> SDBody' a Signal+unaryOp theUOp sig = do+   sig' <- toSig sig+   calcRate <- getCalcRate sig'+   addUGen $ UGen (UGName_U theUOp) calcRate [sig'] 1++-- | Alias of 'unaryOp'+uOp :: (ToSig sig a) => UnaryOp -> sig -> SDBody' a Signal+uOp = unaryOp++-- | Convert from a midi note number (0-127, each representing a musical half step) to a+--   frequency in hz (cycles per second)+midiCPS :: (ToSig i a) => i -> SDBody' a Signal+midiCPS = unaryOp MIDICPS++-- | Inverse of 'midiCPS'+cpsMIDI :: (ToSig i a) => i -> SDBody' a Signal+cpsMIDI = unaryOp CPSMIDI++++-- | The prime is to not conflict with \"abs\" in the prelude. May just use+--   \"uOp Abs\" in the future+abs' :: (ToSig i a) => i -> SDBody' a Signal+abs' = unaryOp Abs++neg :: (ToSig i a) => i -> SDBody' a Signal+neg = unaryOp Neg++-- | The prime, like 'abs'', is to not conflict with a prelude definition.+-- +--   Remember you can always just use:+-- +--   > uOp TanH+tanh' :: ToSig i a => i -> SDBody' a Signal+tanh' i = uOp TanH i++-- | Like 'Vivid.UGens.Maths.clip' but the lo value is always negative the hi value+clip2 :: (ToSig s0 a, ToSig s1 a) => s0 -> s1 -> SDBody' a Signal+clip2 = biOp Clip2++-- | Bitwise xor. Short for @biOp BitXor@+xor :: (ToSig s0 a, ToSig s1 a) => s0 -> s1 -> SDBody' a Signal+xor = biOp BitXor
+ Vivid/UGens/Analysis.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Analysis (++     -- * Analysis > Amplitude++     ampComp+---   , ampCompA+---   , amplitude+---   , detectSilence+---   , loudness+---   , peak+---   , peakFollower+---   , sendPeakRMS++     -- * Analysis > Pitch++---   , keyTrack+   , pitch+---   , zeroCrossing++     -- * Analysis++---   , beatTrack+---   , beatTrack2+---    , mfcc+---   , onsets+     -- In UGens.Maths+   -- , runningSum+     -- In UGens.Filters.Linear:+   -- , slope+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++-- | "Implements the (optimized) formula:+-- +--      compensationFactor = (root / freq) ** exp+-- +--   Higher frequencies are normally perceived as louder, which AmpComp compensates."+-- +--   "Note that for frequencies very much smaller than root the amplitudes can become very high. In this case limit the freq with freq.max(minval), or use AmpCompA."+-- +--   Computed at "AR", "KR", or "IR"+ampComp :: (Args '["freq", "root"] '["exponent"] a) => a -> SDBody a Signal+ampComp = makeUGen+   "AmpComp" AR+   (Vs::Vs '["freq", "root", "exponent"])+   (exponent_ (0.3333::Float))++-- | "Higher frequencies are normally perceived as louder, which AmpCompA compensates. Following the measurings by Fletcher and Munson, the ANSI standard describes a function for loudness vs. frequency.+--   Note that this curve is only valid for standardized amplitude."+-- +--   _NOTE_ "Apart from freq, the values are not modulatable"+++--- ampCompA ::+--- ampCompA =+--- amplitude ::+--- amplitude =+--- detectSilence ::+--- detectSilence =+--- loudness ::+--- loudness =+--- peak ::+--- peak =+--- peakFollower ::+--- peakFollower =+--- sendPeakRMS ::+--- sendPeakRMS =+--- 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."+-- +--   "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" 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))++--- zeroCrossing ::+--- zeroCrossing =+--- beatTrack ::+--- beatTrack =+--- beatTrack2 ::+--- beatTrack2 =+--- mfcc ::+--- mfcc =+--- onsets ::+--- onsets =
Vivid/UGens/Args.hs view
@@ -1,40 +1,597 @@--- | These are named the same as their SC counterparts, usually.---   Sometimes not, if the names are long or if the names would clash w/ common---   other names.+-- | UGen argument labels+-- +--   These are named the same as their SC counterparts, usually.  {-# OPTIONS_HADDOCK show-extensions #-}  {-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} ++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoUndecidableInstances #-}++ module Vivid.UGens.Args where -import Vivid.SynthDef (ToSigM)+import Vivid.SynthDef+import Vivid.SynthDef.FromUA+-- import Vivid.SynthDef.TypesafeArgs (getSymbolVals) -data Buf = forall i. ToSigM i => Buf i-data Bus = forall i. ToSigM i => Bus i-data Damp = forall i. ToSigM i => Damp i-data Dur = forall i. ToSigM i => Dur i-data End = forall i. ToSigM i => End i-data Freq = forall i. ToSigM i => Freq i-data Hi = forall i. ToSigM i => Hi i-data In = forall i. ToSigM i => In i-data Lo = forall i. ToSigM i => Lo i-data MaxVal = forall i. ToSigM i => MaxVal i-data MinVal = forall i. ToSigM i => MinVal i-data Mix = forall i. ToSigM i => Mix i-data NumChans = forall i. ToSigM i => NumChans i-data NumFrames = forall i. ToSigM i => NumFrames i-data Phase = forall i. ToSigM i => Phase i-data Pos = forall i. ToSigM i => Pos i-data Ratio = forall i. ToSigM i => Ratio i-data Room = forall i. ToSigM i => Room i-data Rq = forall i. ToSigM i => Rq i-data SawFreq = forall i. ToSigM i => SawFreq i-data Secs = forall s. ToSigM s => Secs s-data Start = forall i. ToSigM i => Start i-data SyncFreq = forall i. ToSigM i => SyncFreq i-data Trigger = forall i. ToSigM i => Trigger i-data Width = forall i. ToSigM i => Width i-data Wipe = forall i. ToSigM i => Wipe i+import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.Map as Map+-- import Data.Monoid+-- import GHC.TypeLits++a_ :: ToSig s as => s -> UA "a" as+a_ = UA . toSig++a0_ :: ToSig s as => s -> UA "a0" as+a0_ = UA . toSig++a1_ :: ToSig s as => s -> UA "a1" as+a1_ = UA . toSig++a2_ :: ToSig s as => s -> UA "a2" as+a2_ = UA . toSig++active_ :: ToSig s as => s -> UA "active" as+active_ = UA . toSig++add_ :: ToSig s as => s -> UA "add" as+add_ = UA . toSig++ampThreshold_ :: ToSig s as => s -> UA "ampThreshold" as+ampThreshold_ = UA . toSig++aReal_ :: ToSig s as => s -> UA "aReal" as+aReal_ = UA . toSig++-- | SC compatibility+areal_ :: ToSig s as => s -> UA "aReal" as+areal_ = aReal_++aImag_ :: ToSig s as => s -> UA "aImag" as+aImag_ = UA . toSig++-- | SC compatibility+aimag_ :: ToSig s as => s -> UA "aImag" as+aimag_ = aImag_++attackSecs_ :: ToSig s as => s -> UA "attackSecs" as+attackSecs_ = UA . toSig++-- | Alias of 'attackSecs_', for SC compatibility+attackTime_ :: ToSig s as => s -> UA "attackSecs" as+attackTime_ = attackSecs_++b_ :: ToSig s as => s -> UA "b" as+b_ = UA . toSig++b1_ :: ToSig s as => s -> UA "b1" as+b1_ = UA . toSig++b2_ :: ToSig s as => s -> UA "b2" as+b2_ = UA . toSig++bias_ :: ToSig s as => s -> UA "bias" as+bias_ = UA . toSig++bins_ :: ToSig s as => s -> UA "bins" as+bins_ = UA . toSig++bits_ :: ToSig s as => s -> UA "bits" as+bits_ = UA . toSig++buf_ :: ToSig s as => s -> UA "buf" as+buf_ = UA . toSig++-- | For SC compatibility -- alias of 'buf_'+buffer_ :: ToSig s as => s -> UA "buf" as+buffer_ = buf_++bus_ :: ToSig s as => s -> UA "bus" as+bus_ = UA . toSig++bw_ :: ToSig s as => s -> UA "bw" as+bw_ = UA . toSig++bwr_ :: ToSig s as => s -> UA "bwr" as+bwr_ = UA . toSig++c_ :: ToSig s as => s -> UA "c" as+c_ = UA . toSig++-- | Alias of 'numChans_'+chans_ :: ToSig s as => s -> UA "numChans" as+chans_ = numChans_++clampSecs_ :: ToSig s as => s -> UA "clampSecs" as+clampSecs_ = UA . toSig++-- | Alias of 'clampSecs_', for SC compatibility+clampTime_ :: ToSig s as => s -> UA "clampSecs" as+clampTime_ = clampSecs_++clar_ :: ToSig s as => s -> UA "clar" as+clar_ = UA . toSig++coef_ :: ToSig s as => s -> UA "coef" as+coef_ = UA . toSig++control_ :: ToSig s as => s -> UA "control" as+control_ = UA . toSig++crossFade_ :: ToSig s as => s -> UA "crossFade" as+crossFade_ = UA . toSig++-- | For SC compatibility -- alias of 'crossFade_'+crossfade_ :: ToSig s as => s -> UA "crossFade" as+crossfade_ = UA . toSig++-- | **This may change in the future**+curve_curve :: Int -> UA "curve" as+curve_curve = UA . return . Constant . realToFrac++{-+curve_step = 0+curve_linear = 1+curve_lin = 1+curve_exponential = 2+curve_exp = 2+curve_sine = 3+curve_sin = 3+curve_welch = 4+curve_wel = 4+curve_squared = 6+curve_sqr = 6+curve_cubed = 7+curve_cub = 7+envCurveNumber (Curve_Curve _) = 5+-}++damp_ :: ToSig s as => s -> UA "damp" as+damp_ = UA . toSig++db_ :: ToSig s as => s -> UA "db" as+db_ = UA . toSig++decaySecs_ :: ToSig s as => s -> UA "decaySecs" as+decaySecs_ = UA . toSig++-- | Alias of 'decaySecs_' for SC compatibility+decayTime_ :: ToSig s as => s -> UA "decaySecs" as+decayTime_ = decaySecs_++-- | Alias of 'decaySecs_' for SC compatibility+decaytime_ :: ToSig s as => s -> UA "decaySecs" as+decaytime_ = decaySecs_++-- | Alias of 'delaySecs_' for SC compatibility+delay_ :: ToSig s as => s -> UA "delaySecs" as+delay_ = delaySecs_++delaySecs_ :: ToSig s as => s -> UA "delaySecs" as+delaySecs_ = UA . toSig++-- | Alias of 'delaySecs_' for SC compatibility+delayTime_ :: ToSig s as => s -> UA "delaySecs" as+delayTime_ = delaySecs_++-- | Alias of 'delaySecs_' for SC compatibility+delaytime_ :: ToSig s as => s -> UA "delaySecs" as+delaytime_ = delaySecs_++density_ :: ToSig s as => s -> UA "density" as+density_ = UA . toSig++depth_ :: ToSig s as => s -> UA "depth" as+depth_ = UA . toSig++depthVariation_ :: ToSig s as => s -> UA "depthVariation" as+depthVariation_ = UA . toSig++dn_ :: ToSig s as => s -> UA "dn" as+dn_ = UA . toSig++doneAction_ :: ToSig s as => s -> UA "doneAction" as+doneAction_ = UA . toSig++downSample_ :: ToSig s as => s -> UA "downSample" as+downSample_ = UA . toSig++dsthi_ :: ToSig s as => s -> UA "dsthi" as+dsthi_ = UA . toSig++dstlo_ :: ToSig s as => s -> UA "dstlo" as+dstlo_ = UA . toSig++-- | Alias of 'secs_'+dur_ :: ToSig s as => s -> UA "secs" as+dur_ = secs_++duration_ :: ToSig s as => s -> UA "duration" as+duration_ = UA . toSig++end_ :: ToSig s as => s -> UA "end" as+end_ = UA . toSig++execFreq_ :: ToSig s as => s -> UA "execFreq" as+execFreq_ = UA . toSig++-- | Alias of 'exponent_'+exp_ :: ToSig s as => s -> UA "exponent" as+exp_ = exponent_++exponent_ :: ToSig s as => s -> UA "exponent" as+exponent_ = UA . toSig++fftSize_ :: ToSig s as => s -> UA "fftSize" as+fftSize_ = UA . toSig++-- | For SC compatibility -- alias of 'fftSize_'+fftsize_ :: ToSig s as => s -> UA "fftSize" as+fftsize_ = fftSize_++frames_ :: ToSig s as => s -> UA "numFrames" as+frames_ = numFrames_++frameSize_ :: ToSig s as => s -> UA "frameSize" as+frameSize_ = UA . toSig++-- | For SC compatibility -- alias of 'frameSize_'+framesize_ :: ToSig s as => s -> UA "frameSize" as+framesize_ = frameSize_++freeze_ :: ToSig s as => s -> UA "freeze" as+freeze_ = UA . toSig++freq_ :: ToSig s as => s -> UA "freq" as+freq_  = UA . toSig++friction_ :: ToSig s as => s -> UA "friction" as+friction_ = UA . toSig++g_ :: ToSig s as => s -> UA "g" as+g_ = UA . toSig++gain_ :: ToSig s as => s -> UA "gain" as+gain_ = UA . toSig++gate_ :: ToSig s as => s -> UA "gate" as+gate_ = UA . toSig++hi_ :: ToSig s as => s -> UA "hi" as+hi_ = UA . toSig++hop_ :: ToSig s as => s -> UA "hop" as+hop_ = UA . toSig++id_ :: ToSig s as => s -> UA "id" as+id_ = UA . toSig++in_ :: ToSig s as => s -> UA "in" as+in_ = UA . toSig++initFreq_ :: ToSig s as => s -> UA "initFreq" as+initFreq_ = UA . toSig++integrate_ :: ToSig s as => s -> UA "integrate" as+integrate_ = UA . toSig++-- | Interpolation+interp_ :: ToSig s as => s -> UA "interp" as+interp_ = UA . toSig++-- | For SC compatibility -- alias of 'interp_'+interpolation_ :: ToSig s as => s -> UA "interp" as+interpolation_ = interp_++iphase_ :: ToSig s as => s -> UA "iphase" as+iphase_ = UA . toSig++irBufNum_ :: ToSig s as => s -> UA "irBufNum" as+irBufNum_ = UA . toSig++-- | For SC compatibility -- alias of 'irBufSize_'+irbufnum_ :: ToSig s as => s -> UA "irBufNum" as+irbufnum_ = irBufNum_++kernel_ :: ToSig s as => s -> UA "kernel" as+kernel_ = UA . toSig++-- | Alias, for SC compatibility+lag_ :: ToSig s as => s -> UA "lagSecs" as+lag_ = UA . toSig++lagSecs_ :: ToSig s as => s -> UA "lagSecs" as+lagSecs_ = UA . toSig++-- | For SC compatibility:+lagTime_ :: ToSig s as => s -> UA "lagSecs" as+lagTime_ = lagSecs_++length_ :: ToSig s as => s -> UA "length" as+length_ = UA . toSig++level_ :: ToSig s as => s -> UA "level" as+level_ = UA . toSig++lo_ :: ToSig s as => s -> UA "lo" as+lo_ = UA . toSig++loop_ :: ToSig s as => s -> UA "loop" as+loop_ = UA . toSig++m_ :: ToSig s as => s -> UA "m" as+m_ = UA . toSig++max_ :: ToSig s as => s -> UA "max" as+max_ = UA . toSig++maxBinsPerOctave_ :: ToSig s as => s -> UA "maxBinsPerOctave" as+maxBinsPerOctave_ = UA . toSig++maxDelaySecs_ :: ToSig s as => s -> UA "maxDelaySecs" as+maxDelaySecs_ = UA . toSig++-- | Alias of 'maxDelaySecs_' for SC compatibility+maxDelayTime_ :: ToSig s as => s -> UA "maxDelaySecs" as+maxDelayTime_ = UA . toSig++-- | Alias of 'maxDelaySecs_' for SC compatibility+maxdelaytime_ :: ToSig s as => s -> UA "maxDelaySecs" as+maxdelaytime_ = maxDelayTime_++maxFreq_ :: ToSig s as => s -> UA "maxFreq" as+maxFreq_ = UA . toSig++-- | Alias of 'max_', for SC compatibility+maxVal_ :: ToSig s as => s -> UA "max" as+maxVal_ = UA . toSig++median_ :: ToSig s as => s -> UA "median" as+median_ = UA . toSig++min_ :: ToSig s as => s -> UA "min" as+min_ = UA . toSig++minFreq_ :: ToSig s as => s -> UA "minFreq" as+minFreq_ = UA . toSig++minmax_ :: ToSig s as => s -> UA "minmax" as+minmax_ = UA . toSig++-- | Alias of 'min_', for SC compatibility+minVal_ :: ToSig s as => s -> UA "min" as+minVal_ = UA . toSig++mix_ :: ToSig s as => s -> UA "mix" as+mix_ = UA . toSig++mul_ :: ToSig s as => s -> UA "mul" as+mul_ = UA . toSig++numChans_ :: ToSig s as => s -> UA "numChans" as+numChans_ = UA . toSig++numFrames_ :: ToSig s as => s -> UA "numFrames" as+numFrames_ = UA . toSig++numTeeth_ :: ToSig s as => s -> UA "numTeeth" as+numTeeth_ = UA . toSig++offset_ :: ToSig s as => s -> UA "offset" as+offset_ = UA . toSig++onset_ :: ToSig s as => s -> UA "onset" as+onset_ = UA . toSig++peakLevel_ :: ToSig s as => s -> UA "peakLevel" as+peakLevel_ = UA . toSig++peakThreshold_ :: ToSig s as => s -> UA "peakThreshold" as+peakThreshold_ = UA . toSig++phase_ :: ToSig s as => s -> UA "phase" as+phase_ = UA . toSig++pitchDispersion_ :: ToSig s as => s -> UA "pitchDispersion" as+pitchDispersion_ = UA . toSig++pos_ :: ToSig s as => s -> UA "pos" as+pos_ = UA . toSig++post_ :: ToSig s as => s -> UA "post" as+post_ = UA . toSig++preLevel_ :: ToSig s as => s -> UA "preLevel" as+preLevel_ = UA . toSig++rate_ :: ToSig s as => s -> UA "rate" as+rate_ = UA . toSig++rateVariation_ :: ToSig s as => s -> UA "rateVariation" as+rateVariation_ = UA . toSig++radius_ :: ToSig s as => s -> UA "radius" as+radius_ = UA . toSig++ratio_ :: ToSig s as => s -> UA "ratio" as+ratio_ = UA . toSig++recLevel_ :: ToSig s as => s -> UA "recLevel" as+recLevel_ = UA . toSig++relaxSecs_ :: ToSig s as => s -> UA "relaxSecs" as+relaxSecs_ = UA . toSig++-- | Alias of 'relaxSecs_' for SC compatibility+relaxTime_ :: ToSig s as => s -> UA "relaxSecs" as+relaxTime_ = UA . toSig++releaseSecs_ :: ToSig s as => s -> UA "releaseSecs" as+releaseSecs_ = UA . toSig++-- | Alias of 'releaseSecs_', for SC compatibility+releaseTime_ :: ToSig s as => s -> UA "releaseSecs" as+releaseTime_ = releaseSecs_++repeats_ :: ToSig s as => s -> UA "repeats" as+repeats_ = UA . toSig++-- | Shorter alias for 'repeats_'+reps_ :: ToSig s as => s -> UA "repeats" as+reps_ = repeats_++reset_ :: ToSig s as => s -> UA "reset" as+reset_ = UA . toSig++resetPos_ :: ToSig s as => s -> UA "resetPos" as+resetPos_ = UA . toSig++room_ :: ToSig s as => s -> UA "room" as+room_ = UA . toSig++root_ :: ToSig s as => s -> UA "root" as+root_ = UA . toSig++rq_ :: ToSig s as => s -> UA "rq" as+rq_ = UA . toSig++rs_ :: ToSig s as => s -> UA "rs" as+rs_ = UA . toSig++run_ :: ToSig s as => s -> UA "run" as+run_ = UA . toSig++sawFreq_ :: ToSig s as => s -> UA "sawFreq" as+sawFreq_ = UA . toSig++secs_ :: ToSig s as => s -> UA "secs" as+secs_ = UA . toSig++shift_ :: ToSig s as => s -> UA "shift" as+shift_ = UA . toSig++slopeAbove_ :: ToSig s as => s -> UA "slopeAbove" as+slopeAbove_ = UA . toSig++slopeBelow_ :: ToSig s as => s -> UA "slopeBelow" as+slopeBelow_ = UA . toSig++spring_ :: ToSig s as => s -> UA "spring" as+spring_ = UA . toSig++srchi_ :: ToSig s as => s -> UA "srchi" as+srchi_ = UA . toSig++srclo_ :: ToSig s as => s -> UA "srclo" as+srclo_ = UA . toSig++startPos_ :: ToSig s as => s -> UA "startPos" as+startPos_ = UA . toSig++start_ :: ToSig s as => s -> UA "start" as+start_ = UA . toSig++step_ :: ToSig s as => s -> UA "step" as+step_ = UA . toSig++stretch_ :: ToSig s as => s -> UA "stretch" as+stretch_ = UA . toSig++susLevel_ :: ToSig s as => s -> UA "susLevel" as+susLevel_ = UA . toSig++syncFreq_ :: ToSig s as => s -> UA "syncFreq" as+syncFreq_ = UA . toSig++threshold_ :: ToSig s as => s -> UA "threshold" as+threshold_ = UA . toSig++-- | Alias for "threshold_"+thresh_ :: ToSig s as => s -> UA "threshold" as+thresh_ = threshold_++timeDispersion_ :: ToSig s as => s -> UA "timeDispersion" as+timeDispersion_ = UA . toSig++trig_ :: ToSig s as => s -> UA "trigger" as+trig_ = trigger_++-- | You can use "trig_" instead+trigger_ :: ToSig s as => s -> UA "trigger" as+trigger_ = UA . toSig++trigid_ :: ToSig s as => s -> UA "trigid" as+trigid_ = UA . toSig++-- | Short alias for 'ugen_'+ug_ :: ToSig s as => s -> UA "ugen" as+ug_ = UA . toSig++ugen_ :: ToSig s as => s -> UA "ugen" as+ugen_ = UA . toSig++up_ :: ToSig s as => s -> UA "up" as+up_ = UA . toSig++warp_ :: ToSig s as => s -> UA "warp" as+warp_ = UA . toSig++width_ :: ToSig s as => s -> UA "width" as+width_ = UA . toSig++wipe_ :: (ToSig s as) => s -> UA "wipe" as+wipe_ = UA . toSig++-- | Alias of 'windowSize_'+winsize_ :: ToSig s as => s -> UA "windowSize" as+winsize_ = windowSize_++windowSize_ :: ToSig s as => s -> UA "windowSize" as+windowSize_ = UA . toSig++wintype_ :: ToSig s as => s -> UA "windowType" as+wintype_ = windowType_++windowType_ :: ToSig s as => s -> UA "windowType" as+windowType_ = UA . toSig++xi_ :: ToSig s as => s -> UA "xi" as+xi_ = UA . (toSig)+++-- this one gives you:+-- (same as above but "args" at the end there)+--     Could not deduce (FromUA (UA "phase" args0))+-- (this is the same arg as if you have no type sig)+++makeMakeUGen :: (+     GetSymbolVals (Vs tags)+   , FromUA optional+   , FromUA userSupplied+   , SDBodyArgs optional ~ SDBodyArgs userSupplied+   , SDBodyArgs optional ~ args+   ) => (UGen -> SDBody' args x) -> Int -> String -> CalculationRate -> Vs tags -> optional -> (userSupplied -> SDBody' args x)+makeMakeUGen addUGenF numOuts sdName calcRate tagList defaultArgs = \userSupplied -> do+   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++makeMonoUGen = makeMakeUGen addMonoUGen 1+makePolyUGen n = makeMakeUGen addPolyUGen n+makeUGen = makeMonoUGen
+ Vivid/UGens/Buffer.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Buffer (++     -- * Buffer > Info++     bufChannels+   , bufDur+   , bufFrames+   , bufRateScale+   , bufSampleRate+   , bufSamples++     -- * Buffer++   , bufRd+   , bufWr+---   , dbufrd+---   , dbufwr+---   , delTapRd+---   , delTapWr+---   , detectIndex+     -- In Vivid.UGens.InOut:+   -- , diskIn+     -- In Vivid.UGens.InOut:+   -- , diskOut+     -- In Vivid.UGens.Generators.Granular:+   -- , grainBuf+---   , harmonics+---   , index+---   , indexInBetween+---   , indexL+   , localBuf+---   , multiTap+   , phasor+   , playBuf+   , recordBuf+---   , scopeOut+---   , shaper+     -- In Vivid.UGens.Generators.Granular+   -- , tGrains+---   , tap+     -- In Vivid.UGens.InOut:+   -- , vDiskIn+     -- In Vivid.UGens.Generators.Granular+   -- , warp1+---   , wrapIndex+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++import Data.Proxy++-- | Add a single LocalBuf for FFT+-- +--   Can use 'Vivid.UGens.Args.chans_' for \"numChans\"+--   and 'frames_' for \"Vivid.UGens.Args.numFrames\"+localBuf :: Args '["numChans","numFrames"] '[] a => a -> SDBody a Signal+localBuf args = do+   mlb <- addUGen $ UGen (UGName_S "MaxLocalBufs") IR [Constant 1] 1+   numChannels' <- uaArgVal args (Proxy::Proxy "numChans")+   numFrames' <- uaArgVal args (Proxy::Proxy "numFrames")+   -- Another example where the args in sclang and scsynth are in different orders:+   addUGen $ UGen (UGName_S "LocalBuf") IR [numChannels', numFrames', mlb] 1+++-- | Unlike in SC, "doneAction" defaults to 2+playBuf :: (Args '["buf"] '["rate","trigger","startPos","loop","doneAction"] a) => a -> SDBody a Signal+playBuf = makeUGen+   "PlayBuf" AR+   (Vs::Vs '["buf","rate","trigger","startPos","loop","doneAction"])+   (rate_ ((1)::Float), trigger_ ((1)::Float), startPos_ ((0)::Float)+   ,loop_ ((0)::Float), doneAction_ ((2)::Float))+++-- | Unlike in SC, "doneAction" defaults to 2 and "loop" defaults to 0+recordBuf :: (Args '["buf","in"] '["offset","recLevel","preLevel","run","loop","trigger","doneAction"] a) => a -> SDBody a Signal+recordBuf = makeUGen+   "RecordBuf" AR+   (Vs::Vs '["buf","offset","recLevel","preLevel","run","loop","trigger","doneAction","in"])+   -- this is another example of different order:+   (offset_ ((0)::Float), recLevel_ ((1)::Float), preLevel_ ((0)::Float), run_ ((1)::Float), loop_ ((0)::Float), trigger_ ((1)::Float), doneAction_ ((2)::Float))++-- | Defaults to 'KR'. Can be 'IR' too but it's not recommended.+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.+bufDur :: (Args '["buf"] '[] a) => a -> SDBody a Signal+bufDur = makeUGen+   "BufDur" KR+   (Vs::Vs '["buf"])+   NoDefaults++-- bufFrames :: (Args '["buf"] '[] a) => a -> SDBody a Signal++-- | Defaults to 'KR'. Can be 'IR' too but it's not recommended.+-- +--   Note you don't need to use "buf_" when you use this+bufFrames :: ToSig s as => s -> SDBody' as Signal+bufFrames = (flip (.)) buf_ $ makeUGen+   "BufFrames" KR+   (Vs::Vs '["buf"])+   NoDefaults++-- bufRateScale :: (Args '["buf"] '[] a) => a -> SDBody a Signal++-- | Defaults to 'KR'. Can be 'IR' too but it's not recommended.+-- +--   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" 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.+-- +--   Note you don't need to use "buf_" when you use this+bufSampleRate :: ToSig s as => s -> SDBody' as Signal+bufSampleRate = (flip (.)) buf_ $ makeUGen+   "BufSampleRate" KR+   (Vs::Vs '["buf"])+   NoDefaults++-- bufSamples :: (Args '["buf"] '[] a) => a -> SDBody a Signal++-- | Defaults to 'KR'. Can be 'IR' too but it's not recommended.+-- +--   Note you don't need to use "buf_" when you use this+bufSamples :: ToSig s as => s -> SDBody' as Signal+bufSamples = (flip (.)) buf_ $ makeUGen+   "BufSamples" KR+   (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')+bufWr :: (Args '["in", {- "numChans", -} "buf", "phase"] '["loop"] a) => a -> SDBody a Signal+bufWr = makeUGen+   "BufWr" AR+   -- An example of arguments in different orders in sclang and scsynth:+   (Vs::Vs '["buf", "phase", "loop", "in"])+   (loop_ ((1)::Float))++        -- returns demandrate+--- dbufrd ::+--- dbufrd =+--- dbufwr ::+--- dbufwr =++-- | "phase" must be the output of 'delTapWr'+--delTapRd :: (Args '["buf", "phase", "delSecs"] '["interp"] a) => s -> SDBody a Signal+--- delTapRd ::+--- delTapRd =++--- delTapWr ::+--- delTapWr =+--- detectIndex ::+--- detectIndex =+--- harmonics ::+--- harmonics =+--- index ::+--- index =+--- indexInBetween ::+--- indexInBetween =+--- indexL ::+--- indexL =+--- multiTap ::+--- multiTap =++phasor :: (Args '[] '["trigger", "rate", "start", "end", "resetPos"] a) => a -> SDBody a Signal+phasor = makeUGen+   "Phasor" AR+   (Vs::Vs '["trigger", "rate", "start", "end", "resetPos"])+   (trig_ ((0)::Float), rate_ ((1)::Float), start_ ((0)::Float), end_ ((1)::Float), resetPos_ ((0)::Float))++--- scopeOut ::+--- scopeOut =+--- shaper ::+--- shaper =+--- tap ::+--- tap =+--- wrapIndex ::+--- wrapIndex =
+ Vivid/UGens/Conversion.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Conversion (+     a2k+---   , degreeToKey+   , k2a+---   , t2a+---   , t2k+   ) where++import Vivid.SynthDef++import qualified Data.ByteString.Char8 as BS8 (pack)+++-- | Convert an audio rate signal to a control rate signal+a2k :: ToSig s a => s -> SDBody' a Signal+a2k = AR `to` KR++--- degreeToKey ::+--- degreeToKey =++-- | Convert a control rate signal to an audio rate signal+k2a :: ToSig s a => s -> SDBody' a Signal+k2a = KR `to` AR++--- t2a ::+--- t2a =+--- t2k ::+--- t2k =++to :: ToSig s a => CalculationRate -> CalculationRate -> (s -> SDBody' a Signal)+to fromRate toRate = \s -> do+   s' <- toSig s+   getCalcRate s' >>= \case+      rate | rate == fromRate -> return ()+      _ -> error $ mconcat [+          show fromRate,"->",show toRate+         ," called without a "+         ,show fromRate," input"+         ]+   addUGen $ UGen (UGName_S letters) toRate [s'] 1+ where+   letters = BS8.pack [calcLetter fromRate,'2',calcLetter toRate]+   calcLetter = \case+      KR -> 'K'+      AR -> 'A'+      IR -> error "ir?!?!"+      DR -> error "dominican republic?!?!"
+ Vivid/UGens/Convolution.hs view
@@ -0,0 +1,55 @@+-- | Most of these only run at audio rate ('AR')++{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Convolution (+     convolution+   , convolution2+   , convolution2L+   , convolution3+   , partConv+---   , stereoConvolution2L+   ) where++import Vivid.UGens.Args+import Vivid.SynthDef+import Vivid.SynthDef.FromUA++convolution :: (Args '["in", "kernel"] '["frameSize"] a) => a -> SDBody a Signal+convolution = makeUGen+   "Convolution" AR+   (Vs::Vs '["in", "kernel", "frameSize"])+   (frameSize_ ((512)::Float))++convolution2 :: (Args '["in", "kernel"] '["trigger", "frameSize"] a) => a -> SDBody a Signal+convolution2 = makeUGen+   "Convolution2" AR+   (Vs::Vs '["in", "kernel", "trigger", "frameSize"])+   (trigger_ ((0)::Float), frameSize_ ((2048)::Float))++convolution2L :: (Args '["in", "kernel"] '["trigger", "frameSize", "crossFade"] a) => a -> SDBody a Signal+convolution2L = makeUGen+   "Convolution2L" AR+   (Vs::Vs '["in", "kernel", "trigger", "frameSize", "crossFade"])+   (trigger_ ((0)::Float), frameSize_ ((2048)::Float), crossFade_ (((1)::Float)))++-- | This one can run at control rate ('KR').+--   It's inefficient so only useful for very small kernels or control rate.+convolution3 :: (Args '["in", "kernel"] '["trigger", "frameSize"] a) => a -> SDBody a Signal+convolution3 = makeUGen+   "Convolution3" AR+   (Vs::Vs '["in", "kernel", "trigger", "frameSize"])+   (trigger_ ((0)::Float), frameSize_ ((2048)::Float))++partConv :: (Args '["in", "fftSize", "irBufNum"] '[] a) => a -> SDBody a Signal+partConv = makeUGen+   "PartConv" AR+   (Vs::Vs '["in", "fftSize", "ifBufNum"])+   NoDefaults++--- stereoConvolution2L ::+--- stereoConvolution2L =
+ Vivid/UGens/Delays.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Delays (++     -- * Delays > Buffer++---     bufAllpassC+---   , bufAllpassL+---   , bufAllpassN+---   , bufCombC+---   , bufCombL+---   , bufCombN+---   , bufDelayC+---   , bufDelayL+---   , bufDelayN+     -- in Vivid.UGens.Buffer:+   -- , multiTap+---   , pingPong+     -- in Vivid.UGens.Buffer:+   -- , tap++     -- * Delays++     allpassC+   , allpassL+   , allpassN+   , combC+   , combL+   , combN+     -- in Vivid.UGens.Buffer:+   -- , delTapRd+   -- , delTapWr+   , delay1+   , delay2+   , delayC+   , delayL+   , delayN+---   , pluck+---   , tDelay+   ) where++-- import Data.ByteString (ByteString)++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++--- bufAllpassC ::+--- bufAllpassC =+--- bufAllpassL ::+--- bufAllpassL =+--- bufAllpassN ::+--- bufAllpassN =+--- bufCombC ::+--- bufCombC =+--- bufCombL ::+--- bufCombL =+--- bufCombN ::+--- bufCombN =+--- bufDelayC ::+--- bufDelayC =+--- bufDelayL ::+--- bufDelayL =+--- bufDelayN ::+--- bufDelayN =+--- pingPong ::+--- pingPong =+++allpassC :: (Args '["in"] ["maxDelaySecs", "delaySecs", "decaySecs"] a) => a -> SDBody a Signal+allpassC = makeDelay "AllpassC"++allpassL :: (Args '["in"] ["maxDelaySecs", "delaySecs", "decaySecs"] a) => a -> SDBody a Signal+allpassL = makeDelay "AllpassL"++allpassN :: (Args '["in"] ["maxDelaySecs", "delaySecs", "decaySecs"] a) => a -> SDBody a Signal+allpassN = makeDelay "AllpassN"++-- These 3 have a delay -- the above 3 you hear yourself right away:++combC :: (Args '["in"] ["maxDelaySecs", "delaySecs", "decaySecs"] a) => a -> SDBody a Signal+combC = makeDelay "CombC"++combL :: (Args '["in"] ["maxDelaySecs", "delaySecs", "decaySecs"] a) => a -> SDBody a Signal+combL = makeDelay "CombL"++combN :: (Args '["in"] ["maxDelaySecs", "delaySecs", "decaySecs"] a) => a -> SDBody a Signal+combN = makeDelay "CombN"++makeDelay :: String -> (Args '["in"] ["maxDelaySecs", "delaySecs", "decaySecs"] a) => a -> SDBody a Signal+makeDelay delayName =+   makeUGen delayName AR+   (Vs::Vs '["in", "maxDelaySecs", "delaySecs", "decaySecs"])+   (maxDelayTime_ (0.2::Float), delayTime_ (0.2::Float), decayTime_ ((1)::Float))++delay1 :: (Args '["in"] '[] a) => a -> SDBody a Signal+delay1 = makeUGen+   "Delay1" AR+   (Vs::Vs '["in"])+   NoDefaults++delay2 :: (Args '["in"] '[] a) => a -> SDBody a Signal+delay2 = makeUGen+   "Delay2" AR+   (Vs::Vs '["in"])+   NoDefaults++delayC :: (Args '["in"] '["maxDelaySecs", "delaySecs"] a) => a -> SDBody a Signal+delayC = makeUGen+   "DelayC" AR+   (Vs::Vs '["in", "maxDelaySecs", "delaySecs"])+   (maxDelayTime_ (0.2::Float), delayTime_ (0.2::Float))++delayL :: (Args '["in"] '["maxDelaySecs", "delaySecs"] a) => a -> SDBody a Signal+delayL =  makeUGen+   "DelayL" AR+   (Vs::Vs '["in", "maxDelaySecs", "delaySecs"])+   (maxDelayTime_ (0.2::Float), delayTime_ (0.2::Float))++delayN :: (Args '["in"] '["maxDelaySecs", "delaySecs"] a) => a -> SDBody a Signal+delayN =  makeUGen+   "DelayN" AR+   (Vs::Vs '["in", "maxDelaySecs", "delaySecs"])+   (maxDelayTime_ (0.2::Float), delayTime_ (0.2::Float))++--- pluck ::+--- pluck =+--- tDelay ::+--- tDelay =
+ Vivid/UGens/Demand.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Rank2Types #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Demand (+     inf++   , dbrown+     -- In Vivid.UGens.Buffer:+   -- , dbufrd+   -- , dbufwr+   , demand+---   , demandEnvGen+---   , dgeom+   , dibrown+   , diwhite+---   , dpoll+   , drand+---   , dreset+   , dseq+   , dser+---   , dseries+   , dshuf+---   , dstutter+---   , dswitch+---   , dswitch1+---   , duty+   , dwhite+---   , dwrand+   , dxrand+---   , tDuty+   ) where++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 Data.Proxy++-- | This correctly decodes/encodes to OSC:+inf :: Float+inf = 1/0++-- | "Dbrown returns numbers in the continuous range between lo and hi , Dibrown returns integer values."+-- +--   "The arguments can be a number or any other UGen."+-- +--   "See Pbrown, BrownNoise for structurally related equivalents."+dbrown :: Args '[] '["lo","hi","step","length"] a => a -> SDBody a Signal+dbrown = demandBrownian "Dbrown"++-- | Defaults to 'KR'+demand :: Args '[] '["trigger","reset","ugen"] a => a -> SDBody a Signal+demand = makeUGen+   "Demand" KR+   (Vs::Vs '["trigger","reset","ugen"])+   NoDefaults++--- demandEnvGen ::+--- demandEnvGen =+--- dgeom ::+--- dgeom =++dibrown :: Args '[] '["lo","hi","step","length"] a => a -> SDBody a Signal+dibrown = demandBrownian "Dibrown"++demandBrownian :: String -> (Args '[] '["lo","hi","step","length"] a => a -> SDBody a Signal)+demandBrownian ugName = makeUGen+   ugName DR+    -- another example of SC args out of order:+   (Vs::Vs '["length","lo","hi","step"])+   (lo_ (0::Float), hi_ (1::Float), step_ (0.01::Float), length_ inf)++diwhite :: Args '[] '["lo","hi","length"] a => a -> SDBody a Signal+diwhite = demandWhite "Diwhite"++--- dpoll ::+--- dpoll =++-- | \"'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"++--- dreset ::+--- dreset =++-- | The list come second so you can curry the repeats and use '=<<' or '>>='+dseq :: (Args '[] '["repeats"] a, ToSig s (SDBodyArgs a)) => a -> [s] -> SDBody a Signal+dseq = drawFromList "Dseq"+++drawFromList :: (Args '[] '["repeats"] a, ToSig s (SDBodyArgs a)) => String -> a -> [s] -> SDBody a Signal+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++dser :: (Args '[] '["repeats"] a, ToSig s (SDBodyArgs a)) => a -> [s] -> SDBody a Signal+dser = drawFromList "Dser"+++--- dseries ::+--- dseries =++dshuf :: (Args '[] '["repeats"] a, ToSig s (SDBodyArgs a)) => a -> [s] -> SDBody a Signal+dshuf = drawFromList "Dshuf"++--- dstutter ::+--- dstutter =+--- dswitch ::+--- dswitch =+--- dswitch1 ::+--- dswitch1 =+--- duty ::+--- duty =++dwhite :: Args '[] '["lo","hi","length"] a => a -> SDBody a Signal+dwhite = demandWhite "Dwhite"++demandWhite :: String -> (Args '[] '["lo","hi","length"] a => a -> SDBody a Signal)+demandWhite ugName = makeUGen+   ugName DR+    -- another example of SC args out of order:+   (Vs::Vs '["length","lo","hi"])+   (lo_ (0::Float), hi_ (1::Float), length_ inf)++--- dwrand ::+--- dwrand =++-- | \"'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"++--- tDuty ::+--- tDuty =
+ Vivid/UGens/Dynamics.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Dynamics (+     compander+---   , companderD+   , limiter+   , normalizer+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+--- import Vivid.SynthDef.TypesafeArgs+import Vivid.UGens.Args++compander :: (Args '["in"] '["control","threshold","slopeBelow","slopeAbove","clampSecs","relaxSecs"] a) => a -> SDBody a Signal+compander = makeUGen+   "Compander" AR+   (Vs::Vs '["in","control","threshold","slopeBelow","slopeAbove","clampSecs","relaxSecs"])+   (control_ (0::Float), thresh_ (0.5::Float), slopeBelow_ (1::Float), slopeAbove_ (1::Float), clampTime_ (0.01::Float), relaxTime_ (0.1::Float))+++--- companderD ::+--- companderD =++-- | 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_'+limiter :: (Args '["in"] '["level", "secs"] a) => a -> SDBody a Signal+limiter = makeUGen+   "Limiter" AR+   (Vs::Vs '["in","level","secs"])+   (level_ (1::Float), secs_ (0.01::Float))++-- | 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_'+normalizer :: (Args '["in"] '["level", "secs"] a) => a -> SDBody a Signal+normalizer = makeUGen+   "Normalizer" AR+   (Vs::Vs '["in","level","secs"])+   (level_ (1::Float), secs_ (0.01::Float))
+ Vivid/UGens/Envelopes.hs view
@@ -0,0 +1,193 @@+-- | **Note:** The argument format for these is a little+--   rough, and is likely to change in the future++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++{-# LANGUAGE FlexibleContexts #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Envelopes (+     -- In UGens.Filters.Linear:+   -- decay+     -- In UGens.Filters.Linear:+   -- , decay2+     -- In Vivid.UGens.Demand:+   -- , demandEnvGen+     adsrGen+---   , dadsrGen+   , envGate+   , envGen+   , envGen_wGate+---   , iEnvGen+   , line+   , linen+   , percGen+   , xLine+   ) where++import Vivid.Envelopes+import Vivid.SynthDef+import Vivid.SynthDef.FromUA+-- import Vivid.SynthDef.TypesafeArgs+import Vivid.UGens.Args+import Vivid.UGens.Algebraic++import GHC.TypeLits+-- import qualified Data.Map as Map+import Data.Monoid+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 attackTime decayTime sustainLevel releaseTime curve userArgs = do+   attackTime' <- toSig attackTime+   decayTime' <- toSig decayTime+   sustainLevel' <- toSig sustainLevel+   releaseTime' <- toSig releaseTime+   peakLevel <- uaArgValWDefault (1::Float) userArgs (Proxy::Proxy "peakLevel")+   bias <- uaArgValWDefault (0::Float) userArgs (Proxy::Proxy "bias")+   doneAction <- uaArgValWDefault (0::Float) userArgs (Proxy::Proxy "doneAction")+   gate <- uaArgValWDefault (1::Float) userArgs (Proxy::Proxy "gate")++   peakXSustain <- peakLevel ~* sustainLevel'+   let plusBias :: (Signal, Signal) -> SDBody' a (Signal, Signal)+       plusBias (a, b) = do+          a' <- bias ~+ a+          return (a', b)+   biasPlusCurveSegs <- mapM plusBias [+           (peakLevel, attackTime')+         , (peakXSustain, decayTime')+         , (Constant 0, releaseTime')+         ]+-- maybe write in terms of 'dadsr' ^^+   signals <- envLiterallyToSignals $ EnvLiterally {+        _envLiterally_initialVal = bias+      , _envLiterally_releaseNode = Just 2+      , _envLiterally_offset = 0+      , _envLiterally_loopNode = Nothing+      , _envLiterally_curveSegments =+         map (\(a,b)->EnvSegment a b curve) biasPlusCurveSegs+      }+   addUGen $ UGen (UGName_S "EnvGen") AR ([+        gate+      , Constant 1 -- levelScale+      , Constant 0 -- levelBias+      , Constant 1 -- timeScale+      , doneAction -- doneActionNum doneAction+      ] <> signals) 1++--- dadsrGen ::+--- dadsrGen =+++envGate :: Subset '["gate","fadeSecs"] a => SDBody' a Signal+envGate = do+   gate <- (V::V "fadeSecs") ~<= (0::Float)+   let theEnv = EnvLiterally {+            _envLiterally_initialVal = gate+          , _envLiterally_releaseNode = Just 1+          , _envLiterally_offset = 0+          , _envLiterally_loopNode = Nothing+          , _envLiterally_curveSegments = [+               EnvSegment (Constant 1) (Constant 1) Curve_Sin+             , EnvSegment (Constant 0) (Constant 1) Curve_Sin+             ]+          }++   envGen_wGate (V::V "gate") (V::V "fadeSecs") theEnv FreeEnclosing++-- | Defaults to 'AR'+envGen :: EnvLiterally a -> DoneAction -> SDBody' a Signal+envGen theEnv doneAction = do+   curveSignals <- envLiterallyToSignals theEnv+   addUGen $ UGen (UGName_S "EnvGen") AR ([+        Constant 1 -- gate+      , Constant 1 -- levelScale+      , Constant 0 -- levelBias+      , Constant 1 -- timeScale+      , Constant $ doneActionNum doneAction+      ] <> curveSignals) 1++envGen_wGate :: (ToSig gate a, ToSig timeScale a) => gate -> timeScale -> EnvLiterally a -> DoneAction -> SDBody' a Signal+envGen_wGate gate timeScale theEnv doneAction = do+   gate' <- toSig gate+   timeScale' <- toSig timeScale+   curveSignals <- envLiterallyToSignals theEnv+   addUGen $ UGen (UGName_S "EnvGen") AR ([+        gate' -- Constant 1 -- gate+      , Constant 1 -- levelScale+      , Constant 0 -- levelBias+      , timeScale' -- , Constant 1 -- timeScale+      , Constant $ doneActionNum doneAction+      ] <> curveSignals) 1+++--- iEnvGen ::+--- iEnvGen =++-- | \"Generates a line from the start value to the end value.\"+-- +--   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"))+-- +--   you should write+-- +--   > (A::A "freq") ~* line (start_ 0, end_ 1)+-- +--   instead.+-- +--   Defaults to KR+line :: (Args '[] '["start","end","secs","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))++-- | "Simple linear envelope generator"+-- +--   Can't change after it's created -- see the note about 'line' if you want it to+-- +--   Only computes at "KR"+linen :: (Args '[] '["gate", "attackSecs", "susLevel", "releaseSecs", "doneAction"] a) => a -> SDBody a Signal+linen = makeUGen+   "Linen" KR+   (Vs::Vs '["gate", "attackSecs", "susLevel", "releaseSecs", "doneAction"])+   (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+percGen :: (Args '[] '["attackSecs", "releaseSecs", "level", "curve", "doneAction"] a) => a -> SDBody a Signal+percGen userArgs = do+   level <- uaArgWDef_onlyConst (1::Float) userArgs (V::V "level")+   attackTime <- uaArgWDef_onlyConst (0.01::Float) userArgs (V::V "attackSecs")+   releaseTime <- uaArgWDef_onlyConst (1::Float) userArgs (V::V "releaseSecs")+   curve <- uaArgWDef_onlyConst (-4::Float) userArgs (V::V "curve")+   doneAction <- fromEnum <$> uaArgWDef_onlyConst (2::Float) userArgs (V::V "doneAction")++   envGen (env 0 [(level, attackTime), (0, releaseTime)] (Curve_Curve curve)) (DoneAction_AsNum doneAction)+ where+   uaArgWDef_onlyConst defaultVal args argName =+      uaArgValWDefault defaultVal args argName >>= \case+         Constant x -> return x+         _ -> error $ "bad argument type: "<>show (symbolVal argName)<>" wasn't a Constant"++-- | \"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 = makeUGen+   "XLine" KR+   (Vs::Vs '["start","end","secs","doneAction"])+   (start_ (1::Float), end_ (2::Float), secs_ (1::Float), doneAction_ (0::Float))
+ Vivid/UGens/Examples.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoMonomorphismRestriction #-}++module Vivid.UGens.Examples where++import Vivid++-- | 'Dbrown' example from the SC help file+dbrown_example = do+   mx <- mouseX (min_ 1, max_ 40, warp_ 1)+   imp <- impulse (freq_ mx) ? KR+   dbr <- dbrown (lo_ 0, hi_ 15, step_ 1, length_ inf)+   dem <- demand (trig_ imp, reset_ 0, ugen_ dbr)+   s <- 0.1 ~* sinOsc (freq_ $ dem ~* 30 ~+ 340)+   out 0 [s,s]
+ Vivid/UGens/FFT.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.FFT (++   -- * Pre and Post++     fft+   , ifft++     -- In Vivid.UGens.Analysis:+   -- , beatTrack+   -- , beatTrack2+     -- In Vivid.UGens.Convolution:+   -- , convolution+   -- , convolution2+   -- , convolution2L+---   , fftTrigger+---   , packFFT+     -- In Vivid.UGens.Convolution:+   -- , partConv+---   , specCentroid+---   , specFlatness+---   , specPcile+     -- In Vivid.UGens.Convolution:+   -- , stereoConvolution2L+---   , unpack1FFT+---   , unpackFFT++   -- * FFT functions++---   , pv_add+   , pv_binScramble+   , pv_binShift+---   , pv_binWipe+   , pv_brickWall+---   , pv_chainUGen+   , pv_conformalMap+   , pv_conj+---   , pv_copy+---   , pv_copyPhase+   , pv_diffuser+---   , pv_div+---   , pv_hainsworthFoote+---   , pv_jensenAndersen+   , pv_localMax+   , pv_magAbove+   , pv_magBelow+   , pv_magClip+---   , pv_magDiv+   , pv_magFreeze+---   , pv_magMul+   , pv_magNoise+   , pv_magShift+   , pv_magSmear+   , pv_magSquared+---   , pv_max+---   , pv_min+---   , pv_mul+   , pv_phaseShift+   , pv_phaseShift270+   , pv_phaseShift90+   , pv_randComb+---   , pv_randWipe+   , pv_rectComb+---   , pv_rectComb2+   ) where++import Vivid.SynthDef+import Vivid.UGens.Args+import Vivid.SynthDef.FromUA++-- | You can use "wintype_" and "winsize_" if you're used to the SC args:+fft :: (Args '["buf"] '["in", "hop", "windowType", "active", "windowSize"] a) => a -> SDBody a Signal+fft = makeUGen+   "FFT" KR+   (Vs::Vs ["buf", "in", "hop", "windowType", "active", "windowSize"])+   (in_ (0::Float), hop_ (0.5::Float), wintype_ (0::Float), active_ (1::Float), winsize_ (0::Float))++-- | You can use "wintype_" and "winsize_" if you're used to the SC args:+ifft :: (Args '["buf"] '["windowType", "windowSize"] a) => a -> SDBody a Signal+ifft =+   makeUGen "IFFT" AR+   (Vs::Vs '["buf", "windowType", "windowSize"])+   (wintype_ (0::Float), winsize_ (0::Float))++--- fftTrigger ::+--- fftTrigger =+--- packFFT ::+--- packFFT =++{-+"+Given an FFT chain, this measures the spectral centroid, which is the weighted mean frequency, or the "centre of mass" of the spectrum. (DC is ignored.)+This can be a useful indicator of the perceptual brightness of a signal.+"+-}++--- specCentroid ::+--- specCentroid =++--- specFlatness ::+--- specFlatness =++--- specPcile ::+--- specPcile =++--- unpack1FFT ::+--- unpack1FFT =+--- unpackFFT ::+--- unpackFFT =++--- pv_add ::+--- pv_add =++pv_binScramble :: (Args '["buf"] '["wipe", "width", "trigger"] a) => a -> SDBody a Signal+pv_binScramble = makeUGen+   "PV_BinScramble" KR+   (Vs::Vs '["buf", "wipe", "width", "trigger"])+   (wipe_ (0::Float), width_ (0.2::Float), trigger_ (0::Float))++pv_binShift :: (Args '["buf"] '["stretch", "shift", "interp"] a) => a -> SDBody a Signal+pv_binShift = makeUGen+   "PV_BinShift" KR+   (Vs::Vs '["buf", "stretch", "shift", "interp"])+   (stretch_ (1::Float), shift_ (0::Float), interp_ (0::Float))++--- pv_binWipe ::+--- pv_binWipe =++pv_brickWall :: (Args '["buf"] '["wipe"] a) => a -> SDBody a Signal+pv_brickWall = makeUGen+   "PV_BrickWall" KR+   (Vs::Vs '["buf", "wipe"])+   (wipe_ (0::Float))++--- pv_chainUGen ::+--- pv_chainUGen =++pv_conformalMap :: (Args '["buf"] '["aReal", "aImag"] a) => a -> SDBody a Signal+pv_conformalMap = makeUGen+   "PV_ConformalMap" KR+   (Vs::Vs '["buf", "aReal","aImag"])+   (aReal_ (0::Float), aImag_ (0::Float))++pv_conj :: (Args '["buf"] '[] a) => a -> SDBody a Signal+pv_conj = makeUGen+   "PV_Conj" KR+   (Vs::Vs '["buf"])+   NoDefaults++--- pv_copy ::+--- pv_copy =+--- pv_copyPhase ::+--- pv_copyPhase =++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_hainsworthFoote ::+--- pv_hainsworthFoote =+--- pv_jensenAndersen ::+--- pv_jensenAndersen =++pv_localMax :: (Args '["buf"] '["threshold"] a) => a -> SDBody a Signal+pv_localMax = makeUGen+   "PV_LocalMax" KR+   (Vs::Vs '["buf", "threshold"])+   (threshold_ (0::Float))++pv_magAbove :: (Args '["buf", "threshold"] '[] a) => a -> SDBody a Signal+pv_magAbove = makeUGen+   "PV_MagAbove" KR+   (Vs::Vs '["buf", "threshold"])+   NoDefaults++pv_magBelow :: (Args '["buf", "threshold"] '[] a) => a -> SDBody a Signal+pv_magBelow = makeUGen+   "PV_MagBelow" KR+   (Vs::Vs '["buf", "threshold"])+   NoDefaults++pv_magClip :: (Args '["buf", "threshold"] '[] a) => a -> SDBody a Signal+pv_magClip = makeUGen+   "PV_MagClip" KR+   (Vs::Vs '["buf", "threshold"])+   NoDefaults++--- pv_magDiv ::+--- pv_magDiv =++pv_magFreeze :: (Args '["buf"] '["freeze"] a) => a -> SDBody a Signal+pv_magFreeze = makeUGen+   "PV_MagFreeze" KR+   (Vs::Vs '["buf", "freeze"])+   (freeze_ (0::Float))++--- pv_magMul ::+--- pv_magMul =++pv_magNoise :: (Args '["buf"] '[] a) => a -> SDBody a Signal+pv_magNoise = makeUGen+   "PV_MagNoise" KR+   (Vs::Vs '["buf"])+   NoDefaults++pv_magShift :: (Args '["buf"] '["stretch", "shift"] a) => a -> SDBody a Signal+pv_magShift = makeUGen+   "PV_MagShift" KR+   (Vs::Vs '["buf", "stretch", "shift"])+   (stretch_ (1::Float), shift_ (0::Float))++-- | "As [the number of bins] rises, so will CPU usage."+pv_magSmear :: (Args '["buf"] '["bins"] a) => a -> SDBody a Signal+pv_magSmear = makeUGen+   "PV_MagSmear" KR+   (Vs::Vs '["buf", "bins"])+   (bins_ (0::Float))++pv_magSquared :: (Args '["buf"] '[] a) => a -> SDBody a Signal+pv_magSquared = makeUGen+   "PV_MagSquared" KR+   (Vs::Vs '["buf"])+   NoDefaults++--- pv_max ::+--- pv_max =+--- pv_min ::+--- pv_min =+--- pv_mul ::+--- pv_mul =++pv_phaseShift :: (Args '["buf", "shift"] '["integrate"] a) => a -> SDBody a Signal+pv_phaseShift = makeUGen+   "PV_PhaseShift" KR+   (Vs::Vs '["buf", "shift", "integrate"])+   (integrate_ (0::Float))++pv_phaseShift270 :: (Args '["buf"] '[] a) => a -> SDBody a Signal+pv_phaseShift270 = makeUGen+   "PV_PhaseShift270" KR+   (Vs::Vs '["buf"])+   NoDefaults++pv_phaseShift90 :: (Args '["buf"] '[] a) => a -> SDBody a Signal+pv_phaseShift90 = makeUGen+   "PV_PhaseShift90" KR+   (Vs::Vs '["buf"])+   NoDefaults++pv_randComb :: (Args '["buf"] '["wipe", "trigger"] a) => a -> SDBody a Signal+pv_randComb = makeUGen+   "PV_RandComb" KR+   (Vs::Vs '["buf", "wipe", "trigger"])+   (wipe_ (0::Float), trigger_ (0::Float))++--- pv_randWipe ::+--- pv_randWipe =++-- Possibly "numTeeth" should be required:+-- | "Alternates blocks of bins between the two inputs."+pv_rectComb :: (Args '["buf"] '["numTeeth", "phase", "width"] a) => a -> SDBody a Signal+pv_rectComb = makeUGen+   "PV_RandComb" KR+   (Vs::Vs '["buf", "numTeeth", "phase", "width"])+   (numTeeth_ (0::Float), phase_ (0::Float), width_ (0.5::Float))++-- Possibly "numTeeth" should be required:+--- pv_rectComb2 ::+--- pv_rectComb2 =
+ Vivid/UGens/Filters.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Filters (+     module Vivid.UGens.Filters.BEQSuite+   , module Vivid.UGens.Filters.Linear+   , module Vivid.UGens.Filters.Nonlinear+   , module Vivid.UGens.Filters.Pitch++---   , lagUD+---   , lag2UD+---   , lag3UD+   , moogFF+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++import Vivid.UGens.Filters.BEQSuite+import Vivid.UGens.Filters.Linear+import Vivid.UGens.Filters.Nonlinear+import Vivid.UGens.Filters.Pitch++--- lagUD ::+--- lagUD =+--- lag2UD ::+--- lag2UD =+--- lag3UD ::+--- lag3UD =++moogFF :: (Args '["in"] '["freq", "gain", "reset"] a) => a -> SDBody a Signal+moogFF = makeUGen+   "MoogFF" AR+   (Vs::Vs '["in", "freq", "gain", "reset"])+   (freq_ (100::Float), gain_ (2::Float), reset_ (0::Float))
+ Vivid/UGens/Filters/BEQSuite.hs view
@@ -0,0 +1,121 @@+-- | These UGens only run at audio rate ('AR')+-- +--   They also can cause CPU spikes when their parameters are changed++{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Filters.BEQSuite (+     bAllpass+   , bBandPass+   , bBandStop+   , bHiPass+---   , bHiPass4+   , bHiShelf+   , bLowPass+   , bLowPass4+   , bLowShelf+   , bPeakEQ+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++import Vivid.UGens.Algebraic+import Vivid.UGens.Filters.Linear (sos)+import Vivid.UGens.Info (sampleRate, sampleDur)++-- import qualified Data.List as L+-- import Data.Maybe+import Data.Proxy++bAllpass :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal+bAllpass = makeUGen+   "BAllPass" AR+   (Vs::Vs '["in", "freq", "rq"])+   (freq_ (1200::Float), rq_ (1::Float))++-- | Band-pass filter+bBandPass :: (Args '["in"] '["freq", "bw"] a) => a -> SDBody a Signal+bBandPass = makeUGen+   "BBandPass" AR+   (Vs::Vs '["in", "freq", "bw"])+   (freq_ (1200::Float), bw_ (1::Float))++bBandStop :: (Args '["in"] '["freq", "bw"] a) => a -> SDBody a Signal+bBandStop = makeUGen+   "BBandStop" AR+   (Vs::Vs '["in", "freq", "bw"])+   (freq_ (1200::Float), bw_ (1::Float))++-- | Can cause CPU spikes+-- +--   This is only in AR+bHiPass :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal+bHiPass = makeUGen+   "BHiPass" AR+   (Vs::Vs '["in", "freq", "rq"])+   (freq_ (1200::Float), rq_ (1::Float))++-- bHiPass4 :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal+--- bHiPass4 ::+--- bHiPass4 =++bHiShelf :: (Args '["in"] '["freq", "rs", "db"] a) => a -> SDBody a Signal+bHiShelf = makeUGen+   "BHiShelf" AR+   (Vs::Vs '["in", "freq", "rs", "db"])+   (freq_ (1200::Float), rs_ (1::Float), db_ (0::Float))++bLowPass :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal+bLowPass = makeUGen+   "BLowPass" AR+   (Vs::Vs '["in", "freq", "rq"])+   (freq_ (1200::Float), rq_ (1::Float))++-- Checked this w/ 2 different inputs:+bLowPass4 :: (Args '["in"] '["freq","rq"] a) => a -> SDBody a Signal+bLowPass4 as = do+   freq <- uaArgValWDefault (1200::Float) as (Proxy::Proxy "freq")+   rq <- uaArgValWDefault (1::Float) as (Proxy::Proxy "rq")+   in' <- as `uaArgVal` (Proxy::Proxy "in")++   -- We don't actually use 'sRate' -- why?:+   _sRate <- sampleRate+   sDur <- sampleDur+   four <- (Constant $ 2*pi)~*sDur~*freq+   five <- uOp Cos four+   six <- {- 1 ~- five -} (Constant 1) ~- five+   seven <- six ~* (Constant 0.5)+   eight <- five ~* (Constant 2)+   nine <- uOp Sin four+   ten <- nine ~* (Constant 0.5)+   eleven <- ten ~* uOp Sqrt rq+   twelve <- Constant 1 ~+ eleven+   thirteen <- uOp Recip twelve+   fourteen <- seven ~* thirteen+   fifteen <- six ~* thirteen+   sixteen <- eight ~* thirteen+   seventeen <- uOp Neg thirteen+   eighteen <- Constant 1 ~- eleven+   nineteen <- eighteen ~* seventeen+   twenty <- sos (in_ in', a0_ fourteen, a1_ fifteen, a2_ fourteen, b1_ sixteen, b2_ nineteen)+   twentyOne <- sos (in_ twenty, a0_ fourteen, a1_ fifteen, a2_ fourteen, b1_ sixteen, b2_ nineteen)+   return twentyOne++bLowShelf :: (Args '["in"] '["freq", "rs", "db"] a) => a -> SDBody a Signal+bLowShelf = makeUGen+   "BLowShelf" AR+   (Vs::Vs '["in", "freq", "rs", "db"])+   (freq_ (1200::Float), rs_ (1::Float), db_ (0::Float))+++bPeakEQ :: (Args '["in"] '["freq", "rq", "db"] a) => a -> SDBody a Signal+bPeakEQ = makeUGen+   "BPeakEQ" AR+   (Vs::Vs '["in", "freq", "rq", "db"])+   (freq_ (1200::Float), rq_ (1::Float), db_ (0::Float))
+ Vivid/UGens/Filters/Linear.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Filters.Linear (+     apf+   , bpf+   , bpz2+   , brf+   , brz2+---   , changed+   , decay+   , decay2+---   , dynKlank+   , fos+   , formlet+   , hpf+   , hpz1+   , hpz2+   , integrator+---   , klank+   , lag+   , lag2+   , lag3+   , leakDC+   , lpf+   , lpz1+   , lpz2+   , midEQ+   , onePole+   , oneZero+   , rhpf+   , rlpf+   , ramp+   , resonz+   , ringz+   , sos+   , slope+   , twoPole+   , twoZero+---   , varLag+   ) where++-- import Vivid.OSC+import Vivid.SynthDef+import Vivid.UGens.Args+import Vivid.SynthDef.FromUA++import Data.Proxy++-- import Data.ByteString (ByteString)++apf :: (Args '["in"] '["freq", "radius"] a) => a -> SDBody a Signal+apf = makeUGen+   "APF" AR+   (Vs::Vs '["in", "freq", "radius"])+   (freq_ (440::Float), radius_ (0.8::Float))++-- | Band-pass filter+-- +--   Rq: bandwidth / cutofffreq+bpf :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal+bpf = makeUGen+   "BPF" AR+   (Vs::Vs '["in", "freq", "rq"])+   (freq_ (440::Float), rq_ (1::Float))++bpz2 :: (Args '["in"] '[] a) => a -> SDBody a Signal+bpz2 = makeUGen+   "BPZ2" AR+   (Vs::Vs '["in"])+   NoDefaults++brf :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal+brf = makeUGen+   "BRF" AR+   (Vs::Vs '["in", "freq", "rq"])+   (freq_ (440::Float), rq_ (1::Float))++brz2 :: (Args '["in"] '[] a) => a -> SDBody a Signal+brz2 = makeUGen+   "BRZ2" AR+   (Vs::Vs '["in"])+   NoDefaults++--- changed ::+--- changed =++decay :: (Args '["in"] '["decaySecs"] a) => a -> SDBody a Signal+decay = makeUGen+   "Decay" AR+   (Vs::Vs '["in", "decaySecs"])+   (decayTime_ (1::Float))++decay2 :: (Args '["in"] '["attackSecs", "decaySecs"] a) => a -> SDBody a Signal+decay2 = makeUGen+   "Decay2" AR+   (Vs::Vs '["in", "attackSecs", "decaySecs"])+   (attackTime_ (0.01::Float), decayTime_ (1::Float))++--- dynKlank ::+--- dynKlank =++fos :: (Args '["in"] '["a0", "a1", "b1"] a) => a -> SDBody a Signal+fos = makeUGen+   "FOS" AR+   (Vs::Vs '["in", "a0", "a1", "b1"])+   (a0_ (0::Float), a1_ (0::Float), b1_ (0::Float))++formlet :: (Args '["in"] '["freq", "attackSecs", "decaySecs"] a) => a -> SDBody a Signal+formlet = makeUGen+   "Formlet" AR+   (Vs::Vs '["in", "freq", "attackSecs", "decaySecs"])+   (freq_ (440::Float), attackTime_ (1::Float), decayTime_ (1::Float))++-- | High-pass filter+hpf :: (Args '["in"] '["freq"] a) => a -> SDBody a Signal+hpf = passFilter "HPF"++hpz1 :: (Args '["in"] '[] a) => a -> SDBody a Signal+hpz1 = makeUGen+   "HPZ1" AR+   (Vs::Vs '["in"])+   NoDefaults++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 = makeUGen+   "Integrator" AR+   (Vs::Vs '["in", "coef"])+   (coef_ (1::Float))++--- klank ::+--- klank =++-- | 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 as = do+   makeThing =<< getCalcRate =<< uaArgVal as (Proxy::Proxy "in")+ where+   makeThing calcRate = (flip ($)) as $ makeUGen+      "Lag" calcRate+      (Vs::Vs '["in", "lagSecs"])+      (lagTime_ (0.1::Float))++-- | 'lag2 (in_ x)' is equal to 'lag (in_ (lag (in_ x)))'+--+--   The calculation rate of this is whatever its \"in\" is+lag2 :: (Args '["in"] '["lagSecs"] a) => a -> SDBody a Signal+lag2 as =+   makeThing =<< getCalcRate =<< uaArgVal as (Proxy::Proxy "in")+ where+   makeThing calcRate = (flip ($)) as $ makeUGen+      "Lag2" calcRate+      (Vs::Vs '["in", "lagSecs"])+      (lagTime_ (0.1::Float))++-- | 'lag3 (in_ x)' is equal to 'lag (in_ $ lag (in_ $ lag (in_ x)))'+--+--   The calculation rate of this is whatever its \"in\" is+lag3 :: (Args '["in"] '["lagSecs"] a) => a -> SDBody a Signal+lag3 as =+   makeThing =<< getCalcRate =<< uaArgVal as (Proxy::Proxy "in")+ where+   makeThing calcRate = (flip ($)) as $ makeUGen+      "Lag3" calcRate+      (Vs::Vs '["in", "lagSecs"])+      (lagTime_ (0.1::Float))++-- | Note the default for both AR and KR are the same: 0.995. In SC lang, the KR+--   one defaults to 0.9.+leakDC :: (Args '["in"] '["coef"] a) => a -> SDBody a Signal+leakDC = makeUGen+   "LeakDC" AR+   (Vs::Vs '["in", "coef"])+   (coef_ (0.995::Float))++-- also look at RLPF:+-- | Low-pass filter+lpf :: (Args '["in"] '["freq"] a) => a -> SDBody a Signal+lpf = passFilter "LPF"++lpz1 :: (Args '["in"] '[] a) => a -> SDBody a Signal+lpz1 = makeUGen+   "LPZ1" AR+   (Vs::Vs '["in"])+   NoDefaults++lpz2 :: (Args '["in"] '[] a) => a -> SDBody a Signal+lpz2 = makeUGen+   "LPZ2" AR+   (Vs::Vs '["in"])+   NoDefaults++-- | 'Db' is the boost or attenuation of the signal in decibels+midEQ :: (Args '["in", "freq", "db"] '["rq"] a) => a -> SDBody a Signal+midEQ = makeUGen+   "MidEQ" AR+   (Vs::Vs '["in", "freq", "rq", "db"])+   (rq_ (1::Float))++passFilter :: (Args '["in"] '["freq"] a) => String -> a -> SDBody a Signal+passFilter filterName = makeUGen+   filterName AR+   (Vs::Vs '["in", "freq"])+   (freq_ (440::Float))++onePole :: (Args '["in"] '["coef"] a) => a -> SDBody a Signal+onePole = makeUGen+   "OnePole" AR+   (Vs::Vs '["in", "coef"])+   (coef_ (0.5::Float))++oneZero :: (Args '["in"] '["coef"] a) => a -> SDBody a Signal+oneZero = makeUGen+   "OneZero" AR+   (Vs::Vs '["in", "coef"])+   (coef_ (0.5::Float))++rhpf :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal+rhpf = makeUGen+   "RHPF" AR+   (Vs::Vs '["in", "freq", "rq"])+   (freq_ (440::Float), rq_ (1::Float))++rlpf :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal+rlpf = makeUGen+   "RLPF" AR+   (Vs::Vs '["in", "freq", "rq"])+   (freq_ (440::Float), rq_ (1::Float))++ramp :: (Args '["in"] '["lagSecs"] a) => a -> SDBody a Signal+ramp = makeUGen+   "Ramp" AR+   (Vs::Vs '["in", "lagSecs"])+   (lagTime_ (0.1::Float))++resonz :: (Args '["in"] '["freq", "bwr"] a) => a -> SDBody a Signal+resonz = makeUGen+   "Resonz" AR+   (Vs::Vs '["in", "freq", "bwr"])+   (freq_ (440::Float), bwr_ (1::Float))++ringz :: (Args '["in"] '["freq", "decaySecs"] a) => a -> SDBody a Signal+ringz = makeUGen+   "Ringz" AR+   (Vs::Vs '["in", "freq", "decaySecs"])+   (freq_ (440::Float), decaySecs_ (1::Float))++slope :: (Args '["in"] '[] a) => a -> SDBody a Signal+slope = makeUGen+   "Slope" AR+   (Vs::Vs '["in"])+   NoDefaults++sos :: (Args '["in"] '["a0", "a1", "a2", "b1", "b2"] a) => a -> SDBody a Signal+sos = makeUGen+   "SOS" AR+   (Vs::Vs '["in", "a0", "a1", "a2", "b1", "b2"])+   (a0_ (0::Float), a1_ (0::Float), a2_ (0::Float), b1_ (0::Float), b2_ (0::Float))++twoPole :: (Args '["in"] '["freq", "radius"] a) => a -> SDBody a Signal+twoPole = makeUGen+   "TwoPole" AR+   (Vs::Vs '["in", "freq", "radius"])+   (freq_ (440::Float), radius_ (0.8::Float))++twoZero :: (Args '["in"] '["freq", "radius"] a) => a -> SDBody a Signal+twoZero = makeUGen+   "TwoZero" AR+   (Vs::Vs '["in", "freq", "radius"])+   (freq_ (440::Float), radius_ (0.8::Float))++--- varLag ::+--- varLag =
+ Vivid/UGens/Filters/Nonlinear.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Filters.Nonlinear (+     ball+     -- In Vivid.UGens.Filters.Pitch:+   -- , freqShift+   , hasher+---   , hilbert+---   , hilbertFIR+   , mantissaMask+   , median+   , slew+   , spring+   , tBall+   ) where++import Vivid.SynthDef (CalculationRate(AR), {- SDBody, -} Signal)+import Vivid.UGens.Args+import Vivid.SynthDef.FromUA+import Vivid.SynthDef.TypesafeArgs++ball :: (Args '["in"] '["g", "damp", "friction"] a) => a -> SDBody a Signal+ball = makeUGen+   "Ball" AR+   (Vs::Vs '["in", "g", "damp", "friction"])+   (g_ (1::Float), damp_ (0::Float), friction_ (0.01::Float))++hasher :: (Args '["in"] '[] a) => a -> SDBody a Signal+hasher = makeUGen+   "Hasher" AR+   (Vs::Vs '["in"])+   NoDefaults++-- returns 2 channels -- also only has an AR instance+--- hilbert ::+--- hilbert =+--see "hilbert":+--- hilbertFIR ::+--- hilbertFIR =++mantissaMask :: (Args '["in"] '["bits"] a) => a -> SDBody a Signal+mantissaMask = makeUGen+   "MantissaMask" AR+   (Vs::Vs '["in", "bits"])+   (bits_ (3::Float))++median :: (Args '["in"] '["length"] a) => a -> SDBody a Signal+median = makeUGen+   "Median" AR+   (Vs::Vs '["length", "in"])+   (length_ (3::Float))++slew :: (Args '["in"] '["up", "dn"] a) => a -> SDBody a Signal+slew = makeUGen+   "Slew" AR+   (Vs::Vs '["in", "up", "dn"])+   (up_ (1::Float), dn_ (1::Float))++spring :: (Args '["in"] '["spring", "damp"] a) => a -> SDBody a Signal+spring = makeUGen+   "Spring" AR+   (Vs::Vs '["in", "spring", "damp"])+   (spring_ (1::Float), damp_ (0::Float))++tBall :: (Args '["in"] '["g", "damp", "friction"] a) => a -> SDBody a Signal+tBall = makeUGen+   "TBall" AR+   (Vs::Vs '["in", "g", "damp", "friction"])+   (g_ (10::Float), damp_ (0::Float), friction_ (0.01::Float))
+ Vivid/UGens/Filters/Pitch.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Filters.Pitch (+     freqShift+   , pitchShift+   , vibrato+   ) where++import Vivid.SynthDef+import Vivid.UGens.Args+import Vivid.SynthDef.FromUA++-- | \"Moves all the components of a signal by a fixed amount but does not preserve the original harmonic relationships.\" You might want 'Vivid.UGens.Filters.Pitch.pitchShift' instead.+freqShift :: (Args '["in"] '["freq", "phase"] a) => a -> SDBody a Signal+freqShift = makeUGen+   "FreqShift" AR+   (Vs::Vs '["in", "freq", "phase"])+   (freq_ (0::Float), phase_ (0::Float))++        {-+pitchShift :: In a -> Ratio a -> SDBody a Signal+pitchShift (In inp) (Ratio ratio) = do+   in' <- toSigM inp+   ratio' <- toSigM ratio+   addUGen $ UGen (UGName_S "PitchShift") AR [in', {- windowSize: -} Constant 0.2, ratio', {-pitchDispersion -} Constant 0, {- timeDispersion -} Constant 0] 1+-}++pitchShift :: (Args '["in", "ratio"] '["windowSize", "pitchDispersion", "timeDispersion"] a) => a -> SDBody a Signal+pitchShift = makeUGen+   "PitchShift" AR+   (Vs::Vs '["in", "windowSize", "ratio", "pitchDispersion", "timeDispersion"])+   (windowSize_ (0.2::Float), pitchDispersion_ (0::Float), timeDispersion_ (0::Float))++vibrato :: (Args '[] '["freq", "rate", "depth", "delaySecs", "onset", "rateVariation", "depthVariation", "iphase"] a) => a -> SDBody a Signal+vibrato = makeUGen+   "Vibrato" AR+   (Vs::Vs '["freq", "rate", "depth", "delaySecs", "onset", "rateVariation", "depthVariation", "iphase"])+   (freq_ (440::Float), rate_ (6::Float), depth_ (0.02::Float), delay_ (0::Float), onset_ (0::Float), rateVariation_ (0.04::Float), depthVariation_ (0.1::Float), iphase_ (0::Float))
+ Vivid/UGens/Generators/Chaotic.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Generators.Chaotic (+     cuspL+   , cuspN+---   , fbSineC+---   , fbSineL+---   , fbSineN+---   , gbmanL+---   , gbmanN+---   , henonC+---   , henonL+---   , henonN+---   , latoocarfianC+---   , latoocarfianL+---   , latoocarfianN+   , linCongC+   , linCongL+   , linCongN+---   , logistic+---   , lorenzL+---   , quadC+---   , quadL+---   , quadN+---   , sinOscFB+---   , standardL+---   , standardN+   ) where++import Vivid.UGens.Args+import Vivid.SynthDef+import Vivid.SynthDef.FromUA++-- | "A linear-interpolating sound generator based on the difference equation:+-- +--   x[n+1] = a - b * sqrt(abs(x[n]))"+-- +--   Only has an AR instance+cuspL :: (Args '[] '["freq", "a", "b", "xi"] a) => a -> SDBody a Signal+cuspL = makeUGen+   "CuspL" AR+   (Vs::Vs '["freq", "a", "b", "xi"])+   (freq_ (22050::Float), a_ (1::Float), b_ (1.9::Float), xi_ (0::Float))++-- | "A non-interpolating sound generator based on the difference equation:+-- +--    x[n+1] = a - b * sqrt(abs(x[n]))"+-- +--    Only has an AR instance.+cuspN :: (Args '[] '["freq", "a", "b", "xi"] a) => a -> SDBody a Signal+cuspN = makeUGen+   "CuspN" AR+   (Vs::Vs '["freq", "a", "b", "xi"])+   (freq_ (22050::Float), a_ (1::Float), b_ (1.9::Float), xi_ (0::Float))++--- fbSineC ::+--- fbSineC =+--- fbSineL ::+--- fbSineL =+--- fbSineN ::+--- fbSineN =+--- gbmanL ::+--- gbmanL =+--- gbmanN ::+--- gbmanN =+--- henonC ::+--- henonC =+--- henonL ::+--- henonL =+--- henonN ::+--- henonN =+--- latoocarfianC ::+--- latoocarfianC =+--- latoocarfianL ::+--- latoocarfianL =+--- latoocarfianN ::+--- latoocarfianN =++-- | "A cubic-interpolating sound generator based on the difference equation:+-- +--   x[n+1] = (a * x[n] + c) % m+-- +--   The output signal is automatically scaled to a range of [-1, 1]."+--  +--   Only has a "AR" method+linCongC :: (Args '[] '["freq", "a", "c", "m", "xi"] a) => a -> SDBody a Signal+linCongC = makeUGen+   "LinCongC" AR+   (Vs::Vs '["freq", "a", "c", "m", "xi"])+   (freq_ (22050::Float), a_ (1.1::Float), c_ (0.13::Float), m_ (1::Float), xi_ (0::Float))++-- | "A linear-interpolating sound generator based on the difference equation:+-- +--   x[n+1] = (a * x[n] + c) % m+-- +--   The output signal is automatically scaled to a range of [-1, 1]."+-- +--   Only has a "AR" method+linCongL :: (Args '[] '["freq", "a", "c", "m", "xi"] a) => a -> SDBody a Signal+linCongL = makeUGen+   "LinCongL" AR+   (Vs::Vs '["freq", "a", "c", "m", "xi"])+   (freq_ (22050::Float), a_ (1.1::Float), c_ (0.13::Float), m_ (1::Float), xi_ (0::Float))++-- | "A non-interpolating sound generator based on the difference equation:+-- +--   x[n+1] = (a * x[n] + c) % m+-- +--   The output signal is automatically scaled to a range of [-1, 1]."+-- +--   Only has a "AR" method+linCongN :: (Args '[] '["freq", "a", "c", "m", "xi"] a) => a -> SDBody a Signal+linCongN = makeUGen+   "LinCongN" AR+   (Vs::Vs '["freq", "a", "c", "m", "xi"])+   (freq_ (22050::Float), a_ (1.1::Float), c_ (0.13::Float), m_ (1::Float), xi_ (0::Float))++--- logistic ::+--- logistic =+--- lorenzL ::+--- lorenzL =+--- quadC ::+--- quadC =+--- quadL ::+--- quadL =+--- quadN ::+--- quadN =+--- sinOscFB ::+--- sinOscFB =+--- standardL ::+--- standardL =+--- standardN ::+--- standardN =
+ Vivid/UGens/Generators/Deterministic.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Generators.Deterministic (+---     blip+---   , cosc+---   , dynKlang+     -- In Vivid.UGens.Filters:+   -- , dynKlank+     fSinOsc+---   , formant+   , impulse+---   , klang+     -- In Vivid.UGens.Filters:+   -- , klank+   , lfCub+   , lfGauss+   , lfPar+   , lfPulse+   , lfSaw+   , lfTri+---   , osc+---   , oscN+---   , pmOSC+---   , pSinGrain+   , pulse+   , saw+   , sinOsc+     -- In Vivid.UGens.Generators.Chaotic:+   -- , sinOscFB+   , syncSaw+   , varSaw+     -- In Vivid.UGens.Filters:+   -- , vibrato+---   , vOsc+---   , vOsc3+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++--- blip ::+--- blip =+--- cosc ::+--- cosc =+--- dynKlang ::+--- dynKlang =++fSinOsc :: (Args '["freq"] '["phase"] a) => a -> SDBody a Signal+fSinOsc = makeUGen+   "FSinOsc" AR+   (Vs::Vs '["freq", "phase"])+   (phase_ (0::Float))++--- formant ::+--- formant =++impulse :: (Args '["freq"] '["phase"] a) => a -> SDBody a Signal+impulse = makeUGen+   "Impulse" AR+   (Vs::Vs '["freq", "phase"])+   (phase_ (0::Float))++--- klang ::+--- klang =++lfCub :: (Args '["freq"] '["iphase"] a) => a -> SDBody a Signal+lfCub = makeUGen+   "LFCub" AR+   (Vs::Vs '["freq", "iphase"])+   (freq_ (440::Float))++lfGauss :: (Args '[] '["duration", "width", "iphase", "loop", "doneAction"] a) => a -> SDBody a Signal+lfGauss = makeUGen+   "LFGauss" AR+   (Vs::Vs '["duration", "width", "iphase", "loop", "doneAction"])+   (duration_ (1::Float), width_ (0.1::Float), iphase_ (0::Float), loop_ (1::Float), doneAction_ (0::Float))++lfPar :: (Args '["freq"] '["iphase"] a) => a -> SDBody a Signal+lfPar = makeUGen+   "LFPar" AR+   (Vs::Vs '["freq", "iphase"])+   (freq_ (440::Float))++lfPulse :: (Args '["freq"] '["iphase", "width"] a) => a -> SDBody a Signal+lfPulse = makeUGen+   "LFPulse" AR+   (Vs::Vs '["freq", "iphase", "width"])+   (iphase_ (0::Float), width_ (0.5::Float))++-- | \"A non-band-limited sawtooth oscillator. Output ranges from -1 to +1.\"+lfSaw :: (Args '["freq"] '["iphase"] a) => a -> SDBody a Signal+lfSaw = makeUGen+   "LFSaw" AR+   (Vs::Vs '["freq", "iphase"])+   (iphase_ (0::Float))++-- | \"A non-band-limited triangle oscillator. Output ranges from -1 to +1.\"+lfTri :: (Args '["freq"] '["iphase"] a) => a -> SDBody a Signal+lfTri = makeUGen+   "LFTri" AR+   (Vs::Vs '["freq", "iphase"])+   (iphase_ (0::Float))++--- osc ::+--- osc =+--- oscN ::+--- oscN =+--- pmOSC ::+--- pmOSC =+--- pSinGrain ::+--- pSinGrain =++pulse :: (Args '["freq"] '["width"] a) => a -> SDBody a Signal+pulse = makeUGen+   "Pulse" AR+   (Vs::Vs '["freq","width"])+   (width_ (0.5::Float))++saw :: (Args '["freq"] '[] a) => a -> SDBody a Signal+saw = makeUGen+   "Saw" AR+   (Vs::Vs '["freq"])+   NoDefaults++-- | Sine wave+sinOsc :: (Args '["freq"] '["phase"] a) => a -> SDBody a Signal+sinOsc = makeUGen+   "SinOsc" AR+   (Vs::Vs '["freq","phase"])+   (phase_ (0::Float))++syncSaw :: (Args '["syncFreq", "sawFreq"] '[] a) => a -> SDBody a Signal+syncSaw = makeUGen+   "SyncSaw" AR+   (Vs::Vs '["syncFreq", "sawFreq"])+   NoDefaults++-- | Width is "duty cycle from 0 to 1"+varSaw :: (Args '["freq"] '["iphase", "width"] a) => a -> SDBody a Signal+varSaw = makeUGen+   "VarSaw" AR+   (Vs::Vs '["freq", "iphase", "width"])+   (iphase_ (0::Float), width_ (0.5::Float))++--- vOsc ::+--- vOsc =+--- vOsc3 ::+--- vOsc3 =
+ Vivid/UGens/Generators/Granular.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Generators.Granular (+---     grainBuf+---   , grainFM+---   , grainIn+---   , grainSin+---   , tGrains+---   , warp1+   ) where++--- grainBuf ::+--- grainBuf =+--- grainFM ::+--- grainFM =+--- grainIn ::+--- grainIn =+--- grainSin ::+--- grainSin =+--- tGrains ::+--- tGrains =+--- warp1 ::+--- warp1 =
+ Vivid/UGens/Generators/SingleValue.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Generators.SingleValue (+     dc+   -- , silent+   ) where++import Vivid.SynthDef++import qualified Data.ByteString.Char8 as BS8 (pack)++-- | \"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++-- Not creating this because I don't want to clutter the namespace.+-- Just write "dc 0"!+{-+silent :: foo+silent =+-}
+ Vivid/UGens/Generators/Stochastic.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Generators.Stochastic (+     brownNoise+   , clipNoise+---   , coinGate+---   , crackle+   , dust+   , dust2+---   , gendy1+---   , gendy2+---   , gendy3+   , grayNoise+   , lfClipNoise+   , lfdClipNoise+   , lfdNoise0+   , lfdNoise1+   , lfdNoise3+   , lfNoise0+   , lfNoise1+   , lfNoise2+   , pinkNoise+---   , randID+---   , randSeed+     -- In Vivid.UGens.Filters.Pitch:+   -- , vibrato+   , whiteNoise+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++-- | \"Generates noise whose spectrum falls off in power by 6 dB per octave.\"+brownNoise :: SDBody' a Signal+brownNoise = addUGen $ UGen (UGName_S "BrownNoise") AR [] 1++-- | \"Generates noise whose values are either -1 or 1. This produces the maximum energy for the least peak to peak amplitude.\"+clipNoise :: SDBody' a Signal+clipNoise = addUGen $ UGen (UGName_S "ClipNoise") AR [] 1++--- coinGate ::+--- coinGate =+--- crackle ::+--- crackle =++-- | \"Generates random impulses from -1 to +1.\"+dust :: (Args '["density"] '[] a) => a -> SDBody a Signal+dust = makeUGen+   "Dust" AR+   (Vs::Vs '["density"])+   NoDefaults++-- | \"Generates random impulses from -1 to +1.\"+dust2 :: (Args '["density"] '[] a) => a -> SDBody a Signal+dust2 = makeUGen+   "Dust2" AR+   (Vs::Vs '["density"])+   NoDefaults++--- gendy1 ::+--- gendy1 =+--- gendy2 ::+--- gendy2 =+--- gendy3 ::+--- gendy3 =++-- | \"Generates noise which results from flipping random bits in a word. This type of noise has a high RMS level relative to its peak to peak level. The spectrum is emphasized towards lower frequencies.\"+grayNoise :: SDBody' a Signal+grayNoise = addUGen $ UGen (UGName_S "GrayNoise") AR [] 1++-- | E.g.+-- +--   > play $ 0.1 ~* lfClipNoise (freq_ $ xLine (start_ 1e3, end_ 1e4, secs_ 10))+lfClipNoise :: (Args '[] '["freq"] a) => a -> SDBody a Signal+lfClipNoise = makeUGen+   "LFClipNoise" AR+   (Vs::Vs '["freq"])+   (freq_ (500::Float))++-- | \"Like LFClipNoise, it generates the values -1 or +1 at a rate given by the freq argument, with two differences:+--      \" - no time quantization+--      \" - fast recovery from low freq values+--   \" If you don't need very high or very low freqs, or use fixed freqs, LFDClipNoise is more efficient."+lfdClipNoise :: (Args '[] '["freq"] a) => a -> SDBody a Signal+lfdClipNoise = makeUGen+   "LFDClipNoise" AR+   (Vs::Vs '["freq"])+   (freq_ (500::Float))++lfdNoise0 :: (Args '[] '["freq"] a) => a -> SDBody a Signal+lfdNoise0 = makeUGen+   "LFDNoise0" AR+   (Vs::Vs '["freq"])+   (freq_ (500::Float))++lfdNoise1 :: (Args '[] '["freq"] a) => a -> SDBody a Signal+lfdNoise1 = makeUGen+   "LFDNoise1" AR+   (Vs::Vs '["freq"])+   (freq_ (500::Float))++lfdNoise3 :: (Args '[] '["freq"] a) => a -> SDBody a Signal+lfdNoise3 = makeUGen+   "LFDNoise3" AR+   (Vs::Vs '["freq"])+   (freq_ (500::Float))++-- | Freq is \"approximate rate at which to generate random values\"+lfNoise0 :: (Args '[] '["freq"] a) => a -> SDBody a Signal+lfNoise0 = makeUGen+   "LFNoise0" AR+   (Vs::Vs '["freq"])+   (freq_ (500::Float))++-- | Freq is \"approximate rate at which to generate random values\"+lfNoise1 :: (Args '[] '["freq"] a) => a -> SDBody a Signal+lfNoise1 = makeUGen+   "LFNoise1" AR+   (Vs::Vs '["freq"])+   (freq_ (500::Float))++-- | Freq is \"approximate rate at which to generate random values\"+lfNoise2 :: (Args '[] '["freq"] a) => a -> SDBody a Signal+lfNoise2 = makeUGen+   "LFNoise2" AR+   (Vs::Vs '["freq"])+   (freq_ (500::Float))++-- | \"Generates noise whose spectrum falls off in power by 3 dB per octave. This gives equal power over the span of each octave. This version gives 8 octaves of pink noise.\"+pinkNoise :: SDBody' a Signal+pinkNoise = addUGen $ UGen (UGName_S "PinkNoise") AR [] 1++--- randID ::+--- randID =+--- randSeed ::+--- randSeed =++-- | \"Generates noise whose spectrum has equal power at all frequencies.\"+whiteNoise :: SDBody' a Signal+whiteNoise = addUGen $ UGen (UGName_S "WhiteNoise") AR [] 1
+ Vivid/UGens/InOut.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.InOut (+     -- This is deprecated in SC:+   --   audioIn+---     diskIn+---   , diskOut+---   , in__+     aIn+   , kIn+---   , inFeedback+---   , inTrig+---   , lagIn+---   , localIn+---   , localOut+---   , maxLocalBufs+---   , offsetOut+   , out+   , aOut+   , kOut+   , kOut_mono+---   , replaceOut++     -- These 2 have been deprecated in SC:+--    , sharedIn+--    , sharedOut++   , soundIn+---   , vDiskIn+---   , xOut+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Algebraic+import Vivid.UGens.Args++import Data.Proxy++aIn :: (Args '["bus"] '[] a) => a -> SDBody a Signal+aIn = makeUGen+   "In" AR+   (Vs::Vs '["bus"])+   NoDefaults++--- diskIn ::+--- diskIn =+--- diskOut ::+--- diskOut =+--- in__ ::+--- in__ =+--- inFeedback ::+--- inFeedback =+--- inTrig ::+--- inTrig =++kIn :: (Args '["bus"] '[] a) => a -> SDBody a Signal+kIn = makeUGen+   "In" KR+   (Vs::Vs '["bus"])+   NoDefaults++--- lagIn ::+--- lagIn =+--- localIn ::+--- localIn =+--- localOut ::+--- localOut =+--- maxLocalBufs ::+--- maxLocalBufs =+--- offsetOut ::+--- offsetOut =++out :: (ToSig i a, ToSig busNum a) => busNum -> [i] -> SDBody' a [Signal]+out = aOut++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++-- kIn ::+-- kIn =++--- replaceOut ::+--- replaceOut =+++-- | 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+   addUGen $ UGen (UGName_S "In") AR [inPos] 1+++--- vDiskIn ::+--- vDiskIn =++-- | "Send signal to a bus, crossfading with previous contents"+-- +--   +--- xOut ::+--- xOut =
+ Vivid/UGens/Info.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Info (+     checkBadValues+   , controlDur+   , controlRate+     -- In Vivid.UGens.Demand:+   -- , dpoll+   , numAudioBuses+   , numBuffers+   , numControlBuses+   , numInputBuses+   , numOutputBuses+   , numRunningSynths+   -- , poll+   , radiansPerSample+   , sampleDur+   , sampleRate+   , subsampleOffset+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++checkBadValues :: (Args '["in"] '["id", "post"] a) => a -> SDBody a Signal+checkBadValues = makeUGen+   "CheckBadValues" AR+   (Vs::Vs '["in", "id", "post"])+   (id_ (0::Float), post_ (2::Float))++-- | The (current) duration of a control block on the server in seconds+-- +--   Equal to @1 ~/ controlRate@+controlDur :: SDBody' a Signal+controlDur =+   addUGen $ UGen (UGName_S "ControlDur") IR [] 1++-- | The current control rate of the server+-- +--   Equal to @1 ~/ controlDur@+controlRate :: SDBody' a Signal+controlRate =+   addUGen $ UGen (UGName_S "ControlRate") IR [] 1++-- | The number of audio buses+numAudioBuses :: SDBody' a Signal+numAudioBuses =+   addUGen $ UGen (UGName_S "NumAudioBuses") IR [] 1++-- | The number of open buffers+numBuffers :: SDBody' a Signal+numBuffers =+   addUGen $ UGen (UGName_S "NumBuffers") IR [] 1++numControlBuses :: SDBody' a Signal+numControlBuses =+   addUGen $ UGen (UGName_S "NumControlBuses") IR [] 1++numInputBuses :: SDBody' a Signal+numInputBuses =+   addUGen $ UGen (UGName_S "NumInputBuses") IR [] 1++numOutputBuses :: SDBody' a Signal+numOutputBuses =+   addUGen $ UGen (UGName_S "NumOutputBuses") IR [] 1++numRunningSynths :: SDBody' a Signal+numRunningSynths =+   addUGen $ UGen (UGName_S "NumRunningSynths") IR [] 1++-- poll ::+-- poll =++radiansPerSample :: SDBody' a Signal+radiansPerSample =+   addUGen $ UGen (UGName_S "RadiansPerSample") IR [] 1++sampleDur :: SDBody' a Signal+sampleDur =+   addUGen $ UGen (UGName_S "SampleDur") IR [] 1++sampleRate :: SDBody' a Signal+sampleRate =+   addUGen $ UGen (UGName_S "SampleRate") IR [] 1++subsampleOffset :: SDBody' a Signal+subsampleOffset =+   addUGen $ UGen (UGName_S "SubsampleOffset") IR [] 1
+ Vivid/UGens/Maths.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+-- {-# LANGUAGE TypeFamilies #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Maths (+     clip+---   , fold -- rename cuz of haskell clashes!+   , inRange+--   , inRect+     -- In Vivid.UGens.Filters:+   -- , integrator+   , leastChange+   , linExp+---   , linLin+---   , modDif+   , mostChange+   , mulAdd+---   , runningMax+---   , runningMin+---   , runningSum+---   , schmidt+     -- In Vivid.UGens.Analysis:+   -- , slope+---   , wrap+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+-- import Vivid.UGens.Algebraic+import Vivid.UGens.Args++import qualified Data.ByteString.Char8 as BS8 (pack)+import Data.Proxy++-- | +--   **Note this has different behavior than 0.1!**+--   \"lo\" is not implied by+--   \"hi\".+-- +--   If you know you always want \"lo\" to be negative \"hi\" (like -1 to 1)+--   you can use @'biOp' 'Clip2'@+clip :: (Args '["in"] '["lo", "hi"] a) => a -> SDBody a Signal+clip = makeUGen+   "Clip" AR+   (Vs::Vs '["in","lo","hi"])+   (lo_ (0::Float), hi_ (1::Float))++--- fold ::+--- fold =++-- | Returns 1.0 if \"in\" is between \"lo\" and \"hi\" (including+--   equalling "lo" or "hi"). Else 0.0.+-- +--   Can be audio rate (AR), control rate (KR), or fixed (IR)+-- +--   Lo and hi default to 0 and 1+inRange :: (Args '["in"] '["lo", "hi"] a) => a -> SDBody a Signal+inRange = makeUGen+   "InRange" AR+   (Vs::Vs '["in", "lo", "hi"])+   (lo_ (0::Float), hi_ (1::Float))++--- -- inRect =++-- | Returns the value of whichever of the 2 signals is changing+--   least+-- +--   Its default calculation rate is the highest of its 2 inputs+leastChange :: (ToSig s0 as, ToSig s1 as) => s0 -> s1 -> SDBody' as Signal+leastChange = leastOrMostChange "LeastChange"++leastOrMostChange :: (ToSig s0 as, ToSig s1 as) => String -> s0 -> s1 -> SDBody' as Signal+leastOrMostChange sdName s0 s1 = do+   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++-- | "Converts a linear range of values to an exponential range of values."+-- +--   Args:+-- +--   * *in* -  The input signal to convert.+-- +--   * *srclo* - Lower limit of input range.+-- +--   * *srchi* - Upper limit of input range.+-- +--   * *dstlo* - Lower limit of output range.+-- +--   * *dsthi* - Upper limit of output range.+-- +--   **"The dstlo and dsthi arguments must be nonzero and have the same sign."**+-- +--   This will have the same calculation rate as its \"in\" argument+linExp :: Args '["in"] '["srclo", "srchi", "dstlo", "dsthi"] a => a -> SDBody a Signal+linExp as = do+   in' <- as `uaArgVal` (Proxy::Proxy "in")+   getCalcRate in' >>= \case+      AR -> successGraph AR+      KR -> successGraph KR+      _ -> error "linExp: 'in' value must be at AR/KR"+ where+   successGraph calcRate = (flip ($)) as $ makeUGen+      "LinExp" calcRate+      (Vs::Vs '["in", "srclo", "srchi", "dstlo", "dsthi"])+      (srclo_ (0::Float), srchi_ (1::Float), dstlo_ (1::Float), dsthi_ (2::Float))++-- linLin ::+-- linLin =++--- modDif ::+--- modDif =++-- | Opposite of 'leastChange'+mostChange :: (ToSig s0 as, ToSig s1 as) => s0 -> s1 -> SDBody' as Signal+mostChange = leastOrMostChange "MostChange"++mulAdd :: (Args '["in"] '["mul", "add"] a) => a -> SDBody a Signal+mulAdd = makeUGen+   "MulAdd" AR+   (Vs::Vs '["in", "mul", "add"])+   (mul_ (1::Float), add_ (0::Float))++--- runningMax ::+--- runningMax =+--- runningMin ::+--- runningMin =+--- runningSum ::+--- runningSum =+--- schmidt ::+--- schmidt =+--- wrap ::+--- wrap =
+ Vivid/UGens/Multichannel.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Multichannel (++     -- * Multichannel > Ambisonics++---     biPanB2+---   , decodeB2+---   , panB+---   , panB2+---   , rotate2++     -- * Multichannel > Panners++---   , balance2+---   , linPan2+     pan2+---   , pan4+---   , panAz+     -- See above:+   -- , rotate2+---   , splay+---   , splayAz+---   , splayZ++     -- * Multichannel > Select++---   , linSelectX+---   , linXFade2+   , select+---   , selectX+---   , selectXFocus+---   , xFade2++     -- * Multichannel+     +   , mix+---   , numChannels+   ) where++import Vivid.SynthDef+--import Vivid.SynthDef.FromUA+import Vivid.UGens.Algebraic+import Vivid.UGens.Args+import Vivid.SynthDef.FromUA++import Data.List.Split (chunksOf)++--- biPanB2 ::+--- biPanB2 =+--- decodeB2 ::+--- decodeB2 =+--- panB ::+--- panB =+--- panB2 ::+--- panB2 =+--- rotate2 ::+--- rotate2 =+--- balance2 ::+--- balance2 =+--- linPan2 ::+--- linPan2 =++-- | 'pos' is -1 to 1+-- +--   'level' is \"a control-rate level input\"+pan2 :: Args '["in","pos"] '["level"] a => a -> SDBody a [Signal]+pan2 = makePolyUGen+   2 "Pan2" AR+   (Vs::Vs '["in","pos","level"])+   (level_ (1::Float))++--- pan4 ::+--- pan4 =+--- panAz ::+--- panAz =+--- splay ::+--- splay =+--- splayAz ::+--- splayAz =+--- splayZ ::+--- splayZ =+--- linSelectX ::+--- linSelectX =+--- linXFade2 ::+--- linXFade2 =++select :: ToSig s as => s -> [SDBody' as Signal] -> SDBody' as Signal+select which array = do+   which' <- toSig which+   array' <- mapM toSig array+   addUGen $ UGen (UGName_S "Select") AR (which' : array') 1++--- selectX ::+--- selectX =+--- selectXFocus ::+--- selectXFocus =+--- xFade2 ::+--- 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 (~+)@+mix :: ToSig s a => [s] -> SDBody' a Signal+mix [] = error "empty mix"+mix [x] = toSig x+mix xs = mix =<< (mapM mix' . chunksOf 4) =<< mapM toSig xs+ where+   mix' :: [Signal] -> SDBody' a Signal+   mix' [] = error "something's broken"+   mix' [x] = return x+   mix' [a,b] = a ~+ b+   mix' ins@[_,_,_]   = addUGen $ UGen (UGName_S "Sum3") AR ins 1+   mix' ins@[_,_,_,_] = addUGen $ UGen (UGName_S "Sum4") AR ins 1+   mix' _ = error "that would be weird"++--- numChannels ::+--- numChannels =
+ Vivid/UGens/Random.hs view
@@ -0,0 +1,63 @@+-- | For if you want a SynthDef where each Synth instance has a new random number.+-- +--   Creates a random value between \"lo\" and \"hi\". The value never changes in+--   the synth.+-- +--   These compute at "IR"++{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Random (+      -- In Vivid.UGens.Demand:+   --   dshuf+   -- , dwrand+     expRand+     -- In Vivid.UGens.Filters:+   -- , hasher+---   , iRand+   , linRand+---   , nRand+   , rand+     -- In Vivid.UGens.Generators.Stochastic:+   -- , randID+   -- , randSeed+     -- in UGens.Triggers:+   -- , tChoose+   -- , tExpRand+   -- , tIRand+   -- , tRand+   -- , tWChoose+   -- , tWIndex+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++expRand :: (Args '[] '["lo","hi"] a) => a -> SDBody a Signal+expRand = makeUGen+   "ExpRand" IR+   (Vs::Vs '["lo", "hi"])+   (lo_ (0::Float), hi_ (1::Float))++--- iRand ::+--- iRand =++linRand :: (Args '[] '["lo","hi","minmax"] a) => a -> SDBody a Signal+linRand = makeUGen+   "LinRand" IR+   (Vs::Vs '["lo", "hi", "minmax"])+   (lo_ (0::Float), hi_ (1::Float), minmax_ (0::Float))++--- nRand ::+--- nRand =++rand :: (Args '[] '["lo","hi"] a) => a -> SDBody a Signal+rand = makeUGen+   "Rand" IR+   (Vs::Vs '["lo", "hi"])+   (lo_ (0::Float), hi_ (1::Float))
+ Vivid/UGens/Reverbs.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Reverbs (+     freeVerb+---   , freeVerb2+---   , gVerb+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++-- | \"mix\", \"room\", and \"damp\" params range from 0 to1+freeVerb :: (Args '["in"] '["mix", "room", "damp"] a) => a -> SDBody a Signal+freeVerb = makeUGen+   "FreeVerb" AR+   (Vs::Vs '["in", "mix", "room", "damp"])+   (mix_ (1/3::Float), room_ (0.5::Float), damp_ (0.5::Float))++--- freeVerb2 ::+--- freeVerb2 =++-- | there are known issues with this! look in scide:+--- gVerb ::+--- gVerb =
+ Vivid/UGens/SynthControl.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.SynthControl (+   -- Might not actually need these 2 directly:+---     control+---   , controlName++     -- In Vivid.UGens.Analysis:+   -- , detectSilence+---   , done+---   , free__+---   , freeSelf+---   , freeSelfWhenDone+---   , lagControl+---   , namedControl+---   , pause+---   , pauseSelf+---   , pauseSelfWhenDone+---   , trigControl+   ) where+++   -- Might not actually need these 2 directly:+--- control ::+--- control =+--- controlName ::+--- controlName =++--- done ::+--- done =+--- free__ ::+--- free__ =+--- freeSelf ::+--- freeSelf =+--- freeSelfWhenDone ::+--- freeSelfWhenDone =+--- lagControl ::+--- lagControl =+--- namedControl ::+--- namedControl =+--- pause ::+--- pause =+--- pauseSelf ::+--- pauseSelf =+--- pauseSelfWhenDone ::+--- pauseSelfWhenDone =+--- trigControl ::+--- trigControl =
+ Vivid/UGens/Triggers.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Triggers (+     -- in UGens.Filters:+   --   changed+---     gate+     -- in UGens.InOut+   -- , inTrig+---   , lastValue+     latch+     -- In UGens.Buffer:+   -- , phasor+   , pulseCount+---   , pulseDivider+---   , sendReply+---   , sendTrig+---   , setResetFF+---   , stepper+---   , sweep+     -- in UGens.Conversions:+   -- , t2a+   -- , t2k+---   , tChoose+     -- In UGens.Delays:+   -- , tDelay+---   , tExpRand+---   , tIRand+---   , tRand+---   , tWChoose+---   , tWIndex+---   , timer+---   , toggleFF+---   , trig+---   , trig1+   ) where++import Vivid.SynthDef+import Vivid.SynthDef.FromUA+import Vivid.UGens.Args++--- gate ::+--- gate =+--- lastValue ::+--- lastValue =++latch :: (Args '["in", "trigger"] '[] a) => a -> SDBody a Signal+latch = makeUGen+   "Latch" AR+   (Vs::Vs '["in", "trigger"])+   NoDefaults++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 =+--- sendReply ::+--- sendReply =+--- sendTrig ::+--- sendTrig =+--- setResetFF ::+--- setResetFF =+--- stepper ::+--- stepper =+--- sweep ::+--- sweep =+--- tChoose ::+--- tChoose =+--- tExpRand ::+--- tExpRand =+--- tIRand ::+--- tIRand =+--- tRand ::+--- tRand =+--- tWChoose ::+--- tWChoose =+--- tWIndex ::+--- tWIndex =+--- timer ::+--- timer =+--- toggleFF ::+--- toggleFF =+--- trig ::+--- trig =+--- trig1 ::+--- trig1 =
+ Vivid/UGens/Undocumented.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.Undocumented (+---     audioControl+---   , blockSize+---   , inBus+---   , scopeOut2+---   , xIn+---   , xInFeedback+   ) where++--- audioControl ::+--- audioControl =+--- blockSize ::+--- blockSize =+--- inBus  ::+--- inBus =+--- scopeOut2 ::+--- scopeOut2 =+--- xIn ::+--- xIn =+--- xInFeedback ::+--- xInFeedback =
+ Vivid/UGens/UserInteraction.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DataKinds #-}+-- {-# LANGUAGE OverloadedStrings #-}+-- {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}++{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.UGens.UserInteraction (+---     keyState+---   , mouseButton+     mouseX+   , mouseY+   ) where++import Vivid.SynthDef+import Vivid.UGens.Args+import Vivid.SynthDef.FromUA++-- import Data.ByteString (ByteString)+++--- keyState ::+--- keyState =+--- mouseButton ::+--- mouseButton =++-- | Only runs at 'KR'+-- +--   Args:+--    - warp -- "Mapping curve. 0 is linear, 1 is exponential (e. g. for freq or times)"+--    - lag -- "Lag factor to dezpipper cursor movement"+mouseY :: Args '[] '["min","max","warp","lagSecs"] a => a -> SDBody a Signal+mouseY = mouseGeneral "MouseY"++-- | Only runs at 'KR'+-- +--   Args:+--    - warp -- "Mapping curve. 0 is linear, 1 is exponential (e. g. for freq or times)"+--    - lag -- "Lag factor to dezpipper cursor movement"+mouseX :: Args '[] '["min","max","warp","lagSecs"] a => a -> SDBody a Signal+mouseX = mouseGeneral "MouseX"++mouseGeneral :: Args '[] '["min","max","warp","lagSecs"] a => String -> a -> SDBody a Signal+mouseGeneral ugenName = makeUGen+   ugenName KR+   (Vs::Vs '["min", "max", "warp", "lagSecs"])+   (min_ (0::Float), max_ (1::Float), warp_ (0::Float), lagTime_ (0.2::Float))
vivid.cabal view
@@ -1,40 +1,239 @@--- Initial vivid.cabal generated by cabal init.  For further documentation,
---  see http://haskell.org/cabal/users-guide/
-
-name:                vivid
-version:             0.1.0.3
-x-revision: 1
-synopsis:            Sound synthesis with SuperCollider
-description:         Sound synthesis with SuperCollider. Start with Vivid.SynthDef
-author:              Tom Murphy
-maintainer:          Tom Murphy
-category:            Sound
-build-type:          Simple
-cabal-version:       >=1.8
-stability:           experimental
-license:             GPL
-
-library
-  exposed-modules:
-      Vivid
-    , Vivid.OSC
-    , Vivid.OSC.Util
-    , Vivid.SCServer
-    , Vivid.SynthDef
-    , Vivid.SynthDef.CrazyTypes
-    , Vivid.SynthDef.Literally
-    , Vivid.SynthDef.Types
-    , Vivid.UGens
-    , Vivid.UGens.Args
-  -- other-modules:       
-  build-depends:
-      base > 2 && <5
-    , binary
-    , bytestring
-    , containers
-    , deepseq
-    , hashable >= 1.2
-    , mtl
-    , network
-    , split
-    , stm
+name:                vivid+version:             0.2.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+    , 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