hsc3-lang 0.7 → 0.8

raw patch · 110 files changed

+2042/−1264 lines, 110 filesdep +splitdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: split

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Help/Collection/collection.help.lhs +41/−0
• Help/Pattern/List/pappend.help.lhs +20/−0
• Help/Pattern/List/pbool.help.lhs +8/−0
• Help/Pattern/List/pclutch.help.lhs +21/−0
• Help/Pattern/List/pcollect.help.lhs +8/−0
• Help/Pattern/List/pcountpre.help.lhs +12/−0
• Help/Pattern/List/pcycle.help.lhs +11/−0
• Help/Pattern/List/pdegreeToKey.help.lhs +26/−0
• Help/Pattern/List/pdrop.help.lhs +9/−0
• Help/Pattern/List/pempty.help.lhs +9/−0
• Help/Pattern/List/pfilter.help.lhs +9/−0
• Help/Pattern/List/pfin.help.lhs +19/−0
• Help/Pattern/List/pgeom.help.lhs +15/−0
• Help/Pattern/List/phead.help.lhs +12/−0
• Help/Pattern/List/pinterleave.help.lhs +15/−0
• Help/Pattern/List/pn.help.lhs +7/−0
• Help/Pattern/List/prand.help.lhs +25/−0
• Help/Pattern/List/preject.help.lhs +9/−0
• Help/Pattern/List/prepeat.help.lhs +11/−0
• Help/Pattern/List/prsd.help.lhs +10/−0
• Help/Pattern/List/pseq.help.lhs +35/−0
• Help/Pattern/List/pser.help.lhs +13/−0
• Help/Pattern/List/pseries.help.lhs +13/−0
• Help/Pattern/List/pstutter.help.lhs +19/−0
• Help/Pattern/List/pswitch.help.lhs +11/−0
• Help/Pattern/List/pswitch1.help.lhs +18/−0
• Help/Pattern/List/ptail.help.lhs +14/−0
• Help/Pattern/List/ptake.help.lhs +10/−0
• Help/Pattern/List/ptrigger.help.lhs +22/−0
• Help/Pattern/List/pwhite.help.lhs +35/−0
• Help/Pattern/List/pzip.help.lhs +12/−0
• Help/Pattern/Step/pappend.help.lhs +12/−0
• Help/Pattern/Step/pclutch.help.lhs +29/−0
• Help/Pattern/Step/pcollect.help.lhs +9/−0
• Help/Pattern/Step/pcontinue.help.lhs +3/−0
• Help/Pattern/Step/pcountpre.help.lhs +10/−0
• Help/Pattern/Step/pcycle.help.lhs +9/−0
• Help/Pattern/Step/pdegreeToKey.help.lhs +26/−0
• Help/Pattern/Step/pdrop.help.lhs +8/−0
• Help/Pattern/Step/pempty.help.lhs +10/−0
• Help/Pattern/Step/pexprand.help.lhs +13/−0
• Help/Pattern/Step/pfilter.help.lhs +9/−0
• Help/Pattern/Step/pfin.help.lhs +26/−0
• Help/Pattern/Step/pfix.help.lhs +18/−0
• Help/Pattern/Step/pgeom.help.lhs +17/−0
• Help/Pattern/Step/phead.help.lhs +14/−0
• Help/Pattern/Step/pif.help.lhs +34/−0
• Help/Pattern/Step/pinterleave.help.lhs +12/−0
• Help/Pattern/Step/pn.help.lhs +16/−0
• Help/Pattern/Step/ppatlace.help.lhs +30/−0
• Help/Pattern/Step/prand.help.lhs +21/−0
• Help/Pattern/Step/preject.help.lhs +10/−0
• Help/Pattern/Step/prepeat.help.lhs +10/−0
• Help/Pattern/Step/prorate.help.lhs +11/−0
• Help/Pattern/Step/prp.help.lhs +37/−0
• Help/Pattern/Step/prsd.help.lhs +8/−0
• Help/Pattern/Step/pscan.help.lhs +33/−0
• Help/Pattern/Step/pscanl.help.lhs +28/−0
• Help/Pattern/Step/pseq.help.lhs +48/−0
• Help/Pattern/Step/pser.help.lhs +16/−0
• Help/Pattern/Step/pseries.help.lhs +15/−0
• Help/Pattern/Step/pstutter.help.lhs +26/−0
• Help/Pattern/Step/pswitch.help.lhs +11/−0
• Help/Pattern/Step/pswitch1.help.lhs +22/−0
• Help/Pattern/Step/ptail.help.lhs +10/−0
• Help/Pattern/Step/ptake.help.lhs +7/−0
• Help/Pattern/Step/ptrigger.help.lhs +17/−0
• Help/Pattern/Step/pwhite.help.lhs +36/−0
• Help/Pattern/Step/pwrap.help.lhs +17/−0
• Help/Pattern/Step/pxrand.help.lhs +9/−0
• Help/Pattern/pattern.help.lhs +0/−251
• Help/Pattern/pclutch.help.lhs +0/−29
• Help/Pattern/pcollect.help.lhs +0/−9
• Help/Pattern/pcountpre.help.lhs +0/−10
• Help/Pattern/pdegreeToKey.help.lhs +0/−26
• Help/Pattern/pdrop.help.lhs +0/−8
• Help/Pattern/pexprand.help.lhs +0/−13
• Help/Pattern/pfilter.help.lhs +0/−9
• Help/Pattern/pfin.help.lhs +0/−26
• Help/Pattern/pgeom.help.lhs +0/−17
• Help/Pattern/pif.help.lhs +0/−41
• Help/Pattern/pinterleave.help.lhs +0/−13
• Help/Pattern/pn.help.lhs +0/−16
• Help/Pattern/prand.help.lhs +0/−19
• Help/Pattern/preject.help.lhs +0/−10
• Help/Pattern/prorate.help.lhs +0/−11
• Help/Pattern/prsd.help.lhs +0/−8
• Help/Pattern/pseq.help.lhs +0/−48
• Help/Pattern/pser.help.lhs +0/−14
• Help/Pattern/pseries.help.lhs +0/−13
• Help/Pattern/pstutter.help.lhs +0/−26
• Help/Pattern/pswitch.help.lhs +0/−11
• Help/Pattern/pswitch1.help.lhs +0/−22
• Help/Pattern/ptail.help.lhs +0/−10
• Help/Pattern/ptrigger.help.lhs +0/−17
• Help/Pattern/pwhite.help.lhs +0/−20
• Help/Pattern/pwrap.help.lhs +0/−17
• Help/Pattern/pxrand.help.lhs +0/−9
• README +1/−1
• Sound/SC3/Lang.hs +1/−3
• Sound/SC3/Lang/Collection/SequenceableCollection.hs +57/−42
• Sound/SC3/Lang/Math/Pitch.hs +11/−8
• Sound/SC3/Lang/Pattern.hs +0/−11
• Sound/SC3/Lang/Pattern/Control.hs +0/−168
• Sound/SC3/Lang/Pattern/Extend.hs +0/−18
• Sound/SC3/Lang/Pattern/List.hs +319/−35
• Sound/SC3/Lang/Pattern/Pattern.hs +0/−167
• Sound/SC3/Lang/Pattern/Random.hs +0/−43
• Sound/SC3/Lang/Pattern/Step.hs +440/−0
• hsc3-lang.cabal +17/−45

@@ -42,3 +42,44 @@ > [1, 2, 3] * 4  denotes the list [4, 8, 12].++* Sequencable Collection (Sanity Check)++> series 5 1 2 == [1,3..9]++> geom 5 3 6 == [3,18,24,30,36]++> fib 5 1 1 == [1,2,3,5,8]++> first [1..] == Just 1++> first [] == Nothing++> last' [1..5] == Just 5++> last' [] == Nothing++> indexOf [0..] 5 == Just 5++> import Data.List++> indexOf [0..] 5 == elemIndex 5 [0..]++> keep 4 [1..10] == [1..4]++> keep (-4) [1..10] == [7..10]++> keep (-4) [1,2] == [1,2]++> drop' 4 [1..10] == [5..10]++> drop' (-4) [1..10] == [1..6]++> separateAt (<) [3,2,1,2,3,2]++> clump 3 [1..10] == [[1..3],[4..6],[7..9],[10]]++> clumps [1,2,3,4] [1..10] == [[1],[2,3],[4,5,6],[7,8,9,10]]++> clumps [1,2,3] [1..10] == [[1],[2,3],[4,5,6],[7],[8,9],[10]]+

