packages feed

hsc3-lang (empty) → 0.7

raw patch · 46 files changed

+1682/−0 lines, 46 filesdep +arraydep +basedep +containerssetup-changed

Dependencies added: array, base, containers, random

Files

+ Help/Collection/collection.help.lhs view
@@ -0,0 +1,44 @@+* Lists of numbers are numerical, Extension++> import Sound.SC3.Lang.Collection++Pointwise operations in the supercollider +language extend the shorter input by+cycling.++That is, the expression:++| [1, 2] + [3, 4, 5]++is equivalent to:++| [1, 2, 1] + [3, 4, 5]++and so describes the three element +list [4, 6, 6].++The collection module provides list +instances for the standard haskell +numerical type classes with the same +extension behaviour, so that:++> [1, 2] + [3, 4, 5]++has the same value as in the supercollider+language, and as distinct from the value of:++> zipWith (+) [1, 2] [3, 4, 5]++which is the two element list [4, 6].++The function underlying the list numerical +instances is zipWith_c:++> zipWith_c (+) [1, 2] [3, 4, 5]++Since literals are interpreted as single+element lists, the expression:++> [1, 2, 3] * 4++denotes the list [4, 8, 12].
+ Help/Math/pitch.help.lhs view
@@ -0,0 +1,54 @@+* Pitch & record++> import Sound.SC3.Lang.Math++The supercollider language pitch model+is organised as a tree with three separate+layers, and is designed to allow separate+processes to manipulate aspects of the+model independently.++The haskell variant implements Pitch as+a labeled data type, with a default value+such that scale degree 5 is the a above+middle c.++> freq (defaultPitch { degree = 5 })++The note is given as a degree, with a modal+transposition, indexing a scale interpreted+relative to an equally tempered octave+divided into the indicated number of steps.++The midinote is derived from the note by+adding the inidicated root, octave and+gamut transpositions.++The frequency is derived by a chromatic+transposition of the midinote, with a+harmonic multiplier.++> let { p = defaultPitch+>     ; n = p { stepsPerOctave = 12+>             , scale = [0, 2, 4, 5, 7, 9, 11]+>             , degree = 0+>             , mtranspose = 5 }+>     ; m = n { root = 0+>             , octave = 5+>             , gtranspose = 0 }+>     ; f = m { ctranspose = 0+>             , harmonic = 1 } }+> in (note n, midinote m, freq f)++By editing the values of aspects of+a pitch, processes can cooperate. +Below one process controls the note+by editing the modal transposition,+a second edits the octave.++> let { edit_mtranspose p d = p { mtranspose = mtranspose p + d }+>     ; edit_octave p o = p { octave = octave p + o }+>     ; p = repeat defaultPitch+>     ; q = zipWith edit_mtranspose p [0, 2, 4, 3, 5]+>     ; r = zipWith edit_octave q [0, -1, 0, 1, 0] }+> in (map midinote q, map midinote r)
+ Help/Pattern/pattern.help.lhs view
@@ -0,0 +1,251 @@+> import Sound.SC3.Lang.Pattern++* Beginning++| One goal of separating the synthesis engine and+| the language in SC Server is to make it possible+| to explore implementing in other languages the+| concepts expressed in the SuperCollider language+| and class library.  (McCartney, 2000)++Patterns in supercollider language provide+a concise and expressive notation for writing+complex processes.++In a strict language the distinction between+data and process is quite clear.++In non-strict and purely functional languages+ordinary data types may be of indefinite extent.++> let ones = 1 : ones+> in take 5 ones++Since there is no mutation in haskell the+pattern and stream distinction is less +clear.++> let { a = [1,2,3] ++ a+>     ; b = drop 2 (fmap negate a) }+> in take 5 (zip a b)++However, as was noted in relation to the noise+and related unit generators, a notation for+describing indeterminate structures presents+some interesting questions.++* Patterns are abstract++The type of a pattern is abstract.++> data P a++(P a) is the abstract data type of a pattern +with elements of type a.++Patterns are constructed, manipulated and destructured +using the functions provided.++* Patterns are Monoids++> class Monoid a where+>   mempty :: a+>   mappend :: a -> a -> a++Patterns are instances of monoid.  mempty is the+empty pattern, and mappend makes a sequence of two+patterns.++> pempty :: P a+> pappend :: P a -> P a -> P a++* Patterns are Functors++> class Functor f+>     where fmap :: (a -> b) -> f a -> f b++Patterns are an instance of Functor.  fmap applies+a function to each element of a pattern.++> pmap :: (a -> b) -> P a -> P b++* Patterns are Applicative++> class (Functor f) => Applicative f where+>   pure :: a -> f a+>   (<*>) :: f (a -> b) -> f a -> f b++Patterns are instances of Applicative (McBride and+Paterson, 2007).  The pure function lifts a value+into an infinite pattern of itself.  The (<*>)+function applies a pattern of functions to a+pattern of values.++> ppure :: a -> P a+> papply :: P (a -> b) -> P a -> P b++Consider summing two patterns:++> import Control.Applicative++> let { p = pseq [1, 3, 5] 1+>     ; q = pseq [6, 4, 2] 1 }+> in evalP 0 (pure (+) <*> p <*> q)++* Patterns are Monads++> class Monad m where+>     (>>=) :: m a -> (a -> m b) -> m b+>     return :: a -> m a++Patterns are an instance of the Monad class+(Wadler, 1990).  The (>>=) function, pronounced+bind, is the mechanism for processing a monadic+value.  The return function places a value into+the monad, for the pattern case it creates a +single element pattern.++> pbind :: P x -> (x -> P a) -> P a+> preturn :: a -> P a++The monad instance for Patterns follows the+standard monad instance for lists, for example:++> evalP 0 (pseq [1, 2] 1 >>= \x ->+>          pseq [3, 4, 5] 1 >>= \y ->+>          return (x, y))++which may be written using the haskell do notation+as:++> evalP 0 (do { x <- pseq [1, 2] 1+>             ; y <- pseq [3, 4, 5] 1+>             ; return (x, y) })++denotes the pattern having elements (1,3), (1,4),+(1,5), (2,3), (2,4) and (2,5).++* Patterns are numerical++Patterns are instances of both Num:++> class (Eq a, Show a) => Num a where+>   (+) :: a -> a -> a+>   (*) :: a -> a -> a+>   (-) :: a -> a -> a+>   negate :: a -> a+>   abs :: a -> a+>   signum :: a -> a+>   fromInteger :: Integer -> a++and fractional:++> class (Num a) => Fractional a where+>   (/) :: a -> a -> a+>   recip :: a -> a+>   fromRational :: Rational -> a++Summing two patterns does not require using the+applicative notation above, and the numerical+pattern (return x) can be written as the literal+'x':++> let { p = pseq [1, 3, 5] 1+>     ; q = pseq [6, 4, 2] 1 }+> in evalP 0 (p + q)++The numerical instances are written using the +applicative functions pure and <*>.++* Intederminacy, Randomness++A pattern may be given by a function from+a random number generator to a duple of+a pattern and a derived random number +generator.++> prp :: (StdGen -> (P a, StdGen)) -> P a++pfix makes a pattern determinate by seeding +the random number generator for the pattern.++> type Seed = Int+> pfix :: Seed -> P a -> P a++* Accumulation, Threading++pscan is an accumulator.  It provides a mechanism+for state to be threaded through a pattern.  It can+be used to write a function to remove succesive+duplicates from a pattern, to count the distance+between occurences of an element in a pattern and+so on.++> pscan :: (x -> y -> (x, a)) -> (x -> a) -> x -> P y -> P a++* Continuing++pcontinue provides a mechanism to destructure a+pattern and generate a new pattern based on the+first element and the 'rest' of the pattern.++> pcontinue :: P x -> (x -> P x -> P a) -> P a++The bind instance of monad is written in relation+to pcontinue.++> pbind p f = pcontinue p (\x q -> f x `mappend` pbind q f)++pcontinue can be used to write pfilter the+basic pattern filter, ptail which discards+the front elment of a pattern, and so on.++* Destructuring, folding++A pattern has an ordinary right fold, with the+additional requirement of a seed value for the +random number generator.++> pfoldr :: Seed -> (a -> b -> b) -> b -> P a -> b++pfoldr is the primitive traversal function for+a pattern.  ++Right folding with the list constructor (:) and+the empty list transforms a pattern into a list.++> let p = pser [1, 2, 3] 5 + pseq [0, 10] 3+> in pfoldr 0 (:) [] p++* Extension++The haskell patterns follow the normal haskell+behavior when operating pointwise on sequences of+different length - the longer sequence is+truncated.++The haskell expression:++> zip [1, 2] [3, 4, 5]++describes a list of two elements, being (1, 3) and+(2, 4).++This differs from the ordinary supercollider+language behaviour, where the shorter sequence is+extended in a cycle, so that the expression:++| [[1, 2], [3, 4, 5]].flop++computes a list of three elements, [1, 3], [2, 4]+and [1, 5].++* References+++ C. McBride and R. Paterson.  Applicative+  Programming with Effects.  Journal of Functional+  Programming, 17(4), 2007.+++ P. Wadler.  Comprehending Monads.  In Conference+  on Lisp and Funcional Programming, Nice, France,+  June 1990. ACM.
+ Help/Pattern/pclutch.help.lhs view
@@ -0,0 +1,29 @@+pclutch :: (Num b, Ord b) => P a -> P b -> P a+pclutch' :: P a -> P Bool -> P a++ i - input+ c - clutch++Sample and hold a pattern.  For values greater than+zero in the control pattern, step the value pattern,+else hold the previous value. ++> import Sound.SC3.Lang.Pattern++> let { p = pseq [1, 2, 3, 4, 5] 3+>     ; q = pseq [1, 0, 1, 0, 0, 0, 1, 1] 1 }+> in evalP 0 (pclutch p q)++There is a variant that requires a boolean +pattern.  ++> let { p = pseq [1, 2, 3, 4, 5] 3+>     ; q = fmap not (pbool (pseq [0, 0, 1, 0, 0, 0, 1, 1] 1)) }+> in evalP 0 (pclutch' p q)++Note the initialization behavior, nothing+is generated until the first true value.++> let { p = pseq [1, 2, 3, 4, 5] 3+>     ; q = pseq [0, 0, 0, 1, 0, 0, 1] 1 }+> in evalP 0 (pclutch p q)
+ Help/Pattern/pcollect.help.lhs view
@@ -0,0 +1,9 @@+pcollect :: (a -> b) -> P a -> P b+pcollect = fmap++Patterns are functors.++> import Sound.SC3.Lang.Pattern++> let p = pcollect (* 3) (pseq [1, 2, 3] 3)+> in evalP 0 p
+ Help/Pattern/pcountpre.help.lhs view
@@ -0,0 +1,10 @@+pcountpre :: P Bool -> P Int+pcountpost :: P Bool -> P Int++> import Sound.SC3.Lang.Pattern++> let p = pbool (pseq [0, 0, 1, 0, 0, 0, 1, 1] 1)+> in evalP 0 (pcountpre p)++> let p = pbool (pseq [1, 0, 1, 0, 0, 0, 1, 1] 1)+> in evalP 0 (pcountpost p)
+ Help/Pattern/pdegreeToKey.help.lhs view
@@ -0,0 +1,26 @@+pdegreeToKey :: (RealFrac a) => P a -> P [a] -> P a -> P a++         degree - scale degree (zero based)+          scale - list of divisions (ie. [0, 2, 4, 5, 7, 9, 11])+ stepsPerOctave - division of octave (ie. 12)++Derive notes from an index into a scale.++> import Sound.SC3.Lang.Pattern++> let { p = pseq [0, 1, 2, 3, 4, 3, 2, 1, 0, 2, 4, 7, 4, 2] 2+>     ; q = prepeat [0, 2, 4, 5, 7, 9, 11]+>     ; r = prepeat 12 }+> in evalP 0 (pdegreeToKey p q r)++> let { p = pseq [0, 1, 2, 3, 4, 3, 2, 1, 0, 2, 4, 7, 4, 2] 2+>     ; q = pseq [preturn [0, 2, 4, 5, 7, 9, 11]+>                ,preturn [0, 2, 3, 5, 7, 8, 11]] 1+>     ; r = prepeat 12 }+> in evalP 0 (pdegreeToKey p (pstutter 14 q) r)++The degree_to_key function is also given.++> import Sound.SC3.Lang.Math++> map (\n -> degree_to_key n [0,2,4,5,7,9,11] 12) [0,2,4,7,4,2,0]
+ Help/Pattern/pdrop.help.lhs view
@@ -0,0 +1,8 @@+pdrop :: P Int -> P a -> P a++Drop first n element from pattern.++> import Sound.SC3.Lang.Pattern++> let p = pseq [1, 2, 3] 4+> in evalP 0 (pdrop 7 p)
+ Help/Pattern/pexprand.help.lhs view
@@ -0,0 +1,13 @@+pexprand :: (Floating a, Random a) => P a -> P a -> P Int -> P a++Exponential distribution distribution in given range.++> import Sound.SC3.Lang.Pattern++> let p = pexprand 0.01 0.99 12+> in evalP 0 p++> let { l = pseq [1, 11] 1+>     ; r = pseq [2, 12] 1+>     ; p = pexprand l r 12 }+> in evalP 0 p
+ Help/Pattern/pfilter.help.lhs view
@@ -0,0 +1,9 @@+pfilter :: (a -> Bool) -> P a -> P a++Allows values for which the predicate is true. ++> import Sound.SC3.Lang.Pattern++> let { p = pseq [1, 2, 3] 3+>     ; q = pfilter (< 3) p }+> in evalP 0 q
+ Help/Pattern/pfin.help.lhs view
@@ -0,0 +1,26 @@+pfin :: P Int -> P a -> P a+pfin_ :: Int -> P a -> P a+ptake :: P Int -> P a -> P a+ptake_ :: P Int -> P a -> P a++  n - number of elements to take+  x - value pattern++Take only the first n elements of the pattern +into the stream.++> import Sound.SC3.Lang.Pattern++> let p = pseq [1, 2, 3] pinf+> in evalP 0 (pfin 5 p)++There is a variant where the count not a pattern.++> let p = pseq [1, 2, 3] 1+> in evalP 0 (pfin_ 5 p)++Note that pfin does not extend the input pattern,+unlike pser.++> let p = pseq [1, 2, 3] 1+> in evalP 0 (pser [p] 5)
+ Help/Pattern/pgeom.help.lhs view
@@ -0,0 +1,17 @@+pgeom :: (Num a) => a -> a -> Int -> P a++Geometric series pattern.++  start - start value+   grow - multiplication factor+ length - number of values produced++> import Sound.SC3.Lang.Pattern++> let p = pgeom 1 2 12+> in evalP 0 p++Real numbers work as well.++> let p = pgeom 1.0 1.1 6+> in evalP 0 p
+ Help/Pattern/pif.help.lhs view
@@ -0,0 +1,41 @@+pif :: Int -> P Bool -> P a -> P a -> P a+pif' :: P Bool -> P a -> P a -> P a++Pattern-based conditional expression.++ condition - pattern of selectors+    iftrue - pattern selected from when condition is true+   iffalse - pattern selected from when condition is false++The primary form requires a seed to allow the +condition pattern to be fixed.  The variant form+provides a zero seed, and allows one to indicate+that the condition pattern is deterministic (or+that the seed is not important).++> import Sound.SC3.Lang.Pattern++A determinstic condition pattern, with deterministic+branches.++> let { c = pbool (pseq [1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0] 1)+>     ; p = pseq [1,2,3,4,5] pinf+>     ; q = pseq [11,12,13,14,15] pinf }+> in evalP 0 (pif' c p q)++A non-deterministic condition pattern, with+noisy branches.++> let { c = fmap (< 0.3) (pwhite 0 1 20)+>     ; p = pwhite 0 9 pinf+>     ; q = pwhite 100 109 pinf }+> in evalP 0 (pif 3 c p q)++Note that the noisy variant can be had for+less trouble as:++> let { c = fmap (< 0.3) (pwhite 0 1 20)+>     ; p = pwhite 0 9 pinf+>     ; q = pwhite 100 109 pinf +>     ; if_f c' p' q' = if c' then p' else q' }+> in evalP 0 (pzipWith3 if_f c p q)
+ Help/Pattern/pinterleave.help.lhs view
@@ -0,0 +1,13 @@+pinterleave :: P a -> P a -> P a++Interleave elements from two patterns.++> import Sound.SC3.Lang.Pattern++> let { p = pseq [1, 2, 3] 3+>     ; q = pseq [4, 5, 6, 7] 2 }+> in evalP 0 (pinterleave p q)++> let p = pinterleave (pwhite 1 9 5) (pseries 10 1 10)+> in evalP 1317 p+
+ Help/Pattern/pn.help.lhs view
@@ -0,0 +1,16 @@+pn :: P a -> P Int -> P a+preplicate :: P Int -> P a -> P a++Repeats the enclosed pattern a number of times.++> import Sound.SC3.Lang.Pattern++> let p = pn (pseq [1, 2, 3] 1) 4+> in evalP 0 p++There is a variant with the arguments+reversed.++> let p = preplicate 4 (pseq [1, 2, 3] 1)+> in evalP 0 p+
+ Help/Pattern/prand.help.lhs view
@@ -0,0 +1,19 @@+prand :: [P a] -> P Int -> P a++Returns one item from the list at random for each repeat. ++> import Sound.SC3.Lang++> let p = prand [1, 2, 3, 4, 5] 6+> in evalP 9 p++> let p = prand [ pseq [1, 2] 1+>               , pseq [3, 4] 1+>               , pseq [5, 6] 1 ] 9+> in evalP 3 p++> let p = pseq [prand [pempty, pseq [24, 31, 36, 43, 48, 55] 1] 1+>              ,pseq [60, prand [63, 65] 1+>                    ,67, prand [70, 72, 74] 1] (prrand 2 5)+>              ,prand [74, 75, 77, 79, 81] (prrand 3 9)] pinf+> in take 24 (evalP 7 p)
+ Help/Pattern/preject.help.lhs view
@@ -0,0 +1,10 @@+preject :: (a -> Bool) -> P a -> P a+preject f = pfilter (not . f)++Rejects values for which the predicate is true. ++> import Sound.SC3.Lang.Pattern++> let { p = pseq [1, 2, 3] 3+>     ; q = preject (== 1) p }+> in evalP 0 q
+ Help/Pattern/prorate.help.lhs view
@@ -0,0 +1,11 @@+prorate++Divide stream proportionally++ proportions - a pattern that returns either numbers (divides the+               pattern into pairs) or arrays of size n which are used+               to split up the input into n parts.+     pattern - a numerical pattern++> let p = prorate (pseq [0.35, 0.5, 0.8] 1) 1+> in evalP 0 p
+ Help/Pattern/prsd.help.lhs view
@@ -0,0 +1,8 @@+prsd :: (Eq a) => P a -> P a++Remove successive duplicates.++> import Sound.SC3.Lang.Pattern++> let p = pfix 0 (prand [1,2,3] 9)+> in evalP 0 (pzip (prsd p) p)
+ Help/Pattern/pseq.help.lhs view
@@ -0,0 +1,48 @@+pseq :: [P a] -> P Int -> P a+pseq_ :: [P a] -> Int -> P a++Cycle over a list of patterns. The repeats pattern gives+the number of times to repeat the entire list. ++> import Sound.SC3.Lang.Pattern++> let a = pseq [1, 2, 3] 2+> in evalP 0 a++Unlike Pseq, pseq does not have an offset argument to+give a starting offset into the list.++> import Sound.SC3.Lang.Collection++> let p = pseq (rotate 3 [1, 2, 3, 4]) 3+> in evalP 0 p++Because the repeat counter is a pattern one can have+a random number of repeats.++> let p = pseq [1, 2] (prrand 1 9)+> in evalP 7 p++For the same reason the pattern is not static when +re-examined.++> let p = pseq [ 0, pseq [1] (prrand 1 3), 2] 5+> in take 24 (evalP 94 p)++Further, if the repeat pattern is not singular,+the sequence will repeat until the pattern is exhausted.++> let { p = pseq [1] 3+>     ; q = pseq [1] p }+> in evalP 0 q++If one specifies the value pinf for the repeats variable, +then it will repeat indefinitely.++> let p = pseq [1, 2, 3] pinf+> in take 9 (evalP 0 p)++There is a variant with a true integer repeat count.++> let p = pseq_ [1, 2, 3] 5+> in evalP 0 p
+ Help/Pattern/pser.help.lhs view
@@ -0,0 +1,14 @@+pser :: [P a] -> P Int -> P a++pser is like pseq, however the repeats variable +gives the number of elements in the sequence,+not the number of cycles of the pattern.++> let p = pser [1, 2, 3] 5+> in evalP 0 p++> let p = pser [1, pser [100, 200] 3, 3] 9+> in evalP 0 p++> let p = pser [1, 2, 3] 5 *. 3+> in evalP 0 p
+ Help/Pattern/pseries.help.lhs view
@@ -0,0 +1,13 @@+pseries :: (Num a) => a -> a -> Int -> P a++An arithmetric series. ++  start - start value+   step - addition factor+ length - number of values++> let p = pseries 0 2 24+> in evalP 0 p++> let p = pseries 1.0 0.1 24+> in evalP 0 p
+ Help/Pattern/pstutter.help.lhs view
@@ -0,0 +1,26 @@+pstutter :: P Int -> P a -> P a+pstutter' :: P Int -> P a -> P a++  count - number of repeats *cyc*+      x - value pattern++Repeat each element of a pattern n times.++> import Sound.SC3.Lang.Pattern++> let p = pstutter 2 (pseq [1, 2, 3] pinf)+> in take 13 (evalP 0 p)++> let { p = pseq [1, 2] pinf+>     ; q = pseq [1, 2, 3] pinf+>     ; r = pstutter p q }+> in take 13 (evalP 0 r)++There is a variant, pstutter', that does not do+implicit extension on the count pattern.++> let p = pstutter' (prepeat 2) (pseq [1, 2, 3] pinf)+> in take 13 (evalP 0 p)++> let p = pstutter' (pseq [2,3] 1) (pseq [1, 2, 3] pinf)+> in evalP 0 p
+ Help/Pattern/pswitch.help.lhs view
@@ -0,0 +1,11 @@+pswitch :: [P a] -> P Int -> P a+pswitch l i = i >>= (l !!)++Select elements from a list of patterns by a pattern of indices.++> import Sound.SC3.Lang.Pattern++> let { a = pseq [1, 2, 3] 2+>     ; b = pseq [65, 76] 1+>     ; c = pswitch [a, b, 800] (pseq [2, 2, 0, 1] pinf) }+> in take 24 (evalP 0 c)
+ Help/Pattern/pswitch1.help.lhs view
@@ -0,0 +1,22 @@+pswitch1 :: [P a] -> P Int -> P a+pswitch1m :: IntMap (P a) -> P Int -> P a++  list - patterns to index+ which - index++The pattern of indices is used select which pattern+to retrieve the next value from.  Only one value +is selected from each the pattern.++This is in comparison to pswitch, which embeds the +pattern in its entirety.  pswitch1 switches every value.++pswitch1 is implemented in terms of pswitch1m.++> import Control.Applicative+> import Sound.SC3.Lang.Pattern++> let { p = pseq [1, 2, 3] pinf+>     ; q = pseq [65, 76] pinf+>     ; r = pswitch1 [p, q, pure 800] (pseq [2, 2, 0, 1] pinf) }+> in take 24 (evalP 0 r)
+ Help/Pattern/ptail.help.lhs view
@@ -0,0 +1,10 @@+ptail :: P a -> P a++Drop first element from pattern.++> import Sound.SC3.Lang.Pattern++> let p = pseq [1, 2, 3] 1+> in evalP 0 (ptail p)++> evalP 0 (ptail pempty)
+ Help/Pattern/ptrigger.help.lhs view
@@ -0,0 +1,17 @@+ptrigger :: P Bool -> P a -> P (Maybe a)++  tr - boolean pattern+   x - value pattern++The 'tr' pattern determines the rate+at which values are read from the 'x'+pattern.  For each sucessive true +value at 'tr' the output is a 'Just e'+of each succesive element at x.  False+values at 'tr' generate Nothing values. ++> import Sound.SC3.Lang.Pattern++> let { p = pseq [1, 2, 3, 4, 5] 3     +>     ; t = pbool (pseq [0, 0, 1, 0, 0, 0, 1, 1] 1) } +> in evalP 0 (ptrigger t p)
+ Help/Pattern/pwhite.help.lhs view
@@ -0,0 +1,20 @@+pwhite :: (Random a) => P a -> P a -> P Int -> P a++Uniform linear distribution in given range.++> import Sound.SC3.Lang.Pattern++> let p = pwhite 0.0 1.0 12+> in evalP 0 p++> let { l = pseq [0.0, 10.0] 1+>     ; r = pseq [1.0, 11.0] 1+>     ; p = pwhite l r 12 }+> in evalP 0 p++Or equivalently,++> let { b = pseq [return (0.0, 1.0)+>                ,return (10.0, 11.0)] 1+>     ; p = pwhite (fmap fst b) (fmap snd b) 12 }+> in evalP 0 p
+ Help/Pattern/pwrap.help.lhs view
@@ -0,0 +1,17 @@+pwrap :: (Ord a, Num a) => P a -> P a -> P a -> P a++ x - input+ l - lower bound *cycle*+ r - upper bound *cycle*++If x is outside of (l, r) wrap until it lies inside.++> import Sound.SC3.Lang.Pattern++> let { p = pseries 6 2 9+>     ; q = pwrap p 2 10 }+> in evalP 0 q++> let { p = pseries 6 2 9+>     ; q = pwrap p 1 11 }+> in evalP 0 q
+ Help/Pattern/pxrand.help.lhs view
@@ -0,0 +1,9 @@+pxrand :: (Eq a) => [P a] -> P Int -> P a++Like prand, returns one item from the list at random for each +step, but pxrand never repeats the same element twice in a row. ++> import Sound.SC3.Lang.Pattern++> let p = pxrand [1,2,3] 10+> in evalP 0 p
+ README view
@@ -0,0 +1,12 @@+hsc3-lang - Haskell SuperCollider Language Library++hsc3-lang provides Sound.SC3.Lang, a Haskell module that +defines a subset of functions from the SuperCollider +class library.++  http://slavepianos.org/rd/+  http://haskell.org/+  http://audiosynth.com/++(c) rohan drape, 2007-2009+    gpl, http://gnu.org/copyleft/
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ Sound/SC3/Lang.hs view
@@ -0,0 +1,8 @@+module Sound.SC3.Lang +    ( module Sound.SC3.Lang.Collection+    , module Sound.SC3.Lang.Math+    , module Sound.SC3.Lang.Pattern ) where++import Sound.SC3.Lang.Collection+import Sound.SC3.Lang.Math+import Sound.SC3.Lang.Pattern
+ Sound/SC3/Lang/Collection.hs view
@@ -0,0 +1,8 @@+module Sound.SC3.Lang.Collection +    ( module Sound.SC3.Lang.Collection.Collection+    , module Sound.SC3.Lang.Collection.Numerical+    , module Sound.SC3.Lang.Collection.SequenceableCollection ) where++import Sound.SC3.Lang.Collection.Collection+import Sound.SC3.Lang.Collection.Numerical+import Sound.SC3.Lang.Collection.SequenceableCollection
+ Sound/SC3/Lang/Collection/Collection.hs view
@@ -0,0 +1,56 @@+module Sound.SC3.Lang.Collection.Collection where++import Data.List+import Data.Maybe++fill :: Int -> (Int -> a) -> [a]+fill n f = map f [0 .. n - 1]++size :: [a] -> Int+size = length++isEmpty :: [a] -> Bool+isEmpty = null++ignoringIndex :: (a -> b) -> a -> Int -> b+ignoringIndex f e _ = f e++collect :: (a -> Int -> b) -> [a] -> [b]+collect f l = zipWith f l [0..]++select :: (a -> Int -> Bool) -> [a] -> [a]+select f l = map fst (filter (uncurry f) (zip l [0..]))++reject :: (a -> Int -> Bool) -> [a] -> [a]+reject f l = map fst (filter (not . uncurry f) (zip l [0..]))++detect :: (a -> Int -> Bool) -> [a] -> Maybe a+detect f l = maybe Nothing (Just . fst) (find (uncurry f) (zip l [0..]))++detectIndex :: (a -> Int -> Bool) -> [a] -> Maybe Int+detectIndex f l = maybe Nothing (Just . snd) (find (uncurry f) (zip l [0..]))++inject :: a -> (a -> b -> a) -> [b] -> a+inject i f = foldl f i++any' :: (a -> Int -> Bool) -> [a] -> Bool+any' f = isJust . detect f++every :: (a -> Int -> Bool) -> [a] -> Bool+every f = let g e = not . f e+          in not . any' g++count :: (a -> Int -> Bool) -> [a] -> Int+count f = length . select f++occurencesOf :: (Eq a) => a -> [a] -> Int+occurencesOf k = count (\e _ -> e == k)++sum' :: (Num a) => (b -> Int -> a) -> [b] -> a+sum' f = sum . collect f++maxItem :: (Ord b) => (a -> Int -> b) -> [a] -> b+maxItem f = maximum . collect f++minItem :: (Ord b) => (a -> Int -> b) -> [a] -> b+minItem f = minimum . collect f
+ Sound/SC3/Lang/Collection/Numerical.hs view
@@ -0,0 +1,37 @@+module Sound.SC3.Lang.Collection.Numerical where++import Sound.SC3.Lang.Collection.SequenceableCollection (zipWith_c)++instance Num a => Num [a] where+    negate         = map negate+    (+)            = zipWith_c (+)+    (-)            = zipWith_c (-)+    (*)            = zipWith_c (*)+    abs            = map abs+    signum         = map signum+    fromInteger n  = [fromInteger n]++instance Fractional a => Fractional [a] where+    recip          = map recip+    (/)            = zipWith_c (/)+    fromRational n = [fromRational n]++instance Floating a => Floating [a] where+    pi             = cycle [pi]+    exp            = map exp+    log            = map log+    sqrt           = map sqrt+    (**)           = zipWith_c (**)+    logBase        = zipWith_c logBase+    sin            = map sin+    cos            = map cos+    tan            = map tan+    asin           = map asin+    acos           = map acos+    atan           = map atan+    sinh           = map sinh+    cosh           = map cosh+    tanh           = map tanh+    asinh          = map asinh+    acosh          = map acosh+    atanh          = map atanh
+ Sound/SC3/Lang/Collection/SequenceableCollection.hs view
@@ -0,0 +1,142 @@+module Sound.SC3.Lang.Collection.SequenceableCollection where++import Control.Monad+import Data.List+import Data.Maybe+import Sound.SC3.Lang.Collection.Collection+import System.Random++-- | Arithmetic series (size, start, step)+series :: (Num a) => Int -> a -> a -> [a]+series 0 _ _ = []+series n i j = i : series (n - 1) (i + j) j++-- | Geometric series (size, start, grow)+geom :: (Num a) => Int -> a -> a -> [a]+geom 0 _ _ = []+geom n i j = i : series (n - 1) (i * j) j++-- | Fibonacci series (size, initial step, start)+fib :: (Num a) => Int -> a -> a -> [a]+fib 0 _ _ = []+fib n i j = j : fib (n - 1) j (i + j)++-- | Random values (size, min, max) - ought this be in floating?+rand :: (Random a) => Int -> a -> a -> IO [a]+rand n l r = replicateM n (getStdRandom (randomR (l, r)))++-- | Random values in the range -abs to +abs (size, abs)+rand2 :: (Num a, Random a) => Int -> a -> IO [a]+rand2 n m = replicateM n (getStdRandom (randomR (negate m, m)))++-- | The first element.+first :: [t] -> Maybe t+first (x:_) = Just x+first _ = Nothing++-- | The last element.+last' :: [t] -> Maybe t+last' [] = Nothing+last' [x] = Just x+last' (_:xs) = last' xs++-- | flip elemIndex+indexOf :: Eq a => [a] -> a -> Maybe Int+indexOf = flip elemIndex++-- | indexOf+indexOfEqual :: Eq a => [a] -> a -> Maybe Int+indexOfEqual = indexOf++-- | Collection is sorted, index of first greater element.+indexOfGreaterThan :: (Ord a) => a -> [a] -> Maybe Int+indexOfGreaterThan e = detectIndex (ignoringIndex (> e))++-- | Collection is sorted, index of nearest element.+indexIn :: (Ord a, Num a) => a -> [a] -> Int+indexIn e l = maybe (size l - 1) f (indexOfGreaterThan e l)+    where f 0 = 0+          f j = if (e - left) < (right - e) then i else j +              where i = j - 1+                    right = l !! j+                    left = l !! i++-- | Collection is sorted, linearly interpolated fractional index.+indexInBetween :: (Ord a, Fractional a) => a -> [a] -> a+indexInBetween e l = maybe (fromIntegral (size l) - 1) f (indexOfGreaterThan e l)+    where f 0 = 0+          f j = if d == 0 then i else ((e - a) / d) + i - 1+              where i = fromIntegral j+                    a = l !! (j - 1)+                    b = l !! j+                    d = b - a++keep :: Int -> [a] -> [a]+keep n l | n < 0 = fromMaybe l (find (\e -> length e == negate n) (tails l))+         | otherwise = take n l++drop' :: Int -> [a] -> [a]+drop' n l | n < 0 = take (length l + n) l+          | otherwise = drop n l++extendSequences :: [[a]] -> [[a]]+extendSequences l = map (take n . cycle) l+    where n = maximum (map length l)++flop :: [[a]] -> [[a]]+flop = transpose . extendSequences++choose :: [a] -> IO a+choose l = liftM (l!!) (getStdRandom (randomR (0, length l - 1)))++separateAt :: (a -> a -> Bool) -> [a] -> ([a], [a])+separateAt f (x1:x2:xs) = if f x1 x2 +                          then ([x1], x2:xs) +                          else x1 `g` separateAt f (x2:xs)+                              where g e (l,r) = (e:l, r)+separateAt _ l = (l,[])++separate :: (a -> a -> Bool) -> [a] -> [[a]]+separate f l = if null r then [e] else e : separate f r+    where (e, r) = separateAt f l++clump :: Int -> [a] -> [[a]]+clump n l = if null r then [e] else e : clump n r+    where (e, r) = splitAt n l++clumps :: [Int] -> [a] -> [[a]]+clumps m s = f (cycle m) s+    where f [] _ = undefined+          f (n:ns) l = if null r then [e] else e :clumps ns r+              where (e, r) = splitAt n l++-- | dx -> d+integrate :: (Num a) => [a] -> [a]+integrate [] = []+integrate (x:xs) = x : snd (mapAccumL f x xs)+    where f p c = (p + c, p + c)++-- | d -> dx+differentiate :: (Num a) => [a] -> [a]+differentiate l = zipWith (-) l (0:l)++-- | Rotate n places to the left (ie. rotate 1 [1, 2, 3] is [2, 3, 1]).+rotate :: Int -> [a] -> [a]+rotate n p = let (b, a) = splitAt n p +             in a ++ b ++-- | Ensure sum of elements is one.+normalizeSum :: (Fractional a) => [a] -> [a]+normalizeSum l = let n = sum l+                 in map (/ n) l++-- | Variant that cycles the shorter input.+zipWith_c :: (a -> b -> c) -> [a] -> [b] -> [c]+zipWith_c f a b = g a b (False, False)+    where g [] [] _ = []+          g [] b' (_, e) = if e then [] else g a b' (True, e)+          g a' [] (e, _) = if e then [] else g a' b (e, True)+          g (a0 : aN) (b0 : bN) e = f a0 b0 : g aN bN e++zip_c :: [a] -> [b] -> [(a, b)]+zip_c = zipWith_c (,)
+ Sound/SC3/Lang/Math.hs view
@@ -0,0 +1,3 @@+module Sound.SC3.Lang.Math ( module Sound.SC3.Lang.Math.Pitch ) where++import Sound.SC3.Lang.Math.Pitch
+ Sound/SC3/Lang/Math/Pitch.hs view
@@ -0,0 +1,64 @@+module Sound.SC3.Lang.Math.Pitch where++data Pitch a = Pitch { mtranspose :: a+                     , gtranspose :: a+                     , ctranspose :: a+                     , octave :: a+                     , root :: a +                     , scale :: [a]+                     , degree :: a+                     , stepsPerOctave :: a+                     , detune :: a+                     , harmonic :: a+                     , freq_f :: Pitch a -> a+                     , midinote_f :: Pitch a -> a+                     , note_f :: Pitch a -> a }++midi_cps :: (Floating a) => a -> a+midi_cps a = 440.0 * (2.0 ** ((a - 69.0) * (1.0 / 12.0)))++defaultPitch :: (Floating a, RealFrac a) => Pitch a+defaultPitch = +    Pitch { mtranspose = 0+          , gtranspose = 0+          , ctranspose = 0+          , octave = 5+          , root = 0+          , degree = 0+          , scale = [0, 2, 4, 5, 7, 9, 11]+          , stepsPerOctave = 12+          , detune = 0+          , harmonic = 1+          , freq_f = default_freq_f+          , midinote_f = default_midinote_f+          , note_f = default_note_f+          }++default_freq_f :: (Floating a) => Pitch a -> a+default_freq_f e = midi_cps (midinote e + ctranspose e) * harmonic e++default_midinote_f :: (Fractional a) => Pitch a -> a+default_midinote_f e = let n = note e + gtranspose e + root e+                       in (n / stepsPerOctave e + octave e) * 12++default_note_f :: (RealFrac a) => Pitch a -> a+default_note_f e = let d = degree e + mtranspose e+                   in degree_to_key d (scale e) (stepsPerOctave e)++degree_to_key :: (RealFrac a) => a -> [a] -> a -> a+degree_to_key d s n = (n * fromIntegral (d' `div` l)) + (s !! (d' `mod` l)) + a+    where l = length s+          d' = round d+          a = (d - fromIntegral d') * 10.0 * (n / 12.0)++note :: Pitch a -> a+note e = note_f e e++midinote :: Pitch a -> a+midinote e = midinote_f e e++freq :: Pitch a -> a+freq e = freq_f e e++detunedFreq :: (Num a) => Pitch a -> a+detunedFreq e = freq e + detune e
+ Sound/SC3/Lang/Pattern.hs view
@@ -0,0 +1,11 @@+module Sound.SC3.Lang.Pattern ( module Sound.SC3.Lang.Pattern.Pattern+                              , module Sound.SC3.Lang.Pattern.Control+                              , module Sound.SC3.Lang.Pattern.Extend+                              , module Sound.SC3.Lang.Pattern.List+                              , module Sound.SC3.Lang.Pattern.Random ) where++import Sound.SC3.Lang.Pattern.Pattern+import Sound.SC3.Lang.Pattern.Control+import Sound.SC3.Lang.Pattern.Extend+import Sound.SC3.Lang.Pattern.List+import Sound.SC3.Lang.Pattern.Random
+ Sound/SC3/Lang/Pattern/Control.hs view
@@ -0,0 +1,168 @@+module Sound.SC3.Lang.Pattern.Control where++import Control.Applicative+import Control.Monad+import Data.List+import Data.Maybe+import Data.Monoid+import Sound.SC3.Lang.Math.Pitch+import Sound.SC3.Lang.Pattern.Pattern++pfilter :: (a -> Bool) -> P a -> P a+pfilter f p = pcontinue p (\x p' -> if f x +                                    then mappend (return x) (pfilter f p')+                                    else pfilter f p')++plist :: [P a] -> P a+plist = foldr mappend mempty++pcons :: a -> P a -> P a+pcons = mappend . return++preplicate_ :: Int -> P a -> P a+preplicate_ n p | n > 0 = mappend p (preplicate_ (n - 1) p)+                | otherwise = mempty++preplicate :: P Int -> P a -> P a+preplicate n p = n >>= (\x -> preplicate_ x p)++pn :: P a -> P Int -> P a+pn = flip preplicate++pn_ :: P a -> Int -> P a+pn_ = flip preplicate_++-- | 'n' initial values at 'p'.+ptake_ :: Int -> P a -> P a+ptake_ n p = pzipWith const p (preplicate_ n (return undefined))++ptake :: P Int -> P a -> P a+ptake n p = pzipWith const p (preplicate n (return undefined))++-- | 'n' initial values at pcycle of 'p'.+prestrict_ :: Int -> P a -> P a+prestrict_ n = ptake_ n . pcycle++prestrict :: P Int -> P a -> P a+prestrict n = ptake n . pcycle++pmapMaybe :: (a -> Maybe b) -> P a -> P b+pmapMaybe f = fmap fromJust . pfilter isJust . fmap f++preject :: (a -> Bool) -> P a -> P a+preject f = pfilter (not . f)++pzipWith3 :: (a -> b -> c -> d) -> P a -> P b -> P c -> P d+pzipWith3 f p q = (<*>) (pure f <*> p <*> q)++pzip :: P a -> P b -> P (a,b)+pzip = pzipWith (,)++pseries :: (Num a) => a -> a -> Int -> P a+pseries i s n = plist (unfoldr f (i, n))+    where f (_, 0) = Nothing+          f (j, m) = Just (return j, (j + s, m - 1))++pgeom :: (Num a) => a -> a -> Int -> P a+pgeom i s n = plist (unfoldr f (i, n))+    where f (_, 0) = Nothing+          f (j, m) = Just (return j, (j * s, m - 1))++pstutter' :: P Int -> P a -> P a+pstutter' n p =+    let f :: Int -> a -> P a+        f i e = preplicate (return i) (return e)+    in psequence (pzipWith f n p)++pstutter :: P Int -> P a -> P a+pstutter = pstutter' . pcycle++-- | Count false values preceding each true value. +pcountpre :: P Bool -> P Int+pcountpre p = pmapMaybe id (pscan f Nothing 0 p)+    where f x e = if e then (0, Just x) else (x + 1, Nothing)++-- | Count false values following each true value. +pcountpost :: P Bool -> P Int+pcountpost p = ptail (pmapMaybe id (pscan f (Just Just) 0 p))+    where f x e = if e then (0, Just x) else (x + 1, Nothing)++pclutch' :: P a -> P Bool -> P a+pclutch' p q = pstutter' r p+    where r = fmap (+ 1) (pcountpost q)++pbool :: (Ord a, Num a) => P a -> P Bool+pbool = fmap (> 0)++pclutch :: (Num b, Ord b) => P a -> P b -> P a+pclutch p = pclutch' p . pbool++pcollect :: (a -> b) -> P a -> P b+pcollect = fmap++pdegreeToKey :: (RealFrac a) => P a -> P [a] -> P a -> P a+pdegreeToKey = pzipWith3 degree_to_key++pfin :: P Int -> P a -> P a+pfin = ptake++pfin_ :: Int -> P a -> P a+pfin_ = ptake_++wrap :: (Ord a, Num a) => a -> a -> a -> a+wrap l r x = if x > r+             then wrap l r (x - (r - l))+             else if x < l +                  then wrap l r (x + (r - l))+                  else x++pwrap :: (Ord a, Num a) => P a -> P a -> P a -> P a+pwrap x l r = pzipWith3 f x (pcycle l) (pcycle r)+    where f x' l' r' = wrap l' r' x'++-- | Remove successive duplicates.+prsd :: (Eq a) => P a -> P a+prsd p = pmapMaybe id (pscan f Nothing Nothing p)+    where f Nothing a = (Just a, Just a)+          f (Just x) a = (Just a, if a == x then Nothing else Just a)++psequence :: P (P a) -> P a+psequence = join++pduple :: (a, a) -> P a+pduple (x, y) = return x `mappend` return y++pinterleave :: P a -> P a -> P a+pinterleave p = psequence . fmap pduple . pzip p++ptrigger :: P Bool -> P a -> P (Maybe a)+ptrigger p q = join (pzipWith f r q)+    where r = pcountpre p+          f i = mappend (preplicate_ i (return Nothing)) . return . Just++pif :: Int -> P Bool -> P a -> P a -> P a+pif s b p q = pzipWith f p' q'+    where b' = pfix s b+          p' = ptrigger b' p+          q' = ptrigger (fmap not b') q+          f (Just x) Nothing = x+          f Nothing (Just x) = x+          f _ _ = undefined++pif' :: P Bool -> P a -> P a -> P a+pif' = pif 0++phead :: P a -> P a+phead p = pcontinue p (\x _ -> return x)++ptail :: P a -> P a+ptail p = pcontinue p (\_ p' -> p')++pdrop :: P Int -> P a -> P a+pdrop n p = n >>= (\x -> if x > 0 +                         then pdrop (return (x-1)) (ptail p)+                         else p)++pscanl :: (a -> y -> a) -> a -> P y -> P a+pscanl f i p = pcons i (pscan g Nothing i p)+    where g x y = let r = f x y in (r, r)
+ Sound/SC3/Lang/Pattern/Extend.hs view
@@ -0,0 +1,18 @@+module Sound.SC3.Lang.Pattern.Extend where++import Sound.SC3.Lang.Pattern.Pattern++pzipWith_c :: (a -> b -> c) -> P a -> P b -> P c+pzipWith_c f p = pzipWith f p . pcycle++(+.) :: Num a => P a -> P a -> P a+(+.) = pzipWith_c (+)++(*.) :: Num a => P a -> P a -> P a+(*.) = pzipWith_c (*)++(/.) :: Fractional a => P a -> P a -> P a+(/.) = pzipWith_c (/)++(-.) :: Num a => P a -> P a -> P a+(-.) = pzipWith_c (-)
+ Sound/SC3/Lang/Pattern/List.hs view
@@ -0,0 +1,51 @@+module Sound.SC3.Lang.Pattern.List where++import qualified Data.IntMap as M+import Data.List+import Data.Monoid+import Sound.SC3.Lang.Pattern.Pattern+import Sound.SC3.Lang.Pattern.Control++pseq_ :: [P a] -> Int -> P a+pseq_ l n = plist (concat (replicate n l))++pseq :: [P a] -> P Int -> P a+pseq l n = n >>= (\x -> plist (concat (replicate x l)))++-- | 'n' values from the infinite cycle of the streams at l.+pser_ :: [P a] -> Int -> P a+pser_ l n = prestrict_ n (plist l)++pser :: [P a] -> P Int -> P a+pser l n = prestrict n (plist l)++pswitch :: [P a] -> P Int -> P a+pswitch l i = i >>= (l !!)++pswitch1m :: M.IntMap (P a) -> P Int -> P a+pswitch1m m is = let f i js = let h = phead (m M.! i)+                                  t = ptail (m M.! i)+                              in h `mappend` pswitch1m (M.insert i t m) js+                 in pcontinue is f++pswitch1 :: [P a] -> P Int -> P a+pswitch1 = pswitch1m . M.fromList . zip [0..]++ppatlace :: [P a] -> P Int -> P a+ppatlace ps n = let is = pseq (map return [0 .. length ps - 1]) pinf+                in ptake n (pswitch1 ps is)++{-++Neither the definition above or the variant below are correct.+Both deadlock once all patterns are empty.  pswitch1 has the +same problem.  ++ppatlacea :: P (P a) -> P a+ppatlacea ps = +    let f p qs = let h = phead p+                     t = ptail p+                     rs = qs `mappend` return t+                 in h `mappend` (ppatlacea rs)+    in pcontinue ps f+-}
+ Sound/SC3/Lang/Pattern/Pattern.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE ExistentialQuantification #-}++module Sound.SC3.Lang.Pattern.Pattern+    ( P+    , pfoldr, evalP+    , pfix+    , pcontinue+    , pmap -- Prelude.fmap+    , punfoldr -- Data.List.unfoldr+    , preturn -- Control.Monad.return+    , pbind -- Control.Monad.(>>=)+    , pempty -- Data.Monoid.mempty+    , pappend -- Data.Monoid.mappend+    , ppure -- Control.Applicative.pure+    , papply -- Control.Applicative.(<*>)+    , prp+    , pscan+    , pinf+    , pzipWith+    , pcycle+    , prepeat ) where++import Control.Applicative+import Data.Monoid+import System.Random++data P a = Empty+         | Value a+         | RP (StdGen -> (P a, StdGen))+         | Append (P a) (P a)+         | Fix StdGen (P a)+         | forall x . Unfoldr (x -> Maybe (a, x)) x+         | forall x . Continue (P x) (x -> P x -> P a)+         | forall x . Apply (P (x -> a)) (P x)+         | forall x y . Scan (x -> y -> (x, a)) (Maybe (x -> a)) x (P y)++data Result a = Result StdGen a (P a)+              | Done StdGen++step :: StdGen -> P a -> Result a+step g Empty = Done g+step g (Value a) = Result g a pempty+step g (RP f) = let (p, g') = f g+                in step g' p+step g (Append x y) = case step g x of+    Done g' -> step g' y+    Result g' a x' -> Result g' a (Append x' y)+step g (Fix fg p) = case step fg p of+    Done _ -> Done g+    Result fg' x p' -> Result g x (Fix fg' p')+step g (Continue p f) = case step g p of+    Done g' -> Done g'+    Result g' x p' -> step g' (f x p')+step g (Unfoldr f x) = let y = f x +                       in case y of+                            Nothing -> Done g+                            Just (a, x') -> Result g a (Unfoldr f x')+step g (Apply p q) = case step g p of+    Done g' -> Done g'+    Result g' f p' -> case step g' q of+        Done g'' -> Done g''+        Result g'' x q' -> Result g'' (f x) (Apply p' q')+step g (Scan f f' i p) = case step g p of+    Done g' -> case f' of+                 Just h -> Result g' (h i) Empty+                 Nothing -> Done g'+    Result g' a p' -> let (j, x) = f i a+                      in Result g' x (Scan f f' j p')++pfoldr' :: StdGen -> (a -> b -> b) -> b -> P a -> b+pfoldr' g f i p = case step g p of+                    Done _ -> i+                    Result g' a p' -> f a (pfoldr' g' f i p')++pfoldr :: Seed -> (a -> b -> b) -> b -> P a -> b+pfoldr = pfoldr' . mkStdGen++evalP :: Int -> P a -> [a]+evalP n = pfoldr n (:) []++instance (Show a) => Show (P a) where+    show _ = show "a pattern"++instance (Eq a) => Eq (P a) where+    _ == _ = False++-- | Apply `f' pointwise to elements of `p' and `q'.+pzipWith :: (a -> b -> c) -> P a -> P b -> P c+pzipWith f p = (<*>) (pure f <*> p)++instance (Num a) => Num (P a) where+    (+) = pzipWith (+)+    (-) = pzipWith (-)+    (*) = pzipWith (*)+    abs = fmap abs+    signum = fmap signum+    fromInteger = return . fromInteger+    negate = fmap negate++instance (Fractional a) => Fractional (P a) where+    (/) = pzipWith (/)+    recip = fmap recip+    fromRational = return . fromRational++pcycle :: P a -> P a+pcycle x = x `mappend` pcycle x++prepeat :: a -> P a+prepeat = pcycle . return++pmap :: (a -> b) -> P a -> P b+pmap = (<*>) . prepeat++instance Functor P where+    fmap = pmap++instance Monad P where+    (>>=) = pbind+    return = preturn++instance Monoid (P a) where+    mempty = pempty+    mappend = pappend++ppure :: a -> P a+ppure = prepeat++instance Applicative P where+    pure = ppure+    (<*>) = papply++-- * Basic constructors++pempty :: P a+pempty = Empty++preturn :: a -> P a+preturn = Value++prp :: (StdGen -> (P a, StdGen)) -> P a+prp = RP++pinf :: P Int+pinf = return 83886028 -- 2 ^^ 23++pappend :: P a -> P a -> P a+pappend = Append++type Seed = Int++pfix :: Seed -> P a -> P a+pfix = Fix . mkStdGen++pcontinue :: P x -> (x -> P x -> P a) -> P a+pcontinue = Continue++pbind :: P x -> (x -> P a) -> P a+pbind p f = pcontinue p (\x q -> f x `mappend` pbind q f)++papply :: P (a -> b) -> P a -> P b+papply = Apply++pscan :: (x -> y -> (x, a)) -> Maybe (x -> a) -> x -> P y -> P a+pscan = Scan++punfoldr :: (x -> Maybe (a, x)) -> x -> P a+punfoldr = Unfoldr
+ Sound/SC3/Lang/Pattern/Random.hs view
@@ -0,0 +1,43 @@+module Sound.SC3.Lang.Pattern.Random where++import Control.Monad+import Data.Array+import Data.List+import Sound.SC3.Lang.Pattern.Pattern+import Sound.SC3.Lang.Pattern.Control+import Sound.SC3.Lang.Pattern.List+import System.Random++-- Random numbers++prrandf :: (Random a) => (a -> a -> a -> a) -> a -> a -> P a+prrandf f l r = prp (\g -> let (x, g') = randomR (l,r) g+                           in (preturn (f l r x), g'))++prrand :: (Random a) => a -> a -> P a+prrand = prrandf (\_ _ x -> x)++prrandexp :: (Floating a, Random a) => a -> a -> P a+prrandexp = prrandf (\l r x -> l * (log (r / l) * x))++pchoosea :: Array Int (P a) -> P a+pchoosea r = prp (\g -> let (i, g') = randomR (bounds r) g +                        in (r ! i, g'))++pchoose :: [P a] -> P a+pchoose l = pchoosea (listArray (0, length l - 1) l)++prand :: [P a] -> P Int -> P a+prand p = pseq [pchoose p]++pwhite :: (Random a) => P a -> P a -> P Int -> P a+pwhite l r n = prestrict n (join (pzipWith prrand l r))++pexprand :: (Floating a, Random a) => P a -> P a -> P Int -> P a+pexprand l r n = prestrict n (join (pzipWith prrandexp l r))++pxrand :: (Eq a) => [P a] -> P Int -> P a+pxrand p n = ptake n (prsd (pseq [pchoose p] pinf))++pwrand :: [P a] -> [P a] -> P Int -> P a+pwrand = undefined
+ hsc3-lang.cabal view
@@ -0,0 +1,70 @@+Name:              hsc3-lang+Version:           0.7+Synopsis:          Haskell SuperCollider Language+Description:       Haskell library defining operations from the+                   SuperCollider language class library+License:           GPL+Category:          Sound+Copyright:         (c) Rohan Drape, 2007-2009+Author:            Rohan Drape+Maintainer:        rd@slavepianos.org+Stability:         Experimental+Homepage:          http://slavepianos.org/rd/f/649352/+Tested-With:       GHC == 6.8.2+Build-Type:        Simple+Cabal-Version:     >= 1.6++Data-files:        README+                   -- The below is appended by:+                   -- find Help -name "*.*hs" | sort | \+                   -- sed "s/^/                   /" >> hsc3-lang.cabal+                   Help/Collection/collection.help.lhs+                   Help/Math/pitch.help.lhs+                   Help/Pattern/pattern.help.lhs+                   Help/Pattern/pclutch.help.lhs+                   Help/Pattern/pcollect.help.lhs+                   Help/Pattern/pcountpre.help.lhs+                   Help/Pattern/pdegreeToKey.help.lhs+                   Help/Pattern/pdrop.help.lhs+                   Help/Pattern/pexprand.help.lhs+                   Help/Pattern/pfilter.help.lhs+                   Help/Pattern/pfin.help.lhs+                   Help/Pattern/pgeom.help.lhs+                   Help/Pattern/pif.help.lhs+                   Help/Pattern/pinterleave.help.lhs+                   Help/Pattern/pn.help.lhs+                   Help/Pattern/prand.help.lhs+                   Help/Pattern/preject.help.lhs+                   Help/Pattern/prorate.help.lhs+                   Help/Pattern/prsd.help.lhs+                   Help/Pattern/pseq.help.lhs+                   Help/Pattern/pser.help.lhs+                   Help/Pattern/pseries.help.lhs+                   Help/Pattern/pstutter.help.lhs+                   Help/Pattern/pswitch1.help.lhs+                   Help/Pattern/pswitch.help.lhs+                   Help/Pattern/ptail.help.lhs+                   Help/Pattern/ptrigger.help.lhs+                   Help/Pattern/pwhite.help.lhs+                   Help/Pattern/pwrap.help.lhs+                   Help/Pattern/pxrand.help.lhs++Library+  Build-Depends:   array,+                   base == 3.*,+                   containers,+                   random+  GHC-Options:     -Wall -fwarn-tabs+  Exposed-modules: Sound.SC3.Lang+                   Sound.SC3.Lang.Collection+                   Sound.SC3.Lang.Math+                   Sound.SC3.Lang.Pattern+  Other-modules:   Sound.SC3.Lang.Collection.Collection+                   Sound.SC3.Lang.Collection.Numerical+                   Sound.SC3.Lang.Collection.SequenceableCollection+                   Sound.SC3.Lang.Math.Pitch+                   Sound.SC3.Lang.Pattern.Pattern+                   Sound.SC3.Lang.Pattern.Extend+                   Sound.SC3.Lang.Pattern.Control+                   Sound.SC3.Lang.Pattern.List+                   Sound.SC3.Lang.Pattern.Random