hsc3-0.20: Haskell SuperCollider
Safe HaskellSafe-Inferred
LanguageHaskell2010

Sound.Sc3.Ugen.Util

Description

Utility function over Ugen data structure.

Synopsis

Documentation

toUid :: ID a => a -> UgenId Source #

Uid of resolveID.

Ugen graph functions

ugenTraverse :: (Ugen -> Bool) -> (Ugen -> Ugen) -> Ugen -> Ugen Source #

Depth first traversal of graph at u, stopping at halt_f, else applying map_f to each node.

ugenFoldr :: (Ugen -> a -> a) -> a -> Ugen -> a Source #

Right fold of Ugen graph.

map Sound.Sc3.Ugen.PP.ugen_concise_pp $ ugenFoldr (:) [] (sinOsc ar 440 0 * 0.1)
map Sound.Sc3.Ugen.PP.ugen_concise_pp $ ugenFoldr (:) [] (pan2 (sinOsc ar 440 0) 0.25 0.1)

ugenCollectBrackets :: Ugen -> Brackets Source #

Fold over Ugen and collect all bracketing messages from all Primitive nodes.

ugenHasAnyBrackets :: Ugen -> Bool Source #

Are there any brackets at Ugen.

Unit generator node constructors

control_f64 :: Rate -> Maybe Int -> String -> Sample -> Ugen Source #

Control input node constructor.

control :: Rate -> String -> Double -> Ugen Source #

Control input node constructor.

Note that if the name begins with a t_ prefix the control is not converted to a triggered control. Please see trigControl.

control_m :: Rate -> String -> Double -> Control_Meta_T3 Double -> Ugen Source #

Variant of control with meta data.

control_pair :: Control_Group -> Rate -> String -> (Double, Double) -> Control_Meta_T3 Double -> (Ugen, Ugen) Source #

Generate group of two controls. Names are generated according to control_group_suffixes

control_rng :: Rate -> String -> (Double, Double) -> Control_Meta_T3 Double -> (Ugen, Ugen) Source #

Generate range controls. Names are generated according to control_group_suffixes

trigControl_f64 :: Maybe Int -> String -> Sample -> Ugen Source #

Triggered (kr) control input node constructor.

trigControl :: String -> Double -> Ugen Source #

Triggered (kr) control input node constructor.

control_set :: [Ugen] -> [Ugen] Source #

Set indices at a list of controls.

Multiple channel expansion

mce2 :: Ugen -> Ugen -> Ugen Source #

Multiple channel expansion for two inputs.

mce2c :: Ugen -> (Ugen, Ugen) Source #

Extract two channels from possible Mce, if there is only one channel it is duplicated.

unmce2 :: Ugen -> (Ugen, Ugen) Source #

Variant of mce2c that requires input to have two channels.

mce3 :: Ugen -> Ugen -> Ugen -> Ugen Source #

Multiple channel expansion for two inputs.

unmce3 :: Ugen -> (Ugen, Ugen, Ugen) Source #

Variant of mce2c that requires input to have two channels.

mceMap :: (Ugen -> Ugen) -> Ugen -> Ugen Source #

Apply a function to each channel at a unit generator.

map_ix :: ((Int, a) -> b) -> [a] -> [b] Source #

Map with element index.

mce_map_ix :: ((Int, Ugen) -> Ugen) -> Ugen -> Ugen Source #

Variant of mceMap with element index.

mceEdit :: ([Ugen] -> [Ugen]) -> Ugen -> Ugen Source #

Apply Ugen list operation on Mce contents.

mceReverse :: Ugen -> Ugen Source #

Reverse order of channels at Mce.

mceChannel :: Int -> Ugen -> Ugen Source #

Obtain indexed channel at Mce.

mceChannelWrap :: Int -> Ugen -> Ugen Source #

Obtain indexed channel at Mce, indicex wrap around.

map (\ix -> mceChannelWrap ix (mce [1,2,3,4,5])) [0 .. 9]

mceTranspose :: Ugen -> Ugen Source #

Transpose rows and columns, ie. {{a,b},{c,d}} to {{a,c},{b,d}}.

mceRotate :: Int -> Ugen -> Ugen Source #

Rotate mce k places to the right, ie. {a,b,c,d} to {d,a,b,c}

mceRotate 1 (mce [1,2,3,4]) == mce [4,1,2,3]

mceConcat :: [Ugen] -> Ugen Source #

concat at mce channels of each input, ie. {{a,b},{c,d}} to {a,b,c,d}.

mceConcat (map mce [[1,2],[3,4]]) == mce [1..4]

mceClump :: Int -> Ugen -> Ugen Source #

Collect subarrays of mce.

mceClump 2 (mce [1,2,3,4]) == mce2 (mce2 1 2) (mce2 3 4)

mceReduce :: (Ugen -> Ugen -> Ugen) -> Ugen -> Ugen Source #

Foldl1 at channels of mce.

mceProduct :: Ugen -> Ugen Source #

mceReduce of *.

Transform

halt_mce_transform_f :: (a -> [a]) -> [a] -> [a] Source #

Given unmce function make halt mce transform.

halt_mce_transform :: [Ugen] -> [Ugen] Source #

The halt Mce transform, ie. lift channels of last input into list. This is not used by hsc3, but it is used by hsc3-forth and stsc3.

halt_mce_transform [1,2,mce2 3 4] == [1,2,3,4]

prepare_root :: Ugen -> Ugen Source #

If the root node of a Ugen graph is mce, transform to mrg.

Multiple root graphs

mrg2 :: Ugen -> Ugen -> Ugen Source #

Multiple root graph node constructor (left input is output)

Labels

label :: String -> Ugen Source #

Lift a String to a Ugen label (ie. for poll).

unpackLabel :: Bool -> Ugen -> [Ugen] Source #

Unpack a label to a length prefixed list of Constants. There is a special case for mce nodes, but it requires labels to be equal length. Properly, poll would not unpack the label, it would be done by the synthdef builder.

unpackLabel False (label "/tmp")

Envelope

Bitwise

(.<<.) :: Ugen -> Ugen -> Ugen Source #

shiftLeft operator.

(.>>.) :: Ugen -> Ugen -> Ugen Source #

shiftRight operator.

Rate Flow

rewriteUgenRates :: (Rate -> Bool) -> Rate -> Ugen -> Ugen Source #

Traverse graph rewriting audio rate nodes as control rate.

rewriteToControlRate :: Ugen -> Ugen Source #

Traverse graph rewriting audio rate nodes as control rate.

rewriteToDemandRate :: Ugen -> Ugen Source #

Traverse graph rewriting all nodes as demand rate.

rewriteToInitialisationRate :: Ugen -> Ugen Source #

Traverse graph rewriting audio and control nodes as initialisation rate.

rewriteToRate :: Rate -> Ugen -> Ugen Source #

Select rewriting function given Rate.