@@ -0,0 +1,20 @@+(++) :: [a] -> [a] -> [a]+pappend :: P a -> P a -> P a++Sequence two patterns.  This is the mappend instance of Monoid.++> import Sound.SC3.Lang.Pattern.List++> let { p = pseq [1, 2] 1+>     ; q = pseq [2, 3] 1 }+> in p `pappend` q++> pnull (pempty `pappend` pempty)++> ptake 5 (prepeat 3 `pappend` prepeat 4)++> [1,2]++[2,3]++> null ([] ++ [])++> take 5 (repeat 3 ++ repeat 4)

@@ -0,0 +1,8 @@+bool :: (Functor f, Ord a, Num a) => f a -> f Bool+pbool :: (Ord a, Num a) => P a -> P Bool++> import Sound.SC3.Lang.Pattern.List++> pbool (pseq [1, 0, 1, 0, 0, 0, 1, 1] 1)++> bool [1, 0, 1, 0, 0, 0, 1, 1]

@@ -0,0 +1,21 @@+clutch :: [a] -> [Bool] -> [a]+pclutch :: P a -> P Bool -> P a++ i - input+ c - clutch++Sample and hold a pattern.  For true values in the control pattern,+step the value pattern, else hold the previous value.++> import Sound.SC3.Lang.Pattern.List++> let { p = pseq [1, 2, 3, 4, 5] 3+>     ; q = pbool (pseq [1, 0, 1, 0, 0, 0, 1, 1] 1) }+> in 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 = pbool (pseq [0, 0, 0, 1, 0, 0, 1, 0, 1] 1) }+> in pclutch p q

@@ -0,0 +1,8 @@+fmap :: (Functor f) => (a -> b) -> f a -> f b+pcollect :: (a -> b) -> P a -> P b++Patterns are functors.++> import Sound.SC3.Lang.Pattern.List++> pcollect (* 3) (pseq [1, 2, 3] 3)

@@ -0,0 +1,12 @@+countpre :: [Bool] -> [Int]+countpost :: [Bool] -> [Int]+pcountpre :: P Bool -> P Int+pcountpost :: P Bool -> P Int++> import Sound.SC3.Lang.Pattern.List++> pcountpre (pbool (pseq [0, 0, 1, 0, 0, 0, 1, 1] 1))+> pcountpost (pbool (pseq [1, 0, 1, 0, 0, 0, 1, 1] 1))++> countpre (bool [0, 0, 1, 0, 0, 0, 1, 1])+> countpost (bool [1, 0, 1, 0, 0, 0, 1, 1])

@@ -0,0 +1,11 @@+cycle :: [a] -> [a]+pcycle :: P a -> P a++pattern variant of Data.List.cycle++> import Sound.SC3.Lang.Pattern.List++> ptake 5 (pcycle (pseq [1,2,3] 1))++> take 5 (cycle [1,2,3]) == [1,2,3,1,2]+

@@ -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.List++> 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 pdegreeToKey p q r++> let { p = pseq [0, 1, 2, 3, 4, 3, 2, 1, 0, 2, 4, 7, 4, 2] 2+>     ; q = pseq [return [0, 2, 4, 5, 7, 9, 11]+>                ,return [0, 2, 3, 5, 7, 8, 11]] 1+>     ; r = prepeat 12 }+> in 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]

@@ -0,0 +1,9 @@+drop :: Int -> [a] -> [a]+pdrop :: P Int -> P a -> P a++Drop first n element from pattern.++> import Sound.SC3.Lang.Pattern.List++> let p = pseq [1, 2, 3] 4+> in (pdrop 7 p, p)

@@ -0,0 +1,9 @@+pempty :: P a++The empty pattern. (The instance for Monoid mempty.)++> import Sound.SC3.Lang.Pattern.List++> pempty++> pempty `pappend` return 1

@@ -0,0 +1,9 @@+filter :: (a -> Bool) -> [a] -> [a]+pfilter :: (a -> Bool) -> P a -> P a++Allows values for which the predicate is true. ++> import Sound.SC3.Lang.Pattern.List++> let p = pseq [1, 2, 3] 3+> in pfilter (< 3) p

@@ -0,0 +1,19 @@+take :: Int -> [a] -> [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.  pfin = ptake.++> import Sound.SC3.Lang.Pattern.List++> let p = pseq [1, 2, 3] pinf+> in pfin 5 p++Note that pfin does not extend the input pattern,+unlike pser.++> let p = pseq [1, 2, 3] 1+> in (pfin 5 p, pser [p] 5)

@@ -0,0 +1,15 @@+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.List++> pgeom 1 2 12++Real numbers work as well.++> pgeom 1.0 1.1 6

@@ -0,0 +1,12 @@+phead :: P a -> Maybe a++Inspect the first element of a pattern.++> import Sound.SC3.Lang.Pattern.List++> phead (pseq [1, 2, 3] 1)++> let p = pseq [1, 2, 3] 1+> in maybe pempty (\x -> x `pcons` ptail p) (phead p)++> phead pempty

@@ -0,0 +1,15 @@+interleave :: [a] -> [a] -> [a]+pinterleave :: P a -> P a -> P a++Interleave elements from two patterns.  If one pattern ends the other+pattern continues until it also ends.++> import Sound.SC3.Lang.Pattern.List++> let { p = pseq [1, 2, 3] 3+>     ; q = pseq [4, 5, 6, 7] 2 }+> in pinterleave p q++> ptake 10 (pinterleave (pcycle 1) (pcycle 2))++> ptake 10 (pinterleave (pwhite "x" 1 9) (pseries 10 1 5))

@@ -0,0 +1,7 @@+pn :: P a -> P Int -> P a++Repeats the enclosed pattern a number of times.++> import Sound.SC3.Lang.Pattern.List++> pn (pseq [1, 2, 3] 1) 4

@@ -0,0 +1,25 @@+pchoose :: String -> P a -> P a+prand :: String -> [P a] -> P Int -> P a++Returns one item from a finite pattern at random for each step. ++> import Sound.SC3.Lang.List++> let p = pchoose "x" (pseq [1, 2, 3, 4, 5] 1)+> in ptake 5 p++> prand "x" [ pseq [1, 2] 1+>           , pseq [3, 4] 1+>           , pseq [5, 6] 1 ] 10++The below cannot be written as intended with the list+based pattern library.  This is precisely because the+noise patterns are values, not processes with a state+threaded non-locally. ++> let p = pseq [prand "a" [pempty, pseq [24, 31, 36, 43, 48, 55] 1] 1+>              ,pseq [60, prand "b" [63, 65] 1+>                    ,67, prand "c" [70, 72, 74] 1] (pwhite "c" 2 5)+>              ,prand "d" [74, 75, 77, 79, 81] (pwhite "e" 3 9)] pinf+> in ptake 24 p+

@@ -0,0 +1,9 @@+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.List++> let p = pseq [1, 2, 3] 3+> in preject (== 1) p

@@ -0,0 +1,11 @@+repeat :: a -> [a]+prepeat :: a -> P a++pattern variant of Data.List.repeat++> import Sound.SC3.Lang.Pattern.List++> ptake 5 (prepeat 3)++> take 5 (repeat 3) == [3,3,3,3,3]+

@@ -0,0 +1,10 @@+rsd :: (Eq a) => [a] -> [a]+prsd :: (Eq a) => P a -> P a++Remove successive duplicates.++> import Sound.SC3.Lang.Pattern.List++> prsd (pseq [1,1,2,2,2,3,3] 1)++> rsd [1,1,2,2,2,3,3] == [1,2,3]

@@ -0,0 +1,35 @@+pseq :: [P a] -> P 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.List++> pseq [1, 2, 3] 2++Unlike Pseq, pseq does not have an offset argument to+give a starting offset into the list.++> import Sound.SC3.Lang.Collection++> pseq (rotate 3 [1, 2, 3, 4]) 3++Because the repeat counter is a pattern one can have+a random number of repeats.++> pseq [1, 2] (pwhite "u" 1 9)++For the same reason the pattern is static when re-examined.++> let p = pseq [0, pseq [1] (pwhite "u" 1 3), 2] 5+> in ptake 24 p++Only the first element of the repeat pattern is consulted.++> let p = pseq [1,2] 1+> in pseq [1] p++If one specifies the value pinf for the repeats variable, +then it will repeat indefinitely.++> ptake 9 (pseq [1, 2, 3] pinf)

@@ -0,0 +1,13 @@+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.++> import Sound.SC3.Lang.Pattern.List++> pser [1, 2, 3] 5++> pser [1, pser [100, 200] 3, 3] 9++> pser [1, 2, 3] 5 *. 3

@@ -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++> import Sound.SC3.Lang.Pattern.List++> pseries 0 2 24++> pseries 1.0 0.1 24

@@ -0,0 +1,19 @@+stutter :: [Int] -> [a] -> [a]+pstutter :: P Int -> P a -> P a++  count - number of repeats+      x - value pattern++Repeat each element of a pattern n times.++> import Sound.SC3.Lang.Pattern.List++> let p = pstutter (pcycle 2) (pseq [1, 2, 3] pinf)+> in ptake 13 p++> let { p = pseq [1, 2] pinf+>     ; q = pseq [1, 2, 3] pinf+>     ; r = pstutter p q }+> in ptake 13 r++> stutter [1,2,3] [4,5,6] == [4,5,5,6,6,6]

@@ -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.List++> let { a = pseq [1, 2, 3] 2+>     ; b = pseq [65, 76] 1+>     ; c = pswitch [a, b, 800] (pseq [2, 2, 0, 1] pinf) }+> in ptake 24 c

@@ -0,0 +1,18 @@+pswitch1 :: [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.++> import Sound.SC3.Lang.Pattern.List++> let { p = pseq [1, 2, 3] pinf+>     ; q = pseq [65, 76] pinf+>     ; r = pswitch1 [p, q, pn 800 3] (pseq [2, 0, 1] pinf) }+> in ptake 24 r

@@ -0,0 +1,14 @@+tail :: [a] -> [a]+ptail :: P a -> P a++Drop first element from pattern.++> import Sound.SC3.Lang.Pattern.List++> ptail (pseq [1, 2, 3] 1)++> ptail pempty++Note that the haskell tail function is partial.++> tail []

@@ -0,0 +1,10 @@+take :: Int -> [a] -> [a]+ptake :: P Int -> P a -> P a++> import Sound.SC3.Lang.Pattern.List++> ptake 5 (pseq [1,2,3] 5)++> ptake 5 (pseq [1,2,3] 1)++> take 5 [1..] == [1..5]

@@ -0,0 +1,22 @@+trigger :: [Bool] -> [a] -> [Maybe a]+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.List++> let { p = pseq [1, 2, 3] 1+>     ; t = pbool (pseq [0, 0, 1, 0, 0, 0, 1, 1] 1) } +> in ptrigger t p++> let { p = [1, 2, 3]+>     ; t = bool [0, 0, 1, 0, 0, 0, 1, 1] }+> in trigger t p

@@ -0,0 +1,35 @@+pwhite :: (Random a) => String -> P a -> P a -> P a++Uniform linear distribution in given range.++> import Sound.SC3.Lang.Pattern.List++> phead (pwhite "x" 0.0 1.0)++> ptake 5 (pwhite "x" 0.0 1.0)++It is important to note that this structure is not actually+indeterminate, so that the below is zero.++> let p = ptake 12 (pwhite "x" 0.0 1.0)+> in p - p++And likewise the below is a list of two equal elements.++> let { p = pwhite "x" 1 10+>     ; q = ptake 1 p }+> in pseq [q, q] 1++The below is alternately lower and higher noise.++> let { l = pseq [0.0, 10.0] 1+>     ; r = pseq [1.0, 11.0] 1+>     ; p = pwhite "x" l r }+> in ptake 12 p++Or equivalently,++> let { b = pseq [return (0.0, 1.0)+>                ,return (10.0, 11.0)] 1+>     ; p = pwhite "x" (fmap fst b) (fmap snd b) }+> in ptake 12 p

@@ -0,0 +1,12 @@+zip :: [a] -> [b] -> [(a, b)]+pzip :: P a -> P b -> P (a, b)++> import Sound.SC3.Lang.Pattern.List++> ptake 5 (pzip (prepeat 3) (prepeat 4))++Stops on shortest pattern.++> pzip (pseries 0 1 5) (pseries 0 (-1) 4)++> zip [1..] [3,2,1] == [(1,3),(2,2),(3,1)]

@@ -0,0 +1,12 @@+mappend :: P a -> P a -> P a++Sequence two patterns.  This is the mappend instance of Monoid.++> import Data.Monoid+> import Sound.SC3.Lang.Pattern.Step++> let { p = pseq [1, 2] 1+>     ; q = pseq [2, 3] 1 }+> in evalP (p `mappend` q)++> evalP (mempty `mappend` mempty)

@@ -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.Step++> let { p = pseq [1, 2, 3, 4, 5] 3+>     ; q = pseq [1, 0, 1, 0, 0, 0, 1, 1] 1 }+> in evalP (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 (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 (pclutch p q)

@@ -0,0 +1,9 @@+pcollect :: (a -> b) -> P a -> P b+pcollect = fmap++Patterns are functors.++> import Sound.SC3.Lang.Pattern.Step++> let p = pcollect (* 3) (pseq [1, 2, 3] 3)+> in evalP p

@@ -0,0 +1,3 @@+pcontinue :: P x -> (x -> P x -> P a) -> P a++> import Sound.SC3.Lang.Pattern.Step

@@ -0,0 +1,10 @@+pcountpre :: P Bool -> P Int+pcountpost :: P Bool -> P Int++> import Sound.SC3.Lang.Pattern.Step++> let p = pbool (pseq [0, 0, 1, 0, 0, 0, 1, 1] 1)+> in evalP (pcountpre p)++> let p = pbool (pseq [1, 0, 1, 0, 0, 0, 1, 1] 1)+> in evalP (pcountpost p)

@@ -0,0 +1,9 @@+pcycle :: P a -> P a++pattern variant of Data.List.cycle++> import Sound.SC3.Lang.Pattern.Step++> evalP (ptake 5 (pcycle (pseq [1,2,3] 1)))++[1,2,3,1,2]

@@ -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.Step++> 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 (pdegreeToKey p q r)++> let { p = pseq [0, 1, 2, 3, 4, 3, 2, 1, 0, 2, 4, 7, 4, 2] 2+>     ; q = pseq [return [0, 2, 4, 5, 7, 9, 11]+>                ,return [0, 2, 3, 5, 7, 8, 11]] 1+>     ; r = prepeat 12 }+> in evalP (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]

@@ -0,0 +1,8 @@+pdrop :: P Int -> P a -> P a++Drop first n element from pattern.++> import Sound.SC3.Lang.Pattern.Step++> let p = pseq [1, 2, 3] 4+> in evalP (pdrop 7 p)

@@ -0,0 +1,10 @@+mempty :: P a++The empty pattern.++> import Data.Monoid+> import Sound.SC3.Lang.Pattern.Step++> evalP mempty++> evalP (mempty `mappend` return 1)

@@ -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.Step++> let p = pexprand 0.01 0.99 12+> in evalP p++> let { l = pseq [1, 11] 1+>     ; r = pseq [2, 12] 1+>     ; p = pexprand l r 12 }+> in evalP p

@@ -0,0 +1,9 @@+pfilter :: (a -> Bool) -> P a -> P a++Allows values for which the predicate is true. ++> import Sound.SC3.Lang.Pattern.Step++> let { p = pseq [1, 2, 3] 3+>     ; q = pfilter (< 3) p }+> in evalP q

@@ -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.Step++> let p = pseq [1, 2, 3] pinf+> in evalP (pfin 5 p)++There is a variant where the count not a pattern.++> let p = pseq [1, 2, 3] 1+> in evalP (pfin_ 5 p)++Note that pfin does not extend the input pattern,+unlike pser.++> let p = pseq [1, 2, 3] 1+> in evalP (pser [p] 5)

@@ -0,0 +1,18 @@+pfix :: Int -> P a -> P a++> import Sound.SC3.Lang.Pattern.Step++The psuedo-random nodes are actually indeterminate.+To fix the value of these nodes use pfix.++> let p = pwhite 0.0 1.0 12+> in evalP (p - p)++> let p = pfix 0 (pwhite 0.0 1.0 12)+> in evalP (p - p)++The innermost pfix is binding.++> let p = pwhite 0.0 1.0 12+> in evalP (pzip (pfix 1 (pfix 0 p) - pfix 0 p)+>                (pfix 0 (pfix 1 p) - pfix 0 p))

@@ -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.Step++> let p = pgeom 1 2 12+> in evalP p++Real numbers work as well.++> let p = pgeom 1.0 1.1 6+> in evalP p

@@ -0,0 +1,14 @@+phead :: P a -> P a++Retain only the first element of a pattern.++> import Data.Monoid+> import Sound.SC3.Lang.Pattern.Step++> let p = pseq [1, 2, 3] 1+> in evalP (phead p)++> let p = pseq [1, 2, 3] 1+> in evalP (phead p `mappend` ptail p)++> evalP (phead mempty)

@@ -0,0 +1,34 @@+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++> import Sound.SC3.Lang.Pattern.Step++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 (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 (pif 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 (pzipWith3 if_f c p q)

@@ -0,0 +1,12 @@+pinterleave :: P a -> P a -> P a++Interleave elements from two patterns.++> import Sound.SC3.Lang.Pattern.Step++> let { p = pseq [1, 2, 3] 3+>     ; q = pseq [4, 5, 6, 7] 2 }+> in evalP (pinterleave p q)++> let p = pinterleave (pwhite 1 9 5) (pseries 10 1 10)+> in evalP p

@@ -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.Step++> let p = pn (pseq [1, 2, 3] 1) 4+> in evalP p++There is a variant with the arguments+reversed.++> let p = preplicate 4 (pseq [1, 2, 3] 1)+> in evalP p+

@@ -0,0 +1,30 @@+ppatlace :: [P a] -> P Int -> P a++     list - patterns to step through+  repeats - number of steps to take++Interlaced embedding of streams.  Similar to +Place, but the list is an array of streams or +patterns. The results of each stream will be+output in turn.++> import Sound.SC3.Lang.Pattern.Step++> let { w = pwhite 1 5 5+>     ; g = pgeom 10 1.01 10 }+> in evalP (ppatlace [w, g] 15)++> let { w = pwhite 1 5 5+>     ; g = pgeom 10 1.01 10 }+> in evalP (ptake 15 (ppatlacea (pseq (map return [w, g]) 1)))++Note that the ppatlace has an infinite number +of repeats, but the resulting stream is finite +because the member streams are all finite. +When the first stream (pwhite) comes to an end, +it is skipped and you see only the second +stream until it stops.++If even one member stream is infinite and +ppatlace has infinite repeats, the ppatlace +stream will also be infinite.

@@ -0,0 +1,21 @@+prand :: [P a] -> P Int -> P a++Returns one item from the list at random for each repeat. ++> import Sound.SC3.Lang.Pattern.Step++> let p = prand [1, 2, 3, 4, 5] 6+> in evalR "x" p++> let p = prand [ pseq [1, 2] 1+>               , pseq [3, 4] 1+>               , pseq [5, 6] 1 ] 9+> in evalR "x" p++> import Data.Monoid++> let p = pseq [prand [mempty, 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 (evalR "x" p)

@@ -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.Step++> let { p = pseq [1, 2, 3] 3+>     ; q = preject (== 1) p }+> in evalP q

@@ -0,0 +1,10 @@+prepeat :: a -> P a++pattern variant of Data.List.repeat++> import Sound.SC3.Lang.Pattern.Step++> evalP (ptake 5 (prepeat 3))++[3,3,3,3,3]+

@@ -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 p

@@ -0,0 +1,37 @@+> import Sound.SC3.Lang.Pattern.Step+> import System.IO++> data S = S { c :: Char }++> u :: Show a => (a, S) -> IO S+> u (a,_) = print a >> getChar >>= return . S++> s0 :: S+> s0 = S 'a'++> p :: P S Char+> p = prp (\s -> (pcons (c s) p, s))++> q :: P S (Char,Int)+> q = pzip p (pseq [1,2,3,4,5] 1)++> main :: IO ()+> main = do+>   hSetBuffering stdin NoBuffering+>   s <- u (('t',0), s0)+>   r <- runP s u (flip (:)) [] q+>   print (reverse r)++-- for below, set hsc3-literate-p to nil++import Sound.SC3.Lang.Pattern.Step+import System.IO++let { u (x,_) = print x >> getChar >>= return+    ; s0 = 'a'+    ; p = prp (\s -> (pcons s p, s))+    ; q = pzip p (pseq [1,2,3,4,5] 1) }+in do { hSetBuffering stdin NoBuffering+      ; s <- u (('t',0), s0)+      ; r <- runP s u (flip (:)) [] q+      ; print (reverse r) }

@@ -0,0 +1,8 @@+prsd :: (Eq a) => P a -> P a++Remove successive duplicates.++> import Sound.SC3.Lang.Pattern.Step++> let p = pseq [1,1,2,2,2,3,3] 1+> in evalP (prsd p)

@@ -0,0 +1,33 @@+pscan :: (x -> y -> (x, a)) -> Maybe (x -> a) -> x -> P y -> P a++Basic state threading function.  x is the state, an optional+final state to value function can be given if required.++> import Sound.SC3.Lang.Pattern.Step++> let { p = pzip (pbool (pseq [1,0,0,1,0] 1)) (pseq [1,2,3,4,5] 1)+>     ; f ys (b, x) = let r = if b then [x] else (x:ys) in (r, r) }+> in evalP (pscan f Nothing [] p)++[[1],[2,1],[3,2,1],[4],[5,4]]++> let { b = pbool (pseq [1,0,0,1,0,1] 1)+>     ; p = pseq [1,2,3] 1+>     ; q = pseq [11,12,13] 1+>     ; f (x, y) True = ((ptail x, y), phead x)+>     ; f (x, y) False = ((x, ptail y), phead y) }+> in evalP (psequence (pscan f Nothing (p,q) b))++[1,11,12,2,13,3]++> let { p = pbool (pseq [1,0,0,1,0,1] 1)+>     ; q = pseq [1,2,3] 2+>     ; r = pseq [11,12,13] 2+>     ; s = pzip3 p q r+>     ; f ([],ys) (True, x, y) = (([], ys ++ [y]), x)+>     ; f ((x':xs),ys) (True, x, y) = ((xs ++ [x], ys ++ [y]), x')+>     ; f (xs,[]) (False, x, y) = ((xs ++ [x], []), y)+>     ; f (xs,y':ys) (False, x, y) = ((xs++[x], ys ++ [y]), y') }+> in evalP (pscan f Nothing ([],[]) s)++[1,11,12,2,13,3]

@@ -0,0 +1,28 @@+pscanl :: (a -> y -> a) -> a -> P y -> P a++Pattern variant of scanl.  Takes the second argument and the +first item of the pattern and applies the function to them, then+feeds the function with this result and the second argument +and so on. Returns the pattern of intermediate and final results.++> import Sound.SC3.Lang.Pattern.Step++> evalP (pscanl (/) 64 (pseq [4, 2, 4] 1))++[64.0,16.0,8.0,2.0]++> evalP (pscanl (/) 3 mempty)++[3.0]++> evalP (pscanl max 5 (pseq [1, 2, 3, 4] 1))++[5,5,5,5,5]++> evalP (pscanl max 5 (pseq [1, 2, 3, 4, 5, 6, 7] 1))++[5,5,5,5,5,5,6,7]++> evalP (pscanl (\x y -> 2*x + y) 4 (pseq [1, 2, 3] 1))++[4, 9, 20, 43]

@@ -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.Step++> let a = pseq [1, 2, 3] 2+> in evalP 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 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 evalR "x" 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 (evalR "x" 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 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 p)++There is a variant with a true integer repeat count.++> let p = pseq_ [1, 2, 3] 5+> in evalP p

@@ -0,0 +1,16 @@+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.++> import Sound.SC3.Lang.Pattern.Step++> let p = pser [1, 2, 3] 5+> in evalP p++> let p = pser [1, pser [100, 200] 3, 3] 9+> in evalP p++> let p = pser [1, 2, 3] 5 *. 3+> in evalP p

@@ -0,0 +1,15 @@+pseries :: (Num a) => a -> a -> Int -> P a++An arithmetric series. ++  start - start value+   step - addition factor+ length - number of values++> import Sound.SC3.Lang.Pattern.Step++> let p = pseries 0 2 24+> in evalP p++> let p = pseries 1.0 0.1 24+> in evalP p

@@ -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.Step++> let p = pstutter 2 (pseq [1, 2, 3] pinf)+> in take 13 (evalP p)++> let { p = pseq [1, 2] pinf+>     ; q = pseq [1, 2, 3] pinf+>     ; r = pstutter p q }+> in take 13 (evalP 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 p)++> let p = pstutter' (pseq [2,3] 1) (pseq [1, 2, 3] pinf)+> in evalP p

@@ -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.Step++> 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 c)

@@ -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.Step++> 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 r)

@@ -0,0 +1,10 @@+ptail :: P a -> P a++Drop first element from pattern.++> import Sound.SC3.Lang.Pattern.Step++> let p = pseq [1, 2, 3] 1+> in evalP (ptail p)++> evalP (ptail mempty)

@@ -0,0 +1,7 @@+ptake :: P Int -> P a -> P a++> import Sound.SC3.Lang.Pattern.Step++> evalP (ptake 5 (pseq [1,2,3] pinf))++> evalP (ptake 5 (pseq [1,2,3] 1))

@@ -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.Step++> let { p = pseq [1, 2, 3, 4, 5] 3     +>     ; t = pbool (pseq [0, 0, 1, 0, 0, 0, 1, 1] 1) } +> in evalP (ptrigger t p)

@@ -0,0 +1,36 @@+pwhite :: (Random a) => P a -> P a -> P Int -> P a++Uniform linear distribution in given range.++> import Sound.SC3.Lang.Pattern.Step++> let p = pwhite 0.0 1.0 12+> in evalR "x" p++It is important to note that this structure is+actually indeterminate, so that the below is+non-zero.++> let p = pwhite 0.0 1.0 12+> in evalR "x" (p - p)++And likewise the below is a list of two possibly +different elements.++> let { p = pwhite 1 10 1+>     ; q = phead p }+> in evalR "x" (pseq [q, q] 1)++The below is alternately lower and higher noise.++> let { l = pseq [0.0, 10.0] 1+>     ; r = pseq [1.0, 11.0] 1+>     ; p = pwhite l r 12 }+> in evalR "x" 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 evalR "x" p

@@ -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.Step++> let { p = pseries 6 2 9+>     ; q = pwrap p 2 10 }+> in evalP q++> let { p = pseries 6 2 9+>     ; q = pwrap p 1 11 }+> in evalP q

@@ -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.Step++> let p = pxrand [1,2,3] 10+> in evalP p

@@ -1,251 +0,0 @@-> 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.

@@ -1,29 +0,0 @@-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)

@@ -1,9 +0,0 @@-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

@@ -1,10 +0,0 @@-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)

@@ -1,26 +0,0 @@-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]

@@ -1,8 +0,0 @@-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)

@@ -1,13 +0,0 @@-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

@@ -1,9 +0,0 @@-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

@@ -1,26 +0,0 @@-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)

@@ -1,17 +0,0 @@-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

@@ -1,41 +0,0 @@-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)

@@ -1,13 +0,0 @@-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-

@@ -1,16 +0,0 @@-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-

@@ -1,19 +0,0 @@-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)

@@ -1,10 +0,0 @@-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

@@ -1,11 +0,0 @@-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

@@ -1,8 +0,0 @@-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)

@@ -1,48 +0,0 @@-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

@@ -1,14 +0,0 @@-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

@@ -1,13 +0,0 @@-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

@@ -1,26 +0,0 @@-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

@@ -1,11 +0,0 @@-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)

@@ -1,22 +0,0 @@-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)

@@ -1,10 +0,0 @@-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)

@@ -1,17 +0,0 @@-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)

@@ -1,20 +0,0 @@-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

@@ -1,17 +0,0 @@-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

@@ -1,9 +0,0 @@-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

@@ -8,5 +8,5 @@   http://haskell.org/   http://audiosynth.com/ -(c) rohan drape, 2007-2009+(c) rohan drape, 2007-2010     gpl, http://gnu.org/copyleft/

@@ -1,8 +1,6 @@ module Sound.SC3.Lang      ( module Sound.SC3.Lang.Collection-    , module Sound.SC3.Lang.Math-    , module Sound.SC3.Lang.Pattern ) where+    , module Sound.SC3.Lang.Math ) where  import Sound.SC3.Lang.Collection import Sound.SC3.Lang.Math-import Sound.SC3.Lang.Pattern

@@ -2,6 +2,7 @@  import Control.Monad import Data.List+import Data.List.Split import Data.Maybe import Sound.SC3.Lang.Collection.Collection import System.Random@@ -54,34 +55,41 @@  -- | 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+indexIn e l =+    let f 0 = 0+        f j = let i = j - 1+                  right = l !! j+                  left = l !! i+              in if (e - left) < (right - e) then i else j+    in maybe (size l - 1) f (indexOfGreaterThan e l)  -- | 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+indexInBetween e l =+    let f 0 = 0+        f j = let i = fromIntegral j+                  a = l !! (j - 1)+                  b = l !! j+                  d = b - a+              in if d == 0 then i else ((e - a) / d) + i - 1+    in maybe (fromIntegral (size l) - 1) f (indexOfGreaterThan e l)  keep :: Int -> [a] -> [a]-keep n l | n < 0 = fromMaybe l (find (\e -> length e == negate n) (tails l))-         | otherwise = take n l+keep n l =+    if n < 0+    then drop (length l + n) l+    else take n l  drop' :: Int -> [a] -> [a]-drop' n l | n < 0 = take (length l + n) l-          | otherwise = drop n l+drop' n l =+    if n < 0+    then take (length l + n) l+    else drop n l  extendSequences :: [[a]] -> [[a]]-extendSequences l = map (take n . cycle) l-    where n = maximum (map length l)+extendSequences l =+    let n = maximum (map length l)+    in map (take n . cycle) l  flop :: [[a]] -> [[a]] flop = transpose . extendSequences@@ -90,31 +98,35 @@ 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 f (x1:x2:xs) =+    if f x1 x2+    then ([x1], x2:xs)+    else let g e (l,r) = (e:l, r)+         in x1 `g` separateAt f (x2:xs) 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+separate f l =+    let (e, r) = separateAt f l+    in if null r then [e] else e : separate f r  clump :: Int -> [a] -> [[a]]-clump n l = if null r then [e] else e : clump n r-    where (e, r) = splitAt n l+clump = splitEvery  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+clumps [] _ = []+clumps m s =+    let f [] _ = undefined+        f (n:ns) l = let (e, r) = splitAt n l+                     in if null r then [e] else e :clumps ns r+    in f (cycle m) s  -- | 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)+integrate (x:xs) =+    let f p c = (p + c, p + c)+    in x : snd (mapAccumL f x xs)  -- | d -> dx differentiate :: (Num a) => [a] -> [a]@@ -122,21 +134,24 @@  -- | 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 +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+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+zipWith_c f a b =+    let 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+    in g a b (False, False)  zip_c :: [a] -> [b] -> [(a, b)] zip_c = zipWith_c (,)

@@ -38,18 +38,21 @@ 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_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)+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)+degree_to_key d s n =+    let l = length s+        d' = round d+        a = (d - fromIntegral d') * 10.0 * (n / 12.0)+    in (n * fromIntegral (d' `div` l)) + (s !! (d' `mod` l)) + a  note :: Pitch a -> a note e = note_f e e

@@ -1,11 +0,0 @@-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

@@ -1,168 +0,0 @@-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) 

@@ -1,18 +0,0 @@-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 (-)

@@ -1,51 +1,335 @@ 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+import qualified Control.Applicative as A+import qualified Control.Monad as M+import qualified Data.Array as A+import qualified Data.Foldable as F+import qualified Data.HashTable as H+import qualified Data.List as L+import qualified Data.Monoid as M+import qualified Data.Traversable as T+import qualified Sound.SC3.Lang.Collection.Collection as S+import qualified Sound.SC3.Lang.Collection.SequenceableCollection as S+import qualified Sound.SC3.Lang.Math.Pitch as S+import qualified System.Random as R -pseq_ :: [P a] -> Int -> P a-pseq_ l n = plist (concat (replicate n l))+data P a = P { unP :: [a] } -pseq :: [P a] -> P Int -> P a-pseq l n = n >>= (\x -> plist (concat (replicate x l)))+-- * Instances --- | 'n' values from the infinite cycle of the streams at l.-pser_ :: [P a] -> Int -> P a-pser_ l n = prestrict_ n (plist l)+instance A.Alternative P where+    empty = pempty+    (<|>) = pappend +instance A.Applicative P where+    pure = M.return+    (<*>) = M.ap++instance F.Foldable P where+    foldr = pfoldr++instance (Fractional a) => Fractional (P a) where+    (/) = pzipWith (/)+    recip = fmap recip+    fromRational = return . fromRational++instance Functor P where+    fmap f = P . fmap f . unP++instance (Eq a) => Eq (P a) where+    (P p) == (P q) = p == q++instance Monad P where+    m >>= f = pconcatMap f m+    return x = P [x]++instance M.MonadPlus P where+    mzero = pempty+    mplus = pappend++instance M.Monoid (P a) where+    mempty = pempty+    mappend = pappend++instance (Num a) => Num (P a) where+    (+) = pzipWith (+)+    (-) = pzipWith (-)+    (*) = pzipWith (*)+    abs = fmap abs+    signum = fmap signum+    fromInteger = return . fromInteger+    negate = fmap negate++instance (Show a) => Show (P a) where+    show = show . unP++instance T.Traversable P where+    traverse f = let cons_f x ys = pcons A.<$> f x A.<*> ys+                 in pfoldr cons_f (A.pure pempty)++-- * Basic constructors++pinf :: P Int+pinf = return 83886028 -- 2 ^^ 23++-- * List functions++bool :: (Functor f, Ord a, Num a) => f a -> f Bool+bool = fmap (> 0)++clutch :: [a] -> [Bool] -> [a]+clutch p q =+    let r = fmap (+ 1) (countpost q)+    in stutter r p++-- | Count false values following each true value.+countpost :: [Bool] -> [Int]+countpost =+    let f i [] = [i]+        f i (x:xs) = if not x+                     then f (i + 1) xs+                     else i : f 0 xs+    in tail . f 0++-- | Count false values preceding each true value.+countpre :: [Bool] -> [Int]+countpre =+    let f i [] = if i == 0 then [] else [i]+        f i (x:xs) = if x +                     then i : f 0 xs+                     else f (i + 1) xs+    in f 0++interleave :: [a] -> [a] -> [a]+interleave p [] = p+interleave [] q = q+interleave (p:ps) (q:qs) = p : q : interleave ps qs++-- | Remove successive duplicates.+rsd :: (Eq a) => [a] -> [a]+rsd =+    let f _ [] = []+        f Nothing (x:xs) = x : f (Just x) xs+        f (Just y) (x:xs) = if x == y+                            then f (Just x) xs+                            else x : f (Just x) xs+    in f Nothing++stutter :: [Int] -> [a] -> [a]+stutter [] _ = []+stutter _ [] = []+stutter (n:ns) (p:ps) = replicate n p ++ stutter ns ps++trigger :: [Bool] -> [a] -> [Maybe a]+trigger p q =+    let r = countpre p+        f i x = replicate i Nothing ++ [Just x]+    in concat (zipWith f r q)++-- * Pattern functions++pappend :: P a -> P a -> P a+pappend p q = P (unP p ++ unP q)++papply :: P (a -> b) -> P a -> P b+papply (P f) (P x) = P (f A.<*> x)++pbool :: (Ord a, Num a) => P a -> P Bool+pbool = bool++pclutch :: P a -> P Bool -> P a+pclutch (P x) (P c) = P (clutch x c)++pcollect :: (a -> b) -> P a -> P b+pcollect = fmap++pcountpost :: P Bool -> P Int+pcountpost = P . countpost . unP++pcountpre :: P Bool -> P Int+pcountpre = P . countpre . unP++pconcat :: P (P a) -> P a+pconcat p =+    if pnull p+    then pempty+    else case phead p of+           Nothing -> pempty+           Just x -> x `pappend` (pconcat (ptail p))++pconcatMap :: (b -> P a) -> P b -> P a+pconcatMap f = pconcat . fmap f++pcons :: a -> P a -> P a+pcons x = P . (x:) . unP++pcycle :: P a -> P a+pcycle = P . L.cycle . unP++pdegreeToKey :: (RealFrac a) => P a -> P [a] -> P a -> P a+pdegreeToKey = pzipWith3 S.degree_to_key++pdrop :: P Int -> P a -> P a+pdrop n =+    case phead n of+      Nothing -> error "pdrop"+      Just n' -> P . L.drop n' . unP++pempty :: P a+pempty = P []++pfilter :: (a -> Bool) -> P a -> P a+pfilter f = P . L.filter f . unP++pfin :: P Int -> P a -> P a+pfin = ptake++pfoldr :: (a -> b -> b) -> b -> P a -> b+pfoldr f x = L.foldr f x . unP++pgeom :: (Num a) => a -> a -> Int -> P a+pgeom i s n = P (S.geom n i s)++phead :: P a -> Maybe a+phead (P []) = Nothing+phead (P (x:_)) = Just x++pinterleave :: P a -> P a -> P a+pinterleave (P p) (P q) = P (interleave p q)++pn :: P a -> P Int -> P a+pn (P p) n =+    let f 0 _ = []+        f i xs = xs ++ f (i - 1) xs+    in case phead n of+         Nothing -> error "preplicate"+         Just x -> P (f x p)++pnull :: P a -> Bool+pnull = L.null . unP++prepeat :: a -> P a+prepeat = P . L.repeat++preject :: (a -> Bool) -> P a -> P a+preject f =+    let g i _ = f i+    in P . S.reject g . unP++prsd :: (Eq a) => P a -> P a+prsd = P . rsd . unP++pseq :: [P a] -> P Int -> P a+pseq ps n =+    case phead n of+      Nothing -> error "pseq: empty repeat pattern"+      Just n' -> let ps' = concat (replicate n' ps)+                 in L.foldr pappend pempty ps'+ pser :: [P a] -> P Int -> P a-pser l n = prestrict n (plist l)+pser ps n = ptake n (pseq ps pinf) +pseries :: (Num a) => a -> a -> Int -> P a+pseries i s n = P (S.series n i s)++pstutter :: P Int -> P a -> P a+pstutter (P n) (P p) = P (stutter n p)+ 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..]+pswitch1 ps i =+    case phead i of+      Nothing -> pempty+      Just i' -> let (l, r) = splitAt i' ps+                     (p:_) = r+                     x = phead p+                     j = ptail i+                 in case x of+                      Nothing -> pswitch1 ps j+                      Just x' -> let ps' = l ++ [ptail p] ++ tail r+                                 in x' `pcons` pswitch1 ps' j -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)+ptail :: P a -> P a+ptail =+    let f [] = []+        f (_:xs) = xs+    in P . f . unP -{-+ptake :: P Int -> P a -> P a+ptake n =+    case phead n of+      Nothing -> error "ptake: empty length pattern"+      Just n' -> P . L.take n' . unP -Neither the definition above or the variant below are correct.-Both deadlock once all patterns are empty.  pswitch1 has the -same problem.  +ptrigger :: P Bool -> P a -> P (Maybe a)+ptrigger (P p) (P q) = P (trigger p q) -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--}+pzip :: P a -> P b -> P (a, b)+pzip (P p) (P q) = P (zip p q)++pzip3 :: P a -> P b -> P c -> P (a, b, c)+pzip3 (P p) (P q) (P r) = P (zip3 p q r)++pzipWith :: (a -> b -> c) -> P a -> P b -> P c+pzipWith f (P p) (P q) = P (L.zipWith f p q)++pzipWith3 :: (a -> b -> c -> d) -> P a -> P b -> P c -> P d+pzipWith3 f (P p) (P q) (P r) = P (L.zipWith3 f p q r)++-- * Random patterns++choosea :: R.StdGen -> A.Array Int a -> [a]+choosea g r = +    let (i, g') = R.randomR (A.bounds r) g+        x = r A.! i+    in x : choosea g' r++pchoose :: String -> P a -> P a+pchoose s (P p) = +    let g = R.mkStdGen (fromIntegral (H.hashString s))+    in P (choosea g (A.listArray (0, length p - 1) p))++pnoise :: (R.Random a) => String -> P a+pnoise s =+    let g = R.mkStdGen (fromIntegral (H.hashString s))+    in P (R.randoms g)++prand :: String -> [P a] -> P Int -> P a+prand s ps n = +    case phead n of+      Nothing -> error "prand"+      Just n' -> let g = R.mkStdGen (fromIntegral (H.hashString s))+                     qs = choosea g (A.listArray (0, length ps - 1) ps)+                 in L.foldr pappend pempty (take n' qs)++prand_b :: (R.Random a) => R.StdGen -> P (a,a) -> P a+prand_b g b =+    case phead b of+      Nothing -> pempty+      Just b' -> let (x, g') = R.randomR b' g+                 in pcons x (prand_b g' (ptail b))++pwhite :: (R.Random a) => String -> P a -> P  a -> P a+pwhite s l r =+    let b = pzip (pcycle l) (pcycle r)+        g = R.mkStdGen (fromIntegral (H.hashString s))+    in prand_b g b++-- * Extension++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 (-)

@@ -1,167 +0,0 @@-{-# 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

@@ -1,43 +0,0 @@-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

@@ -0,0 +1,440 @@+{-# LANGUAGE ExistentialQuantification #-}++module Sound.SC3.Lang.Pattern.Step where++import qualified Control.Applicative as A+import qualified Control.Monad as M+import qualified Data.Array as A+import qualified Data.HashTable as H+import qualified Data.IntMap as M+import qualified Data.List as L+import qualified Data.Maybe as M+import qualified Data.Monoid as M+import qualified Sound.SC3.Lang.Math.Pitch as S+import qualified System.Random as R++data P s a+    = Empty+    | Value a+    | RP (s -> (P s a, s))+    | Append (P s a) (P s a)+    | forall x . Unfoldr (x -> Maybe (a, x)) x+    | forall x . Continue (P s x) (x -> P s x -> P s a)+    | forall x . Apply (P s (x -> a)) (P s x)+    | forall x y . Scan (x -> y -> (x, a)) (Maybe (x -> a)) x (P s y)++data Result s a +    = Result s a (P s a)+    | Done s++step :: s -> P s a -> Result s a+step g Empty = Done g+step g (Value a) = Result g a M.mempty+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 (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')++runP :: Monad m =>+        s -> ((a, s) -> m s) -> (b -> a -> b) -> b -> P s a -> m b+runP s u f i p = do+  case step s p of+    Done _ -> return i+    Result s' a p' -> do s'' <- u (a, s')+                         runP s'' u f (f i a) p'++pfoldr' :: s -> (a -> b -> b) -> b -> P s 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')++evalP :: P () a -> [a]+evalP = pfoldr' () (:) []++evalR :: String -> P R.StdGen a -> [a]+evalR s =+    let g = R.mkStdGen (fromIntegral (H.hashString s))+    in pfoldr' g (:) []++instance (Show a) => Show (P s a) where+    show _ = show "a pattern"++instance (Eq a) => Eq (P s a) where+    _ == _ = False++instance M.Monad (P s) where+    (>>=) p f = Continue p (\x q -> f x `M.mappend` (>>=) q f)+    return = Value++instance M.MonadPlus (P s) where+    mzero = Empty+    mplus = Append++instance M.Monoid (P s a) where+    mempty = Empty+    mappend = Append++-- | Apply `f' pointwise to elements of `p' and `q'.+pzipWith :: (a -> b -> c) -> P s a -> P s b -> P s c+pzipWith f p = (A.<*>) (A.pure f A.<*> p)++instance (Num a) => Num (P s a) where+    (+) = pzipWith (+)+    (-) = pzipWith (-)+    (*) = pzipWith (*)+    abs = fmap abs+    signum = fmap signum+    fromInteger = return . fromInteger+    negate = fmap negate++instance (Fractional a) => Fractional (P s a) where+    (/) = pzipWith (/)+    recip = fmap recip+    fromRational = return . fromRational++pcycle :: P s a -> P s a+pcycle x = x `M.mappend` pcycle x++prepeat :: a -> P s a+prepeat = pcycle . return++instance Functor (P a) where+    fmap = (A.<*>) . prepeat++instance A.Applicative (P s) where+    pure = prepeat+    (<*>) = Apply++instance A.Alternative (P s) where+    empty = Empty+    (<|>) = Append++-- * Basic constructors++prp :: (s -> (P s a, s)) -> P s a+prp = RP++pinf :: P s Int+pinf = return 83886028 -- 2 ^^ 23++pcontinue :: P s x -> (x -> P s x -> P s a) -> P s a+pcontinue = Continue++pscan :: (x -> y -> (x, a)) -> Maybe (x -> a) -> x -> P s y -> P s a+pscan = Scan++punfoldr :: (x -> Maybe (a, x)) -> x -> P s a+punfoldr = Unfoldr++-- * Control++pfilter :: (a -> Bool) -> P s a -> P s a+pfilter f p =+    let g x p' = if f x+                 then M.mappend (return x) (pfilter f p')+                 else pfilter f p'+    in pcontinue p g++plist :: [P s a] -> P s a+plist = foldr M.mappend M.mempty++pcons :: a -> P s a -> P s a+pcons = M.mappend . return++preplicate_ :: Int -> P s a -> P s a+preplicate_ n p | n > 0 = M.mappend p (preplicate_ (n - 1) p)+                | otherwise = M.mempty++preplicate :: P s Int -> P s a -> P s a+preplicate n p = n >>= (\x -> preplicate_ x p)++pn :: P s a -> P s Int -> P s a+pn = flip preplicate++pn_ :: P s a -> Int -> P s a+pn_ = flip preplicate_++-- | 'n' initial values at 'p'.+ptake_ :: Int -> P s a -> P s a+ptake_ n p =+    let e = error "ptake_"+    in pzipWith const p (preplicate_ n (return e))++ptake :: P s Int -> P s a -> P s a+ptake n p =+    let e = error "ptake"+    in pzipWith const p (preplicate n (return e))++-- | 'n' initial values at pcycle of 'p'.+prestrict_ :: Int -> P s a -> P s a+prestrict_ n = ptake_ n . pcycle++prestrict :: P s Int -> P s a -> P s a+prestrict n = ptake n . pcycle++pmapMaybe :: (a -> Maybe b) -> P s a -> P s b+pmapMaybe f = fmap M.fromJust . pfilter M.isJust . fmap f++preject :: (a -> Bool) -> P s a -> P s a+preject f = pfilter (not . f)++pzipWith3 :: (a -> b -> c -> d) -> P s a -> P s b -> P s c -> P s d+pzipWith3 f p q = (A.<*>) (A.pure f A.<*> p A.<*> q)++pzipWith4 :: (a -> b -> c -> d -> e) -> +             P s a -> P s b -> P s c -> P s d -> P s e+pzipWith4 f p q r = (A.<*>) (A.pure f A.<*> p A.<*> q  A.<*> r)++pzip :: P s a -> P s b -> P s (a,b)+pzip = pzipWith (,)++pzip3 :: P s a -> P s b -> P s c -> P s (a,b,c)+pzip3 = pzipWith3 (,,)++pzip4 :: P s a -> P s b -> P s c -> P s d -> P s (a,b,c,d)+pzip4 = pzipWith4 (,,,)++pseries :: (Num a) => a -> a -> Int -> P s a+pseries i s n =+    let f (_, 0) = Nothing+        f (j, m) = Just (return j, (j + s, m - 1))+    in plist (L.unfoldr f (i, n))++pgeom :: (Num a) => a -> a -> Int -> P s a+pgeom i s n =+    let f (_, 0) = Nothing+        f (j, m) = Just (return j, (j * s, m - 1))+    in plist (L.unfoldr f (i, n))++pstutter' :: P s Int -> P s a -> P s a+pstutter' n p =+    let f :: Int -> a -> P s a+        f i e = preplicate (return i) (return e)+    in psequence (pzipWith f n p)++pstutter :: P s Int -> P s a -> P s a+pstutter = pstutter' . pcycle++-- | Count false values preceding each true value.+pcountpre :: P s Bool -> P s Int+pcountpre p =+    let f x e = if e then (0, Just x) else (x + 1, Nothing)+    in pmapMaybe id (pscan f Nothing 0 p)++-- | Count false values following each true value.+pcountpost :: P s Bool -> P s Int+pcountpost p =+    let f x e = if e then (0, Just x) else (x + 1, Nothing)+    in ptail (pmapMaybe id (pscan f (Just Just) 0 p))++pclutch' :: P s a -> P s Bool -> P s a+pclutch' p q =+    let r = fmap (+ 1) (pcountpost q)+    in pstutter' r p++pbool :: (Ord a, Num a) => P s a -> P s Bool+pbool = fmap (> 0)++pclutch :: (Num b, Ord b) => P s a -> P s b -> P s a+pclutch p = pclutch' p . pbool++pcollect :: (a -> b) -> P s a -> P s b+pcollect = fmap++pdegreeToKey :: (RealFrac a) => P s a -> P s [a] -> P s a -> P s a+pdegreeToKey = pzipWith3 S.degree_to_key++pfin :: P s Int -> P s a -> P s a+pfin = ptake++pfin_ :: Int -> P s a -> P s 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 s a -> P s a -> P s a -> P s a+pwrap x l r =+    let f x' l' r' = wrap l' r' x'+    in pzipWith3 f x (pcycle l) (pcycle r)++-- | Remove successive duplicates.+prsd :: (Eq a) => P s a -> P s a+prsd p =+    let f Nothing a = (Just a, Just a)+        f (Just x) a = (Just a, if a == x then Nothing else Just a)+    in pmapMaybe id (pscan f Nothing Nothing p)++psequence :: P s (P s a) -> P s a+psequence = M.join++pduple :: (a, a) -> P s a+pduple (x, y) = return x `M.mappend` return y++pinterleave :: P s a -> P s a -> P s a+pinterleave p = psequence . fmap pduple . pzip p++ptrigger :: P s Bool -> P s a -> P s (Maybe a)+ptrigger p q =+    let r = pcountpre p+        f i = M.mappend (preplicate_ i (return Nothing)) . return . Just+    in M.join (pzipWith f r q)++pif :: P s Bool -> P s a -> P s a -> P s a+pif b p q =+    let f (x, y) True = ((ptail x, y), phead x)+        f (x, y) False = ((x, ptail y), phead y)+    in psequence (pscan f Nothing (p,q) b)++phead :: P s a -> P s a+phead p = pcontinue p (\x _ -> return x)++ptail :: P s a -> P s a+ptail p = pcontinue p (\_ p' -> p')++pdrop :: P s Int -> P s a -> P s a+pdrop n p = n >>= (\x -> if x > 0+                         then pdrop (return (x-1)) (ptail p)+                         else p)++pscanl :: (a -> y -> a) -> a -> P s y -> P s a+pscanl f i p =+    let g x y = let r = f x y in (r, r)+    in pcons i (pscan g Nothing i p)++-- * Random numbers++prrandf :: (R.RandomGen s, R.Random a) => +           (a -> a -> a -> a) -> a -> a -> P s a+prrandf f l r = prp (\g -> let (x, g') = R.randomR (l,r) g+                           in (return (f l r x), g'))++prrand :: (R.RandomGen s, R.Random a) => +          a -> a -> P s a+prrand = prrandf (\_ _ x -> x)++prrandexp :: (R.RandomGen s, Floating a, R.Random a) => +             a -> a -> P s a+prrandexp = prrandf (\l r x -> l * (log (r / l) * x))++pchoosea :: (R.RandomGen s) => A.Array Int (P s a) -> P s a+pchoosea r = prp (\g -> let (i, g') = R.randomR (A.bounds r) g +                        in (r A.! i, g'))++pchoose :: R.RandomGen s => [P s a] -> P s a+pchoose l = pchoosea (A.listArray (0, length l - 1) l)++prand :: R.RandomGen s => [P s a] -> P s Int -> P s a+prand p = pseq [pchoose p]++pwhite :: (R.RandomGen s, R.Random a) => +          P s a -> P s a -> P s Int -> P s a+pwhite l r n = prestrict n (M.join (pzipWith prrand l r))++pexprand :: (R.RandomGen s, Floating a, R.Random a) => +            P s a -> P s a -> P s Int -> P s a+pexprand l r n = prestrict n (M.join (pzipWith prrandexp l r))++pxrand :: (R.RandomGen s, Eq a) => [P s a] -> P s Int -> P s a+pxrand p n = ptake n (prsd (pseq [pchoose p] pinf))++pwrand :: R.RandomGen s => [P s a] -> [P s a] -> P s Int -> P s a+pwrand = undefined++-- * List++pseq_ :: [P s a] -> Int -> P s a+pseq_ l n = plist (concat (replicate n l))++pseq :: [P s a] -> P s Int -> P s a+pseq l n = n >>= (\x -> plist (concat (replicate x l)))++-- | 'n' values from the infinite cycle of the streams at l.+pser_ :: [P s a] -> Int -> P s a+pser_ l n = prestrict_ n (plist l)++pser :: [P s a] -> P s Int -> P s a+pser l n = prestrict n (plist l)++pswitch :: [P s a] -> P s Int -> P s a+pswitch l i = i >>= (l !!)++pswitch1m :: M.IntMap (P s a) -> P s Int -> P s a+pswitch1m m is =+    let f i js = let h = phead (m M.! i)+                     t = ptail (m M.! i)+                 in h `M.mappend` pswitch1m (M.insert i t m) js+    in pcontinue is f++pswitch1 :: [P s a] -> P s Int -> P s a+pswitch1 = pswitch1m . M.fromList . zip [0..]++ppatlace :: [P s a] -> P s Int -> P s 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 s (P s a) -> P s 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+-}++-- * Extend++pzipWith_c :: (a -> b -> c) -> P s a -> P s b -> P s c+pzipWith_c f p = pzipWith f p . pcycle++infixl 7  *., /.+infixl 6  +., -.++(+.) :: Num a => P s a -> P s a -> P s a+(+.) = pzipWith_c (+)++(*.) :: Num a => P s a -> P s a -> P s a+(*.) = pzipWith_c (*)++(/.) :: Fractional a => P s a -> P s a -> P s a+(/.) = pzipWith_c (/)++(-.) :: Num a => P s a -> P s a -> P s a+(-.) = pzipWith_c (-)

@@ -1,70 +1,42 @@ Name:              hsc3-lang-Version:           0.7+Version:           0.8 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+Copyright:         (c) Rohan Drape, 2007-2010 Author:            Rohan Drape Maintainer:        rd@slavepianos.org Stability:         Experimental-Homepage:          http://slavepianos.org/rd/f/649352/-Tested-With:       GHC == 6.8.2+Homepage:          http://slavepianos.org/rd/?t=hsc3-lang+Tested-With:       GHC == 6.10.3 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+                   Help/Collection/*.help.lhs+                   Help/Math/*.help.lhs+                   Help/Pattern/List/*.help.lhs+                   Help/Pattern/Step/*.help.lhs  Library   Build-Depends:   array,-                   base == 3.*,+                   base == 4.*,                    containers,+                   split,                    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.Collection                    Sound.SC3.Lang.Collection.Numerical                    Sound.SC3.Lang.Collection.SequenceableCollection+                   Sound.SC3.Lang.Math                    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+                   Sound.SC3.Lang.Pattern.Step++Source-Repository  head+  Type:            darcs+  Location:        http://slavepianos.org/~rd/sw/hsc3-lang/