packages feed

tidal 0.9.4 → 0.9.5

raw patch · 16 files changed

+700/−328 lines, 16 filesdep ~hosc

Dependency ranges changed: hosc

Files

+ CHANGELOG.md view
@@ -0,0 +1,40 @@+# TidalCycles log of changes++## 0.9.5++### Enhancements++* Added `hurry` which both speeds up the sound and the pattern by the given amount.+* Added `stripe` which repeats a pattern a given number of times per+  cycle, with random but contiguous durations.+* Added continuous function `cosine`+* Turned more pattern transformation parameters into patterns - spread', striateX, every', inside, outside, swing+* Added experimental datatype for Xenakis sieves+* Correctly parse negative rationals+* Added `breakUp` that finds events that share the same timespan, and spreads them out during that timespan, so for example (breakUp "[bd,sn]") gets turned into the "bd sn"+* Added `fill` which 'fills in' gaps in one pattern with events from another. ++## 0.9.4++### Fixes++* Swapped `-` for `..` in ranges as quick fix for issue with parsing negative numbers+* Removed overloaded list thingie for now, unsure whether it's worth the dependency++## 0.9.3++### Enhancements++* The sequence parser can now expand ranges, e.g. `"0-3 4-2"` is+  equivalent to `"[0 1 2 3] [4 3 2]"`+* Sequences can now be described using list syntax, for example `sound ["bd", "sn"]` is equivalent to `sound "bd sn"`. They *aren't* lists though, so you can't for example do `sound (["bd", "sn"] ++ ["arpy", "cp"])` -- but can do `sound (append ["bd", "sn"]  ["arpy", "cp"])`+* New function `linger`, e.g. `linger (1/4)` will only play the first quarter of the given pattern, four times to fill the cycle. +* `discretise` now takes time value as its first parameter, not a pattern of time, which was causing problems and needs some careful thought.+* a `rel` alias for the `release` parameter, to match the `att` alias for `attack`+* `_fast` alias for `_density`+* The start of automatic testing for a holy bug-free future++### Fixes++* Fixed bug that was causing events to double up or get lost,+  e.g. where `rev` was combined with certain other functions.
Sound/Tidal/Chords.hs view
@@ -4,107 +4,99 @@ import Data.Maybe import Control.Applicative -major :: [Int]+major :: Num a => [a] major = [0,4,7]-minor :: [Int]+minor :: Num a => [a] minor = [0,3,7]-major7 :: [Int]+major7 :: Num a => [a] major7 = [0,4,7,11]-dom7 :: [Int]+dom7 :: Num a => [a] dom7 = [0,4,7,10]-minor7 :: [Int]+minor7 :: Num a => [a] minor7 = [0,3,7,10]-aug :: [Int]+aug :: Num a => [a] aug = [0,4,8]-dim :: [Int]+dim :: Num a => [a] dim = [0,3,6]-dim7 :: [Int]+dim7 :: Num a => [a] dim7 = [0,3,6,9]-one :: [Int]+one :: Num a => [a] one = [0]-five :: [Int]+five :: Num a => [a] five = [0,7]-plus :: [Int]+plus :: Num a => [a] plus = [0,4,8]-sharp5 :: [Int]+sharp5 :: Num a => [a] sharp5 = [0,4,8]-msharp5 :: [Int]+msharp5 :: Num a => [a] msharp5 = [0,3,8]-sus2 :: [Int]+sus2 :: Num a => [a] sus2 = [0,2,7]-sus4 :: [Int]+sus4 :: Num a => [a] sus4 = [0,5,7]-six :: [Int]+six :: Num a => [a] six = [0,4,7,9]-m6 :: [Int]+m6 :: Num a => [a] m6 = [0,3,7,9]-sevenSus2 :: [Int]+sevenSus2 :: Num a => [a] sevenSus2 = [0,2,7,10]-sevenSus4 :: [Int]+sevenSus4 :: Num a => [a] sevenSus4 = [0,5,7,10]-sevenFlat5 :: [Int]+sevenFlat5 :: Num a => [a] sevenFlat5 = [0,4,6,10]-m7flat5 :: [Int]+m7flat5 :: Num a => [a] m7flat5 = [0,3,6,10]-sevenSharp5 :: [Int]+sevenSharp5 :: Num a => [a] sevenSharp5 = [0,4,8,10]-m7sharp5 :: [Int]+m7sharp5 :: Num a => [a] m7sharp5 = [0,3,8,10]-nine :: [Int]+nine :: Num a => [a] nine = [0,4,7,10,14]-m9 :: [Int]+m9 :: Num a => [a] m9 = [0,3,7,10,14]-m7sharp9 :: [Int]+m7sharp9 :: Num a => [a] m7sharp9 = [0,3,7,10,14]-maj9 :: [Int]+maj9 :: Num a => [a] maj9 = [0,4,7,11,14]-nineSus4 :: [Int]+nineSus4 :: Num a => [a] nineSus4 = [0,5,7,10,14]-sixby9 :: [Int]+sixby9 :: Num a => [a] sixby9 = [0,4,7,9,14]-m6by9 :: [Int]+m6by9 :: Num a => [a] m6by9 = [0,3,9,7,14]-sevenFlat9 :: [Int]+sevenFlat9 :: Num a => [a] sevenFlat9 = [0,4,7,10,13]-m7flat9 :: [Int]+m7flat9 :: Num a => [a] m7flat9 = [0,3,7,10,13]-sevenFlat10 :: [Int]+sevenFlat10 :: Num a => [a] sevenFlat10 = [0,4,7,10,15]-nineSharp5 :: [Int]+nineSharp5 :: Num a => [a] nineSharp5 = [0,1,13]-m9sharp5 :: [Int]+m9sharp5 :: Num a => [a] m9sharp5 = [0,1,14]-sevenSharp5flat9 :: [Int]+sevenSharp5flat9 :: Num a => [a] sevenSharp5flat9 = [0,4,8,10,13]-m7sharp5flat9 :: [Int]+m7sharp5flat9 :: Num a => [a] m7sharp5flat9 = [0,3,8,10,13]-eleven :: [Int]+eleven :: Num a => [a] eleven = [0,4,7,10,14,17]-m11 :: [Int]+m11 :: Num a => [a] m11 = [0,3,7,10,14,17]-maj11 :: [Int]+maj11 :: Num a => [a] maj11 = [0,4,7,11,14,17]-evelenSharp :: [Int]+evelenSharp :: Num a => [a] evelenSharp = [0,4,7,10,14,18]-m11sharp :: [Int]+m11sharp :: Num a => [a] m11sharp = [0,3,7,10,14,18]-thirteen :: [Int]+thirteen :: Num a => [a] thirteen = [0,4,7,10,14,17,21]-m13 :: [Int]+m13 :: Num a => [a] m13 = [0,3,7,10,14,17,21]  -- | @chordate cs m n@ selects the @n@th "chord" (a chord is a list of Ints) -- from a list of chords @cs@ and transposes it by @m@ chordate :: Num b => [[b]] -> b -> Int -> [b] chordate cs m n = map (+m) $ cs!!n---- | @flatpat@ takes a Pattern of lists and pulls the list elements as--- separate Events-flatpat :: Pattern [a] -> Pattern a-flatpat p = stack [unMaybe $ fmap (`maybeInd` i) p | i <- [0..9]]-  where maybeInd xs i | i < length xs = Just $ xs!!i-                      | otherwise = Nothing-        unMaybe = (fromJust <$>) . filterValues isJust  -- | @enchord chords pn pc@ turns every note in the note pattern @pn@ into -- a chord, selecting from the chord lists @chords@ using the index pattern
Sound/Tidal/Context.hs view
@@ -13,6 +13,7 @@ import Sound.Tidal.Strategies as C import Sound.Tidal.Tempo as C import Sound.Tidal.Time as C+import Sound.Tidal.Sieve as C import Sound.Tidal.SuperCollider as C import Sound.Tidal.Params as C import Sound.Tidal.Transition as C
Sound/Tidal/Dirt.hs view
@@ -13,7 +13,7 @@ import Data.Maybe import Data.Fixed import Data.Ratio-import Data.List (elemIndex)+import Data.List (elemIndex, sort)  import Sound.Tidal.Stream import Sound.Tidal.OscStream@@ -23,7 +23,7 @@ import Sound.Tidal.Time import Sound.Tidal.Tempo import Sound.Tidal.Transition (transition, wash)-import Sound.Tidal.Utils (enumerate)+import Sound.Tidal.Utils (enumerate, fst')  dirt :: Shape dirt = Shape {   params = [ s_p,@@ -117,8 +117,9 @@   dirtToColour :: ParamPattern -> Pattern ColourD-dirtToColour p = s-  where s = fmap (\x -> maybe black (datumToColour) (Map.lookup (param dirt "s") x)) p+--dirtToColour p = s+--  where s = fmap (\x -> maybe black (datumToColour) (Map.lookup (param dirt "s") x)) p+dirtToColour = fmap (stringToColour . show)  showToColour :: Show a => a -> ColourD showToColour = stringToColour . show@@ -197,15 +198,21 @@ Note that `striate` uses the `begin` and `end` parameters internally. This means that if you're using `striate` (or `striate'`) you probably shouldn't also specify `begin` or `end`. -}-striate' :: Int -> Double -> ParamPattern -> ParamPattern-striate' n f p = fastcat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]+striate' :: Pattern Int -> Pattern Double -> ParamPattern -> ParamPattern+striate' = temporalParam2 _striate'++_striate' :: Int -> Double -> ParamPattern -> ParamPattern+_striate' n f p = fastcat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]   where off i p = p # begin (atom (slot * i) :: Pattern Double) # end (atom ((slot * i) + f) :: Pattern Double)         slot = (1 - f) / (fromIntegral n)  {- | like `striate`, but with an offset to the begin and end values -}-striateO :: Int -> Double -> ParamPattern -> ParamPattern-striateO n o p = _striate n p |+| begin (atom o :: Pattern Double) |+| end (atom o :: Pattern Double)+striateO :: Pattern Int -> Pattern Double -> ParamPattern -> ParamPattern+striateO = temporalParam2 _striateO +_striateO :: Int -> Double -> ParamPattern -> ParamPattern+_striateO n o p = _striate n p |+| begin (atom o :: Pattern Double) |+| end (atom o :: Pattern Double)+ {- | Just like `striate`, but also loops each sample chunk a number of times specified in the second argument. The primed version is just like `striate'`, where the loop count is the third argument. For example: @@ -215,10 +222,16 @@  Like `striate`, these use the `begin` and `end` parameters internally, as well as the `loop` parameter for these versions. -}-striateL :: Int -> Int -> ParamPattern -> ParamPattern-striateL n l p = _striate n p # loop (atom $ fromIntegral l)-striateL' n f l p = striate' n f p # loop (atom $ fromIntegral l)+striateL :: Pattern Int -> Pattern Int -> ParamPattern -> ParamPattern+striateL = temporalParam2 _striateL +striateL' :: Pattern Int -> Pattern Double -> Pattern Int -> ParamPattern -> ParamPattern+striateL' = temporalParam3 _striateL'++_striateL :: Int -> Int -> ParamPattern -> ParamPattern+_striateL n l p = _striate n p # loop (atom $ fromIntegral l)+_striateL' n f l p = _striate' n f p # loop (atom $ fromIntegral l)+ metronome = _slow 2 $ sound (p "[odx, [hh]*8]")  {-|@@ -300,7 +313,7 @@ -}  stut :: Pattern Integer -> Pattern Double -> Pattern Rational -> ParamPattern -> ParamPattern-stut n g t p = unwrap $ (\a b c -> _stut a b c p) <$> n <*> g <*> t+stut = temporalParam3 _stut  _stut :: Integer -> Double -> Rational -> ParamPattern -> ParamPattern _stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) `rotR` (p |*| gain (pure $ scale (fromIntegral x))))) [1..(steps-1)]))@@ -315,9 +328,41 @@  In this case there are two _overlays_ delayed by 1/3 of a cycle, where each has the @vowel@ filter applied. -}-stut' :: Integer -> Time -> (ParamPattern -> ParamPattern) -> ParamPattern -> ParamPattern-stut' steps steptime f p | steps <= 0 = p-                         | otherwise = overlay (f (steptime `rotR` stut' (steps-1) steptime f p)) p+stut' :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+stut' n t f p = unwrap $ (\a b -> _stut' a b f p) <$> n <*> t++_stut' :: (Num n, Ord n) => n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+_stut' steps steptime f p | steps <= 0 = p+                         | otherwise = overlay (f (steptime `rotR` _stut' (steps-1) steptime f p)) p++{- | @durPattern@ takes a pattern and returns the length of events in that+pattern as a new pattern.  For example the result of `durPattern "[a ~] b"`+would be `"[0.25 ~] 0.5"`.+-}++durPattern :: Pattern a -> Pattern Time+durPattern p = Pattern $ \a -> map eventLengthEvent $ arc p a+  where eventLengthEvent (a1@(s1,e1), a2, x) = (a1, a2, e1-s1)++{- | @durPattern'@ is similar to @durPattern@, but does some lookahead to try+to find the length of time to the *next* event. For example, the result of+`durPattern' "[a ~] b"` would be `"[0.5 ~] 0.5"`.+-}++durPattern' :: Pattern a -> Pattern Time+durPattern' p = Pattern $ \a@(s,e) -> map (eventDurToNext (arc p (s,e+1))) (arc p a)+      where eventDurToNext evs ev@(a1,a2,x) = (a1, a2, (nextNum (t ev) (mt evs)) - (t ev))+            t = fst . fst'+            mt = (map fst) . (map fst')+            nextNum a = head . sort . filter (\x -> x >a)++{- | @stutx@ is like @stut'@ but will limit the number of repeats using the +duration of the original sound.  This usually prevents overlapping "stutters"+from subsequent sounds.+-}++stutx :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+stutx n t f p = stut' (liftA2 min n (fmap floor $ durPattern' p / (t+0.001))) t f p  {-| same as `anticipate` though it allows you to specify the number of cycles until dropping to the new pattern, e.g.:
Sound/Tidal/Params.hs view
@@ -279,8 +279,8 @@  -- aliases att, chdecay, ctf, ctfg, delayfb, delayt, lbd, lch, lcl, lcp, lcr, lfoc, lfoi-   , lfop, lht, llt, loh, lsn, ohdecay, pit1, pit2, pit3, por, sag, scl, scp-   , scr, sld, std, stt, sus, tdecay, vcf, vco, voi+   , lfop, lht, llt, loh, lsn, ohdecay, phasdp, phasr, pit1, pit2, pit3, por, sag, scl, scp+   , scr, sld, std, stt, sus, tdecay, tremdp, tremr, vcf, vco, voi       :: Pattern Double -> ParamPattern att = attack bpf = bandf@@ -317,6 +317,8 @@ lpq_p = resonance_p lsn = lsnare ohdecay = ophatdecay+phasdp = phaserdepth+phasr = phaserrate pit1 = pitch1 pit2 = pitch2 pit3 = pitch3@@ -326,11 +328,14 @@ scl = sclaves scp = sclap scr = scrash+sz  = size sld = slide std = stutterdepth stt = stuttertime sus  = sustain tdecay = tomdecay+tremdp = tremolodepth+tremr = tremolorate vcf  = vcfegint vco  = vcoegint voi  = voice
Sound/Tidal/Parse.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}-{-# LANGUAGE LambdaCase, GADTs #-}+{-# LANGUAGE LambdaCase #-}  module Sound.Tidal.Parse where @@ -21,24 +21,23 @@ import Sound.Tidal.Time (Arc, Time)  -- | AST representation of patterns-data TPat a where-   TPat_Atom :: Parseable a => a -> TPat a-   TPat_Density :: Parseable a => Time -> (TPat a) -> (TPat a)-   -- We keep this distinct from '_density because of divide-by-zero:-   TPat_Slow :: Parseable a => Time -> TPat a -> TPat a-   TPat_Zoom :: Parseable a => Arc -> TPat a -> TPat a-   TPat_DegradeBy :: Parseable a => Double -> TPat a -> TPat a-   TPat_Silence :: Parseable a => TPat a-   TPat_Foot :: Parseable a => TPat a-   TPat_Enum :: Parseable a => TPat a-   TPat_EnumFromTo :: Parseable a => TPat a -> TPat a -> TPat a -   TPat_Cat :: Parseable a => [TPat a] -> TPat a-   TPat_Overlay :: Parseable a => TPat a -> TPat a -> TPat a-   TPat_ShiftL :: Parseable a => Time -> TPat a -> TPat a-   -- TPat_E Int Int (TPat a)-   TPat_pE :: Parseable a => TPat Int -> TPat Int -> TPat Integer -> TPat a -> TPat a --- deriving (Show)+data TPat a = TPat_Atom a+            | TPat_Density Time (TPat a)+            | TPat_Slow Time (TPat a)+            | TPat_Zoom Arc (TPat a)+            | TPat_DegradeBy Double (TPat a)+            | TPat_Silence+            | TPat_Foot+            | TPat_Elongate Int+            | TPat_EnumFromTo (TPat a) (TPat a)+            | TPat_Cat [TPat a]+            | TPat_TimeCat [TPat a]+            | TPat_Overlay (TPat a) (TPat a)+            | TPat_ShiftL Time (TPat a)+              -- TPat_E Int Int (TPat a)+            | TPat_pE (TPat Int) (TPat Int) (TPat Integer) (TPat a)+            deriving (Show)  instance Parseable a => Monoid (TPat a) where    mempty = TPat_Silence@@ -53,15 +52,21 @@    TPat_DegradeBy amt x -> _degradeBy amt $ toPat x    TPat_Silence -> silence    TPat_Cat xs -> fastcat $ map toPat xs+   TPat_TimeCat xs -> timeCat $ map (\(n, p) -> (toRational n, toPat p)) $ durations xs    TPat_Overlay x0 x1 -> overlay (toPat x0) (toPat x1)    TPat_ShiftL t x -> t `rotL` toPat x    TPat_pE n k s thing ->       unwrap $ eoff <$> toPat n <*> toPat k <*> toPat s <*> pure (toPat thing)    TPat_Foot -> error "Can't happen, feet (.'s) only used internally.."-   TPat_Enum -> error "Can't happen, enums (..'s) only used internally.."    TPat_EnumFromTo a b -> unwrap $ fromTo <$> (toPat a) <*> (toPat b)    -- TPat_EnumFromThenTo a b c -> unwrap $ fromThenTo <$> (toPat a) <*> (toPat b) <*> (toPat c) +durations :: [TPat a] -> [(Int, TPat a)]+durations [] = []+durations ((TPat_Elongate n):xs) = (n, TPat_Silence):(durations xs)+durations (a:(TPat_Elongate n):xs) = (n+1,a):(durations xs)+durations (a:xs) = (1,a):(durations xs)+ p :: Parseable a => String -> Pattern a p = toPat . parseTPat @@ -184,9 +189,15 @@                                     <|> return a                                <|> do symbol "."                                       return [TPat_Foot]-                  let ps' = TPat_Cat $ map TPat_Cat $ splitFeet $ concat ps+                               <|> do es <- many1 (symbol "_")+                                      return [TPat_Elongate (length es)]+                  let ps' = TPat_Cat $ map elongate $ splitFeet $ concat ps                   return (length ps, ps') +elongate xs | any (isElongate) xs = TPat_TimeCat xs+            | otherwise = TPat_Cat xs+  where isElongate (TPat_Elongate _) = True+        isElongate _ = False {- expandEnum :: Parseable t => Maybe (TPat t) -> [TPat t] -> [TPat t] expandEnum a [] = [a]@@ -369,19 +380,20 @@      return $ map (\x -> TPat_Zoom (x%n,(x+1)%n) thing) [0 .. (n-1)]  pRatio :: Parser (Rational)-pRatio = do n <- natural+pRatio = do s <- sign+            n <- natural             result <- do char '%'                          d <- natural                          return (n%d)                       <|>                       do char '.'-                         d <- natural+                         s <- many1 digit                          -- A hack, but not sure if doing this                          -- numerically would be any faster..-                         return (toRational $ ((read $ show n ++ "." ++ show d)  :: Double))+                         return (toRational $ ((read $ show n ++ "." ++ s)  :: Double))                       <|>                       return (n%1)-            return result+            return $ applySign s result  pRational :: Parser (TPat Rational) pRational = do r <- pRatio
Sound/Tidal/Pattern.hs view
@@ -22,6 +22,7 @@ import Sound.Tidal.Bjorklund  import Text.Show.Functions ()+import qualified Control.Exception as E  -- | The pattern datatype, a function from a time @Arc@ to @Event@ -- values. For discrete patterns, this returns the events which are@@ -304,9 +305,21 @@ temporalParam :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c) temporalParam f tv p = unwrap $ (\v -> f v p) <$> tv +temporalParam2 :: (a -> b -> Pattern c -> Pattern d) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d)+temporalParam2 f a b p = unwrap $ (\x y -> f x y p) <$> a <*> b++temporalParam3 :: (a -> b -> c -> Pattern d -> Pattern e) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e)+temporalParam3 f a b c p = unwrap $ (\x y z -> f x y z p) <$> a <*> b <*> c+ temporalParam' :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c) temporalParam' f tv p = unwrap' $ (\v -> f v p) <$> tv +temporalParam2' :: (a -> b -> Pattern c -> Pattern d) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d)+temporalParam2' f a b p = unwrap' $ (\x y -> f x y p) <$> a <*> b++temporalParam3' :: (a -> b -> c -> Pattern d -> Pattern e) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e)+temporalParam3' f a b c p = unwrap' $ (\x y z -> f x y z p) <$> a <*> b <*> c+ -- | @fast@ (also known as @density@) returns the given pattern with speed -- (or density) increased by the given @Time@ factor. Therefore @fast 2 p@ -- will return a pattern that is twice as fast, and @fast (1/3) p@@@ -314,6 +327,7 @@ fast :: Pattern Time -> Pattern a -> Pattern a fast = temporalParam _density +_fast :: Time -> Pattern a -> Pattern a _fast = _density  fast' :: Pattern Time -> Pattern a -> Pattern a@@ -325,7 +339,9 @@ density = fast  _density :: Time -> Pattern a -> Pattern a-_density r p = withResultTime (/ r) $ withQueryTime (* r) p+_density r p | r == 0 = silence+             | r < 0 = rev $ _density (0-r) p+             | otherwise = withResultTime (/ r) $ withQueryTime (* r) p  -- | @fastGap@ (also known as @densityGap@ is similar to @fast@ but maintains its cyclic -- alignment. For example, @fastGap 2 p@ would squash the events in@@ -423,9 +439,10 @@ -- | @rev p@ returns @p@ with the event positions in each cycle -- reversed (or mirrored). rev :: Pattern a -> Pattern a-rev p = splitQueries $ Pattern $ \a -> map makeWholeAbsolute $ mapSnds' mirrorArc $ map makeWholeRelative (arc p (mirrorArc a))+rev p = splitQueries $ Pattern $ \a -> map makeWholeAbsolute $ mapSnds' (mirrorArc (mid a)) $ map makeWholeRelative (arc p (mirrorArc (mid a) a))   where makeWholeRelative ((s,e), part@(s',e'), v) = ((s'-s, e-e'), part, v)         makeWholeAbsolute ((s,e), part@(s',e'), v) = ((s'-e,e'+s), part, v)+        mid (s,e) = (sam s) + 0.5  -- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that -- the pattern alternates between forwards and backwards.@@ -486,9 +503,12 @@ _every n f p = when ((== 0) . (`mod` n)) f p  -- | @every n o f'@ is like @every n f@ with an offset of @o@ cycles-every' :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-every' n o f = when ((== o) . (`mod` n)) f+every' :: Pattern Int -> Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+every' np op f p = do { n <- np; o <- op; _every' n o f p } +_every' :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+_every' n o f = when ((== o) . (`mod` n)) f+ -- | @foldEvery ns f p@ applies the function @f@ to @p@, and is applied for -- each cycle in @ns@. foldEvery :: [Int] -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a@@ -510,6 +530,10 @@ sine :: Pattern Double sine = sinewave +-- | @sine@ is a synonym for @0.25 ~> sine@.+cosine :: Pattern Double+cosine = 0.25 ~> sine+ -- | @sinerat@ is equivalent to @sinewave@ for @Rational@ values, -- suitable for use as @Time@ offsets. sinerat :: Pattern Rational@@ -836,6 +860,7 @@ plays a melody randomly choosing one of the four notes \"a\", \"e\", \"g\", \"c\". -} choose :: [a] -> Pattern a+choose [] =  E.throw (E.ErrorCall "Empty list. Nothing to choose from.") choose xs = (xs !!) <$> (irand $ length xs)  {- |@@ -954,6 +979,13 @@ wedge :: Time -> Pattern a -> Pattern a -> Pattern a wedge t p p' = overlay (densityGap (1/t) p) (t `rotR` densityGap (1/(1-t)) p') +timeCat :: [(Time, Pattern a)] -> Pattern a+timeCat tps = stack $ map (\(s,e,p) -> compress (s/total, e/total) p) $ arrange 0 tps+    where total = sum $ map fst tps+          arrange :: Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]+          arrange _ [] = []+          arrange t ((t',p):tps) = (t,t+t',p):(arrange (t+t') tps)+ {- | @whenmod@ has a similar form and behavior to `every`, but requires an additional number. Applies the function to the pattern, when the remainder of the current loop number divided by the first parameter,@@ -1059,10 +1091,9 @@ @ -} within :: Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-within (s,e) f p = stack [sliceArc (0,s) p,-                           compress (s,e) $ f $ zoom (s,e) p,-                           sliceArc (e,1) p-                          ]+within (s,e) f p = stack [playWhen (\t -> cyclePos t >= s && cyclePos t < e) $ f p,+                          playWhen (\t -> not $ cyclePos t >= s && cyclePos t < e) $ p+                         ]  revArc :: Arc -> Pattern a -> Pattern a revArc a = within a rev@@ -1234,7 +1265,7 @@ -- | @randcat ps@: does a @slowcat@ on the list of patterns @ps@ but -- randomises the order in which they are played. randcat :: [Pattern a] -> Pattern a-randcat ps = spread' (rotL) (discretise 1 $ ((%1) . fromIntegral) <$> (irand (length ps - 1) :: Pattern Int)) (slowcat ps)+randcat ps = spread' (rotL) (discretise 1 $ ((%1) . fromIntegral) <$> (irand (length ps) :: Pattern Int)) (slowcat ps)  -- @fromNote p@: converts a pattern of human-readable pitch names -- into pitch numbers. For example, @"cs2"@ will be parsed as C Sharp@@ -1303,8 +1334,53 @@ substruct :: Pattern String -> Pattern b -> Pattern b substruct s p = Pattern $ f   where f a = concatMap (\a' -> arc (compressTo a' p) a') $ (map fst' $ arc s a)-        compressTo (s,e) p = compress (cyclePos s, e-(sam s)) p +compressTo :: Arc -> Pattern a -> Pattern a+compressTo (s,e) p = compress (cyclePos s, e-(sam s)) p++randArcs :: Int -> Pattern [Arc]+randArcs n =+  do rs <- mapM (\x -> (pure $ (toRational x)/(toRational n)) <~ choose [1,2,3]) [0 .. (n-1)]+     let rats = map toRational rs+         total = sum rats+         pairs = pairUp $ accumulate $ map ((/total)) rats+     return $ pairs+       where pairUp [] = []+             pairUp xs = (0,head xs):(pairUp' xs)+             pairUp' [] = []+             pairUp' (a:[]) = []+             pairUp' (a:b:[]) = [(a,1)]+             pairUp' (a:b:xs) = (a,b):(pairUp' (b:xs))++randStruct n = splitQueries $ Pattern f+  where f (s,e) = mapSnds' fromJust $ filter (\(_,x,_) -> isJust x) $ as+          where as = map (\(n, (s',e')) -> ((s' + sam s, e' + sam s),+                                           subArc (s,e) (s' + sam s, e' + sam s),+                                           n+                                          )+                         ) $ enumerate $ thd' $ head $ arc (randArcs n) (sam s, nextSam s)++substruct' :: Pattern Int -> Pattern a -> Pattern a+substruct' s p = Pattern $ \a -> concatMap (\(a', _, i) -> arc (compressTo a' (inside (pure $ 1/toRational(length (arc s (sam (fst a), nextSam (fst a))))) (rotR (toRational i)) p)) a') (arc s a)++-- | @stripe n p@: repeats pattern @p@, @n@ times per cycle. So+-- similar to @fast@, but with random durations. The repetitions will+-- be continguous (touching, but not overlapping) and the durations+-- will add up to a single cycle. @n@ can be supplied as a pattern of+-- integers.+stripe :: Pattern Int -> Pattern a -> Pattern a+stripe = temporalParam _stripe++_stripe :: Int -> Pattern a -> Pattern a+_stripe = substruct' . randStruct++-- | @slowstripe n p@: The same as @stripe@, but the result is also+-- @n@ times slower, so that the mean average duration of the stripes+-- is exactly one cycle, and every @n@th stripe starts on a cycle+-- boundary (in indian classical terms, the @sam@).+slowstripe :: Pattern Int -> Pattern a -> Pattern a+slowstripe n = slow (toRational <$> n) . stripe n+ -- Lindenmayer patterns, these go well with the step sequencer -- general rule parser (strings map to strings) parseLMRule :: String -> [(String,String)]@@ -1329,7 +1405,7 @@ -} lindenmayer :: Int -> String -> String -> String lindenmayer _ _ [] = []-lindenmayer 1 r (c:cs) = (fromMaybe [c] $ lookup c $ parseLMRule' r) +lindenmayer 1 r (c:cs) = (fromMaybe [c] $ lookup c $ parseLMRule' r)                          ++ (lindenmayer 1 r cs) lindenmayer n r s = iterate (lindenmayer 1 r) s !! n @@ -1352,7 +1428,7 @@ @ d1 $ s (mask ("1 1 1 ~ 1 1 ~ 1" :: Pattern Bool)   (slowcat ["sn*8", "[cp*4 bd*4, bass*5]"] ))-  # n (run 8) +  # n (run 8) @  Due to the use of `slowcat` here, the same mask is first applied to `"sn*8"` and in the next cycle to `"[cp*4 bd*4, hc*5]".@@ -1362,7 +1438,7 @@ @ d1 $ s (mask ("1 ~ 1 ~ 1 1 ~ 1" :: Pattern Bool)   (slowcat ["can*8", "[cp*4 sn*4, jvbass*16]"] ))-  # n (run 8) +  # n (run 8) @  Detail: It is currently needed to explicitly _tell_ Tidal that the mask itself is a `Pattern Bool` as it cannot infer this by itself, otherwise it will complain as it does not know how to interpret your input.@@ -1411,12 +1487,16 @@ d1 $ chunk 4 (density 4) $ sound "cp sn arpy [mt lt]" @ -}-chunk :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+chunk :: Integer -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+chunk n f p = cat [within (i%(fromIntegral n),(i+1)%(fromIntegral n)) f p | i <- [0..n-1]]++{- chunk n f p = do i <- _slow (toRational n) $ run (fromIntegral n)                  within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p+-}  -- deprecated (renamed to chunk)-runWith :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+runWith :: Integer -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b runWith = chunk  {-| @chunk'@ works much the same as `chunk`, but runs from right to left.@@ -1429,10 +1509,10 @@ runWith' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b runWith' = chunk' -inside :: Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a-inside n f p = _density n $ f (_slow n p)+inside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a+inside n f p = density n $ f (slow n p) -outside :: Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a+outside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a outside n = inside (1/n)  loopFirst :: Pattern a -> Pattern a@@ -1441,37 +1521,37 @@           where minus = mapArc (subtract (sam s))                 plus = mapArc (+ (sam s)) -timeLoop :: Time -> Pattern a -> Pattern a+timeLoop :: Pattern Time -> Pattern a -> Pattern a timeLoop n = outside n loopFirst  seqPLoop :: [(Time, Time, Pattern a)] -> Pattern a-seqPLoop ps = timeLoop (maxT - minT) $ minT `rotL` seqP ps+seqPLoop ps = timeLoop (pure $ maxT - minT) $ minT `rotL` seqP ps   where minT = minimum $ map fst' ps         maxT = maximum $ map snd' ps  {- | @toScale@ lets you turn a pattern of notes within a scale (expressed as a list) to note numbers.  For example `toScale [0, 4, 7] "0 1 2 3"` will turn-into the pattern `"0 4 7 12"`.  It assumes your scale fits within an octave,+into the pattern `"0 4 7 12"`.  It assumes your scale fits within an octave; to change this use `toScale' size`.  Example:-`toscale' 24 [0,4,7,10,14,17] (run 8)` turns into `"0 4 7 10 14 17 24 28"`+`toScale' 24 [0,4,7,10,14,17] (run 8)` turns into `"0 4 7 10 14 17 24 28"` -}-toScale'::Int -> [Int] -> Pattern Int -> Pattern Int-toScale' o s p = (+) <$> fmap (s!!) notep <*> fmap (o*) octp-  where notep = fmap (`mod` (length s)) p-        octp  = fmap (`div` (length s)) p+toScale' :: Int -> [Int] -> Pattern Int -> Pattern Int+toScale' o s = fmap noteInScale+  where octave x = x `div` length s+        noteInScale x = (s !!! x) + o * octave x -toScale::[Int] -> Pattern Int -> Pattern Int+toScale :: [Int] -> Pattern Int -> Pattern Int toScale = toScale' 12  {- | `swingBy x n` divides a cycle into `n` slices and delays the notes in the second half of each slice by `x` fraction of a slice . @swing@ is an alias for `swingBy (1%3)` -}-swingBy::Time -> Time -> Pattern a -> Pattern a -swingBy x n = inside n (within (0.5,1) (x `rotR`))+swingBy :: Pattern Time -> Pattern Time -> Pattern a -> Pattern a+swingBy x n = inside n (within (0.5,1) (x ~>)) -swing :: Time -> Pattern a -> Pattern a -swing = swingBy (1%3)+swing :: Pattern Time -> Pattern a -> Pattern a+swing = swingBy (pure $ 1%3)  {- | `cycleChoose` is like `choose` but only picks a new item from the list once each cycle -}@@ -1481,7 +1561,7 @@         ctrand s = (timeToRand :: Time -> Double) $ fromIntegral $ (floor :: Time -> Int) $ sam s  {- | `shuffle n p` evenly divides one cycle of the pattern `p` into `n` parts,-and returns a random permutation of the parts each cycle.  For example, +and returns a random permutation of the parts each cycle.  For example, `shuffle 3 "a b c"` could return `"a b c"`, `"a c b"`, `"b a c"`, `"b c a"`, `"c a b"`, or `"c b a"`.  But it will **never** return `"a a a"`, because that is not a permutation of the parts.@@ -1489,18 +1569,18 @@ shuffle::Int -> Pattern a -> Pattern a shuffle n = fit' 1 n (_run n) (randpat n)   where randpat n = Pattern $ \(s,e) -> arc (p n $ sam s) (s,e)-        p n c = listToPat $ map snd $ sort $ zip +        p n c = listToPat $ map snd $ sort $ zip                   [timeToRand (c+i/n') | i <- [0..n'-1]] [0..n-1]         n' :: Time         n' = fromIntegral n  {- | `scramble n p` is like `shuffle` but randomly selects from the parts-of `p` instead of making permutations. +of `p` instead of making permutations. For example, `scramble 3 "a b c"` will randomly select 3 parts from `"a"` `"b"` and `"c"`, possibly repeating a single part. -} scramble::Int -> Pattern a -> Pattern a-scramble n = fit' 1 n (_run n) (_density (fromIntegral n) $ +scramble n = fit' 1 n (_run n) (_density (fromIntegral n) $   liftA2 (+) (pure 0) $ irand n)  ur :: Time -> Pattern String -> [Pattern a] -> Pattern a@@ -1525,7 +1605,7 @@         adjust (a, (p, f)) = f a p         transform (x:_) a = transform' x a         transform _ _ = id-        transform' str (s,e) p = s `rotR` (inside (1/(e-s)) (matchF str) p)+        transform' str (s,e) p = s `rotR` (inside (pure $ 1/(e-s)) (matchF str) p)         matchF str = fromMaybe id $ lookup str fs  inhabit :: [(String, Pattern a)] -> Pattern String -> Pattern a@@ -1543,3 +1623,41 @@         spaceArcs xs = map (\(a,b) -> (a/s,b/s)) $ markOut 0 xs         s = sum xs +-- | @flatpat@ takes a Pattern of lists and pulls the list elements as+-- separate Events+flatpat :: Pattern [a] -> Pattern a+flatpat p = Pattern $ \a -> (concatMap (\(b,b',xs) -> map (\x -> (b,b',x)) xs) $ arc p a)++-- | @layer@ takes a Pattern of lists and pulls the list elements as+-- separate Events+layer :: [a -> Pattern b] -> a -> Pattern b+layer fs p = stack $ map ($ p) fs++-- | @breakUp@ finds events that share the same timespan, and spreads them out during that timespan, so for example @breakUp "[bd,sn]"@ gets turned into @"bd sn"@+breakUp :: Pattern a -> Pattern a+breakUp p = Pattern $ \a -> munge $ arc p a+  where munge es = concatMap spreadOut (groupBy (\a b -> fst' a == fst' b) es)+        spreadOut xs = catMaybes $ map (\(n, x) -> shiftIt n (length xs) x) $ enumerate xs+        shiftIt n d ((s,e), a', v) = do a'' <- subArc (newS, newE) a'+                                        return ((newS, newE), a'', v)+          where newS = s + (dur*(fromIntegral n))+                newE = newS + dur+                dur = (e - s) / (fromIntegral d)++-- | @fill@ 'fills in' gaps in one pattern with events from another. For example @fill "bd" "cp ~ cp"@ would result in the equivalent of `"~ bd ~"`. This only finds gaps in a resulting pattern, in other words @"[bd ~, sn]"@ doesn't contain any gaps (because @sn@ covers it all), and @"bd ~ ~ sn"@ only contains a single gap that bridges two steps.+fill :: Pattern a -> Pattern a -> Pattern a+fill p' p = struct (splitQueries $ Pattern (f p)) p'+  where+    f p (s,e) = removeTolerance (s,e) $ invert (s-tolerance, e+tolerance) $ arc p (s-tolerance, e+tolerance)+    invert (s,e) es = map arcToEvent $ foldr remove [(s,e)] (map snd' es)+    remove (s,e) xs = concatMap (remove' (s, e)) xs+    remove' (s,e) (s',e') | s > s' && e < e' = [(s',s),(e,e')] -- inside+                          | s > s' && s < e' = [(s',s)] -- cut off right+                          | e > s' && e < e' = [(e,e')] -- cut off left+                          | s <= s' && e >= e' = [] -- swallow+                          | otherwise = [(s',e')] -- miss+    arcToEvent a = (a,a,"x")+    removeTolerance (s,e) es = concatMap (expand) $ mapSnds' f es+      where f (a) = concatMap (remove' (e,e+tolerance)) $ remove' (s-tolerance,s) a+            expand (a,xs,c) = map (\x -> (a,x,c)) xs+    tolerance = 0.01
Sound/Tidal/Scales.hs view
@@ -1,149 +1,149 @@ module Sound.Tidal.Scales where  -- five notes scales-minPent :: [Int]+minPent :: Num a => [a] minPent = [0,3,5,7,10]-majPent :: [Int]+majPent :: Num a => [a] majPent = [0,2,4,7,9]  --  another mode of major pentatonic-ritusen :: [Int]+ritusen :: Num a => [a] ritusen = [0,2,5,7,9]  -- another mode of major pentatonic-egyptian :: [Int]+egyptian :: Num a => [a] egyptian = [0,2,5,7,10]  ---kumai :: [Int]+kumai :: Num a => [a] kumai = [0,2,3,7,9]-hirajoshi :: [Int]+hirajoshi :: Num a => [a] hirajoshi = [0,2,3,7,8]-iwato :: [Int]+iwato :: Num a => [a] iwato = [0,1,5,6,10]-chinese :: [Int]+chinese :: Num a => [a] chinese = [0,4,6,7,11]-indian :: [Int]+indian :: Num a => [a] indian = [0,4,5,7,10]-pelog :: [Int]+pelog :: Num a => [a] pelog = [0,1,3,7,8]  ---prometheus :: [Int]+prometheus :: Num a => [a] prometheus = [0,2,4,6,11]-scriabin :: [Int]+scriabin :: Num a => [a] scriabin = [0,1,4,7,9]  -- han chinese pentatonic scales-gong :: [Int]+gong :: Num a => [a] gong = [0,2,4,7,9]-shang :: [Int]+shang :: Num a => [a] shang = [0,2,5,7,10]-jiao :: [Int]+jiao :: Num a => [a] jiao = [0,3,5,8,10]-zhi :: [Int]+zhi :: Num a => [a] zhi = [0,2,5,7,9]-yu :: [Int]+yu :: Num a => [a] yu = [0,3,5,7,10]  -- 6 note scales-whole :: [Int]+whole :: Num a => [a] whole = [0,2,4,6,8,10]-augmented :: [Int]+augmented :: Num a => [a] augmented = [0,3,4,7,8,11]-augmented2 :: [Int]+augmented2 :: Num a => [a] augmented2 = [0,1,4,5,8,9]  -- hexatonic modes with no tritone-hexMajor7 :: [Int]+hexMajor7 :: Num a => [a] hexMajor7 = [0,2,4,7,9,11]-hexDorian :: [Int]+hexDorian :: Num a => [a] hexDorian = [0,2,3,5,7,10]-hexPhrygian :: [Int]+hexPhrygian :: Num a => [a] hexPhrygian = [0,1,3,5,8,10]-hexSus :: [Int]+hexSus :: Num a => [a] hexSus = [0,2,5,7,9,10]-hexMajor6 :: [Int]+hexMajor6 :: Num a => [a] hexMajor6 = [0,2,4,5,7,9]-hexAeolian :: [Int]+hexAeolian :: Num a => [a] hexAeolian = [0,3,5,7,8,10]  -- 7 note scales-major :: [Int]+major :: Num a => [a] major = [0,2,4,5,7,9,11]-ionian :: [Int]+ionian :: Num a => [a] ionian = [0,2,4,5,7,9,11]-dorian :: [Int]+dorian :: Num a => [a] dorian = [0,2,3,5,7,9,10]-phrygian :: [Int]+phrygian :: Num a => [a] phrygian = [0,1,3,5,7,8,10]-lydian :: [Int]+lydian :: Num a => [a] lydian = [0,2,4,6,7,9,11]-mixolydian :: [Int]+mixolydian :: Num a => [a] mixolydian = [0,2,4,5,7,9,10]-aeolian :: [Int]+aeolian :: Num a => [a] aeolian = [0,2,3,5,7,8,10]-minor :: [Int]+minor :: Num a => [a] minor = [0,2,3,5,7,8,10]-locrian :: [Int]+locrian :: Num a => [a] locrian = [0,1,3,5,6,8,10]-harmonicMinor :: [Int]+harmonicMinor :: Num a => [a] harmonicMinor = [0,2,3,5,7,8,11]-harmonicMajor :: [Int]+harmonicMajor :: Num a => [a] harmonicMajor = [0,2,4,5,7,8,11]-melodicMinor :: [Int]+melodicMinor :: Num a => [a] melodicMinor = [0,2,3,5,7,9,11]-melodicMinorDesc :: [Int]+melodicMinorDesc :: Num a => [a] melodicMinorDesc = [0,2,3,5,7,8,10]-melodicMajor :: [Int]+melodicMajor :: Num a => [a] melodicMajor = [0,2,4,5,7,8,10]-bartok :: [Int]+bartok :: Num a => [a] bartok = [0,2,4,5,7,8,10]-hindu :: [Int]+hindu :: Num a => [a] hindu = [0,2,4,5,7,8,10]  -- raga modes-todi :: [Int]+todi :: Num a => [a] todi = [0,1,3,6,7,8,11]-purvi :: [Int]+purvi :: Num a => [a] purvi = [0,1,4,6,7,8,11]-marva :: [Int]+marva :: Num a => [a] marva = [0,1,4,6,7,9,11]-bhairav :: [Int]+bhairav :: Num a => [a] bhairav = [0,1,4,5,7,8,11]-ahirbhairav :: [Int]+ahirbhairav :: Num a => [a] ahirbhairav = [0,1,4,5,7,9,10]  ---superLocrian :: [Int]+superLocrian :: Num a => [a] superLocrian = [0,1,3,4,6,8,10]-romanianMinor :: [Int]+romanianMinor :: Num a => [a] romanianMinor = [0,2,3,6,7,9,10]-hungarianMinor :: [Int]+hungarianMinor :: Num a => [a] hungarianMinor = [0,2,3,6,7,8,11]-neapolitanMinor :: [Int]+neapolitanMinor :: Num a => [a] neapolitanMinor = [0,1,3,5,7,8,11]-enigmatic :: [Int]+enigmatic :: Num a => [a] enigmatic = [0,1,4,6,8,10,11]-spanish :: [Int]+spanish :: Num a => [a] spanish = [0,1,4,5,7,8,10]  -- modes of whole tones with added note ->-leadingWhole :: [Int]+leadingWhole :: Num a => [a] leadingWhole = [0,2,4,6,8,10,11]-lydianMinor :: [Int]+lydianMinor :: Num a => [a] lydianMinor = [0,2,4,6,7,8,10]-neapolitanMajor :: [Int]+neapolitanMajor :: Num a => [a] neapolitanMajor = [0,1,3,5,7,9,11]-locrianMajor :: [Int]+locrianMajor :: Num a => [a] locrianMajor = [0,2,4,5,6,8,10]  -- 8 note scales-diminished :: [Int]+diminished :: Num a => [a] diminished = [0,1,3,4,6,7,9,10]-diminished2 :: [Int]+diminished2 :: Num a => [a] diminished2 = [0,2,3,5,6,8,9,11]  -- 12 note scales-chromatic :: [Int]-chromatic = [0..11]+chromatic :: Num a => [a]+chromatic = [0,1,2,3,4,5,6,7,8,9,10,11]
+ Sound/Tidal/Sieve.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-name-shadowing #-}++module Sound.Tidal.Sieve where++import Control.Applicative+import Data.Monoid++import Sound.Tidal.Parse+import Sound.Tidal.Pattern+import Sound.Tidal.Strategies+import Sound.Tidal.Time++-- The 'Sieve' datatype, which represents a Xenakis sieve.+-- (for an overview, see www.mitpressjournals.org/doi/pdf/10.1162/0148926054094396)++data Sieve a = Sieve {sieveAt :: Int -> a}++instance Functor Sieve where+    fmap f s = Sieve $ \i -> f (sieveAt s i)++instance Applicative Sieve where+    pure b = Sieve $ \i -> b+    a <*> b = Sieve $ \i -> (sieveAt a i) (sieveAt b i)++-- | The basic notation for and constructor of a boolean 'Sieve' is @m\@\@n@,+-- which represents all integers whose modulo with @m@ is equal to @n@+infixl 9 @@ +(@@) :: Int -> Int -> Sieve Bool +m @@ i = Sieve $ \j -> (j `mod` m) == i++-- If Haskell's logic operators had been defined on a type class, we could+-- declare Sieve to be an instance, but they haven't so here we are++-- | @not'@ gives the complement of a sieve+not' :: Applicative f => f Bool -> f Bool+not' = fmap not++-- | @#||#@ gives the union (logical OR) of two sieves+infixl 2 #||#+(#||#) :: Applicative f => f Bool -> f Bool -> f Bool+(#||#) = liftA2 (||)++-- | @#&&#@ gives the intersection (logical AND) of two sieves+infixl 3 #&&#+(#&&#) :: Applicative f => f Bool -> f Bool -> f Bool+(#&&#) = liftA2 (&&)++-- | `#^^#` gives the exclusive disjunction (logical XOR) of two sieves+infixl 2 #^^#+(#^^#) :: Applicative f => f Bool -> f Bool -> f Bool+(#^^#) x y = (x #&&# not' y) #||# (y #&&# not' x)++-- | @sieveToList n@ returns a list of the values of the sieve for each+-- nonnegative integer less than @n@ +-- For example: @sieveToList 10 $ 3\@\@1@ returns +-- `[False, True, False, False, True, False, False, True, False, False]`+sieveToList :: Int -> Sieve a -> [a]+sieveToList n s = map (sieveAt s) [0..n-1]++-- | @sieveToString n@ represents the sieve as a character string, where+-- @-@ represents False and @x@ represents True+sieveToString :: Int -> Sieve Bool -> [Char]+sieveToString n s = map b2c $ sieveToList n s+    where b2c b | b == True = 'x' | otherwise = '-'++-- | @sieveToInts n@ returns a list of nonnegative integers less than @n@+-- where the sieve is True+sieveToInts :: Int -> Sieve Bool -> [Int]+sieveToInts n s = map snd $ filter fst $ zip (sieveToList n s) [0..n-1]++-- | @sieveToPat n@ returns a pattern where the cycle is divided into @n@+-- beats, and there is an event whenever the matching beat number is in the+-- sieve+-- For example: @sieveToPat 8 $ 3\@\@1@ returns @"~ x ~ ~ x ~ ~ x"@+sieveToPat :: Int -> Sieve Bool -> Pattern String+sieveToPat n s = p $ concatMap b2s $ sieveToList n s where+  b2s b | b == True = "x " | otherwise = "~ "++-- | @stepSieve n str@ works like 'sieveToPat' but uses @str@ in the pattern+-- instead of @x@+stepSieve :: Int -> String -> Sieve Bool -> Pattern String+stepSieve n str sieve = step str (sieveToString n sieve)++-- | @slowstepSieve t@ is shorthand for applying @slow t@ to the result of+-- `stepSieve`+slowstepSieve :: Pattern Time -> Int -> String -> Sieve Bool -> Pattern String+slowstepSieve t n str sieve = slow t $ stepSieve n str sieve++-- | @scaleSieve n@ uses 'sieveToInts' to turn a sieve into a list of+-- integers, and then uses that with the @toScale@ function to+-- turn a pattern of numbers into a pattern of notes in the scale.+-- For example: @scaleSieve 8 (3\@\@1) "0 1 2 1"@ first converts the sieve+-- to the scale @[1, 4, 7]@ and then uses that with @toScale@ to return the+-- pattern @"1 4 7 4"@+scaleSieve :: Int -> Sieve Bool -> Pattern Int -> Pattern Int+scaleSieve n sieve = toScale (sieveToInts n sieve)++instance Show (Sieve Bool) where +    show = sieveToString 32
Sound/Tidal/Strategies.hs view
@@ -409,3 +409,6 @@     warpP n p = thread (warp n) n p     maskedWeft n p = Sound.Tidal.Pattern.mask (every 2 rev $ _density ((n)%2) "~ 1" :: Pattern Int) $ weftP n p     maskedWarp n p = mask (every 2 rev $ _density ((n)%2) "1 ~" :: Pattern Int) $ warpP n p++hurry :: Pattern Rational -> ParamPattern -> ParamPattern+hurry x = (|*| speed (fromRational <$> x)) . fast x
Sound/Tidal/Tempo.hs view
@@ -9,7 +9,7 @@ import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.MVar import Control.Monad.Trans (liftIO)-import Data.Maybe (fromMaybe, maybe)+import Data.Maybe (fromMaybe, maybe, isJust, fromJust) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T@@ -28,6 +28,13 @@  type ClientState = [TConnection] +data ServerMode = Master+                | Slave UDP++instance Show ServerMode where+  show Master = "Master"+  show _ = "Slave"+ data TConnection = TConnection Unique WS.Connection  wsConn :: TConnection -> WS.Connection@@ -50,6 +57,14 @@ getServerPort =    maybe 9160 (readNote "port parse") <$> lookupEnv "TIDAL_TEMPO_PORT" +getMasterPort :: IO Int+getMasterPort =+   maybe 6042 (readNote "port parse") <$> lookupEnv "TIDAL_MASTER_PORT"++getSlavePort :: IO Int+getSlavePort =+   maybe 6043 (readNote "port parse") <$> lookupEnv "TIDAL_SLAVE_PORT"+ readTempo :: String -> Tempo readTempo x = Tempo (read a) (read b) (read c) (read d) (read e)   where (a:b:c:d:e:_) = wordsBy (== ',') x@@ -77,9 +92,8 @@  clientApp :: MVar Tempo -> MVar Double -> MVar Double -> WS.ClientApp () clientApp mTempo mCps mNudge conn = do-  --sink <- WS.getSink-    liftIO $ forkIO $ sendCps conn mTempo mCps-    liftIO $ forkIO $ sendNudge conn mTempo mNudge+    liftIO $ forkIO $ sendCps conn mCps+    liftIO $ forkIO $ sendNudge conn mNudge     forever loop   where     loop = do@@ -91,21 +105,18 @@         -- putStrLn $ "to: " ++ show tempo         liftIO $ putMVar mTempo tempo -sendTempo :: WS.Connection -> Tempo -> IO ()-sendTempo conn t = WS.sendTextData conn (T.pack $ show t)+sendTempo :: [WS.Connection] -> Tempo -> IO ()+sendTempo conns t = mapM_ (\conn -> WS.sendTextData conn (T.pack $ show t)) conns -sendCps :: WS.Connection -> MVar Tempo -> MVar Double -> IO ()-sendCps conn mTempo mCps = forever $ do-    cps <- takeMVar mCps-    t <- readMVar mTempo-    t' <- updateTempo t cps-    sendTempo conn t'+sendCps :: WS.Connection -> MVar Double -> IO ()+sendCps conn mCps = forever $ do cps <- takeMVar mCps+                                 let m = "cps " ++ (show cps)+                                 WS.sendTextData conn (T.pack m) -sendNudge :: WS.Connection -> MVar Tempo -> MVar Double -> IO ()-sendNudge conn mTempo mNudge = forever $ do-    secs <- takeMVar mNudge-    t <- readMVar mTempo-    sendTempo conn $ nudgeTempo t secs+sendNudge :: WS.Connection -> MVar Double -> IO ()+sendNudge conn mNudge = forever $ do nudge <- takeMVar mNudge+                                     let m = "nudge " ++ (show nudge)+                                     WS.sendTextData conn (T.pack m)  connectClient :: Bool -> String -> MVar Tempo -> MVar Double -> MVar Double -> IO () connectClient secondTry ip mTempo mCps mNudge = do @@ -156,34 +167,6 @@                return f clocked :: (Tempo -> Int -> IO ()) -> IO () clocked = clockedTick 1--{--clocked callback = -  do (mTempo, mCps) <- runClient-     t <- readMVar mTempo-     now <- getCurrentTime-     let delta = realToFrac $ diffUTCTime now (at t)-         beatDelta = cps t * delta-         nowBeat = beat t + beatDelta-         nextBeat = ceiling nowBeat-         -- next4 = nextBeat + (4 - (nextBeat `mod` 4))-     loop mTempo nextBeat-  where loop mTempo b = -          do t <- readMVar mTempo-             b' <- doSlice t b-             loop mTempo $ b'-        -- wait an eighth of a cycle if we're paused-        doSlice t b | paused t = threadDelay $ floor ((0.125 / cps t) * 1000000)-                    | otherwise =-          do now <- getCurrentTime-             let delta = realToFrac $ diffUTCTime now (at t)-                 actualBeat = (beat t) + ((cps t) * delta)-                 beatDelta = (fromIntegral b) - actualBeat-                 delay = beatDelta / (cps t)-             threadDelay $ floor (delay * 1000000)-             callback t b-             return $ b + 1--}                           clockedTick :: Int -> (Tempo -> Int -> IO ()) -> IO () clockedTick tpb callback = @@ -224,15 +207,6 @@                          | otherwise = tick + 1              return $ newTick ---updateTempo :: MVar Tempo -> Maybe Double -> IO ()---updateTempo mt Nothing = return ()---updateTempo mt (Just cps') = do t <- takeMVar mt---                                now <- getCurrentTime---                                let delta = realToFrac $ diffUTCTime now (at t)---                                    beat' = (beat t) + ((cps t) * delta)---                                putMVar mt $ Tempo now beat' cps' (paused t)-- updateTempo :: Tempo -> Double -> IO (Tempo) updateTempo t cps'   | paused t == True && cps' > 0 =@@ -264,53 +238,70 @@   l <- getLatency   tempoState <- newMVar (Tempo start 0 1 False l)   clientState <- newMVar []-  liftIO $ oscBridge clientState-  forkIO $ WS.runServer "0.0.0.0" serverPort $ serverApp tempoState clientState+  serverState <- newMVar Master+  --liftIO $ oscBridge clientState+  liftIO $ slave serverState clientState+  forkIO $ WS.runServer "0.0.0.0" serverPort $ serverApp tempoState serverState clientState -serverApp :: MVar Tempo -> MVar ClientState -> WS.ServerApp-serverApp tempoState clientState pending = do+serverApp :: MVar Tempo -> MVar ServerMode -> MVar ClientState -> WS.ServerApp+serverApp tempoState serverState clientState pending = do     conn <- TConnection <$> newUnique <*> WS.acceptRequest pending     tempo <- liftIO $ readMVar tempoState     liftIO $ WS.sendTextData (wsConn conn) $ T.pack $ show tempo     clients <- liftIO $ readMVar clientState     liftIO $ modifyMVar_ clientState $ return . (conn:)-    serverLoop conn tempoState clientState+    serverLoop conn tempoState serverState clientState -oscBridge :: MVar ClientState -> IO ()-oscBridge clientState =-  do -- putStrLn $ "start osc bridge"-     osc <- liftIO $ udpServer "0.0.0.0" 6060-     _ <- forkIO $ loop osc+slave :: MVar ServerMode -> MVar ClientState -> IO ()+slave serverState clientState =+  do slavePort <- getSlavePort+     slaveSock <- udpServer "127.0.0.1" (fromIntegral slavePort)+     _ <- forkIO $ loop slaveSock      return ()-  where loop osc =-          do b <- recvBundle osc-             -- putStrLn $ "received bundle" ++ (show b)-             let timestamp = addUTCTime (realToFrac $ ntpr_to_ut $ bundleTime b) ut_epoch-                 msg = head $ bundleMessages b-                 -- todo - Data.Maybe version of !!-                 tick = datum_floating $ (messageDatum msg) !! 0-                 tempo = datum_floating $ (messageDatum msg) !! 1-                 address = messageAddress msg-             act address timestamp tick tempo-             loop osc-        act "/sync" timestamp (Just tick) (Just tempo)-          = do -- putStrLn $ "time " ++ show timestamp ++ " tick " ++ show tick ++ " tempo " ++ show tempo-               let t = Tempo {at = timestamp, beat = tick, cps = tempo,-                              paused = False,-                              clockLatency = 0-                             }-                   msg = T.pack $ show t-               clients <- readMVar clientState-               broadcast msg clients-               return ()-        act _ _ _ _  = return ()+  where loop slaveSock =+          do ms <- recvMessages slaveSock+             mapM_ (\m -> slaveAct (messageAddress m) serverState clientState m) ms+             loop slaveSock -serverLoop :: TConnection -> MVar Tempo -> MVar ClientState -> IO ()-serverLoop conn _tempoState clientState = E.handle catchDisconnect $+slaveAct :: String -> MVar ServerMode -> MVar ClientState -> Message -> IO ()+slaveAct "/tempo" serverState clientState m+  | isJust t = do clients <- readMVar clientState+                  setSlave serverState+                  sendTempo (map wsConn clients) (fromJust t)+  | otherwise = return ()+  where t = do beat' <- datum_floating $ (messageDatum m) !! 2+               cps' <- datum_floating $ (messageDatum m) !! 3+               return $ Tempo {at = ut,+                               beat = beat',+                               cps = cps',+                               paused = False,+                               clockLatency = 0+                              }+        ut = addUTCTime (realToFrac $ dsec) ut_epoch+        sec = fromJust $ datum_int32 $ (messageDatum m) !! 0+        usec = fromJust $ datum_int32 $ (messageDatum m) !! 1+        dsec = ((fromIntegral sec) + ((fromIntegral usec) / 1000000)) :: Double++setSlave :: MVar ServerMode -> IO ()+setSlave serverState = do s <- takeMVar serverState+                          s' <- updateState s+                          putMVar serverState s'+                          return ()+     where updateState Master = do putStrLn "Slaving tempo.."+                                   masterPort <- getMasterPort+                                   sock <- openUDP "127.0.0.1" (fromIntegral masterPort)+                                   return (Slave sock)+           -- already slaving..+           updateState s = return s+                          +serverLoop :: TConnection -> MVar Tempo -> MVar ServerMode -> MVar ClientState -> IO ()+serverLoop conn tempoState serverState clientState = E.handle catchDisconnect $   forever $ do     msg <- WS.receiveData $ wsConn conn     --liftIO $ updateTempo tempoState $ maybeRead $ T.unpack msg-    liftIO $ readMVar clientState >>= broadcast msg+    mode <- readMVar serverState+    serverAct (T.unpack msg) mode tempoState clientState+    --      --tempo <- liftIO $ readMVar tempoState     -- liftIO $ readMVar clientState >>= broadcast (T.pack $ show tempo)    where@@ -320,3 +311,32 @@             return s'         _ -> return () ++serverAct :: String -> ServerMode -> MVar Tempo -> MVar ClientState -> IO ()+serverAct ('c':'p':'s':' ':n) mode tempoState clientState = setCps (read n) mode tempoState clientState+serverAct ('n':'u':'d':'g':'e':' ':n) mode tempoState clientState = setNudge (read n) mode tempoState clientState+serverAct s _ _ _ = do putStrLn $ "tempo server received unknown message " ++ s+                       return ()++setCps :: Double -> ServerMode -> MVar Tempo -> MVar ClientState -> IO ()+setCps n Master tempoState clientState = do tempo <- takeMVar tempoState+                                            tempo' <- updateTempo tempo (n :: Double)+                                            clients <- readMVar clientState+                                            sendTempo (map wsConn clients) (tempo')+                                            putMVar tempoState tempo'+                                            return ()+                                            +setCps n (Slave sock) tempoState clientState = sendOSC sock $ Message "/cps" [Float (realToFrac n)]+++setNudge :: Double -> ServerMode -> MVar Tempo -> MVar ClientState -> IO ()+setNudge n Master tempoState clientState = do tempo <- takeMVar tempoState+                                              let tempo' = nudgeTempo tempo n+                                              clients <- readMVar clientState+                                              sendTempo (map wsConn clients) (tempo')+                                              putMVar tempoState tempo'+                                              return ()+                                              +setNudge n (Slave sock) tempoState clientState = sendOSC sock $ Message "/nudge" [Float (realToFrac n)]++
Sound/Tidal/Time.hs view
@@ -76,9 +76,9 @@ mapCycle f (s,e) = (sam' + (f $ s - sam'), sam' + (f $ e - sam'))          where sam' = sam s --- | Returns the `mirror image' of an @Arc@, used by @Sound.Tidal.Pattern.rev@.-mirrorArc :: Arc -> Arc-mirrorArc (s, e) = (sam s + (nextSam s - e), nextSam s - (s - sam s))+-- | Returns the `mirror image' of an @Arc@ around the given point intime, used by @Sound.Tidal.Pattern.rev@.+mirrorArc :: Time -> Arc -> Arc+mirrorArc mid (s, e) = (mid - (e-mid), mid+(mid-s))  -- | The start time of the given @Event@ eventStart :: Event a -> Time
Sound/Tidal/Utils.hs view
@@ -97,3 +97,8 @@ -} (!!!) :: [a] -> Int -> a (!!!) xs n = xs !! (n `mod` length xs)++accumulate :: Num t => [t] -> [t]+accumulate = accumulate' 0+  where accumulate' _ [] = []+        accumulate' n (a:xs) = (n+a):(accumulate' (n+a) xs)
Sound/Tidal/Version.hs view
@@ -1,4 +1,4 @@  module Sound.Tidal.Version where -tidal_version = "0.9.4"+tidal_version = "0.9.5"
tidal.cabal view
@@ -1,5 +1,5 @@ name:                tidal-version:             0.9.4+version:             0.9.5 synopsis:            Pattern language for improvised music -- description: homepage:            http://tidalcycles.org/@@ -14,7 +14,7 @@ cabal-version:       >=1.10 tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 -Extra-source-files: README.md tidal.el doc/tidal.md+Extra-source-files: README.md CHANGELOG.md tidal.el doc/tidal.md  Description: Tidal is a domain specific language for live coding pattern. @@ -37,6 +37,7 @@                        Sound.Tidal.Transition                        Sound.Tidal.Scales                        Sound.Tidal.Chords+                       Sound.Tidal.Sieve                        Sound.Tidal.Version                        -- Sound.Tidal.PatternList @@ -45,7 +46,7 @@     , containers     , hashable     , colour-    , hosc > 0.13+    , hosc > 0.13, hosc <= 0.15     , text     , mersenne-random-pure64     , time
tidal.el view
@@ -1,6 +1,29 @@-;; tidal.el - (c) alex@slab.org, 20012, based heavily on...-;; hsc3.el - (c) rohan drape, 2006-2008+;;; tidal.el --- Interact with TidalCycles for live coding patterns  -*- lexical-binding: t; -*- +;; Copyright (C) 2012  alex@slab.org+;; Copyright (C) 2006-2008  rohan drape (hsc3.el)++;; Author: alex@slab.org+;; Homepage: https://github.com/tidalcycles/Tidal+;; Version: 0+;; Keywords: tools+;; Package-Requires: ((haskell-mode "16") (emacs "24"))++;; This program is free software; you can redistribute it and/or modify+;; it under the terms of the GNU General Public License as published by+;; the Free Software Foundation, either version 3 of the License, or+;; (at your option) any later version.++;; This program is distributed in the hope that it will be useful,+;; but WITHOUT ANY WARRANTY; without even the implied warranty of+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+;; GNU General Public License for more details.++;; You should have received a copy of the GNU General Public License+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.++;;; Commentary:+ ;; notes from hsc3: ;; This mode is implemented as a derivation of `haskell' mode, ;; indentation and font locking is courtesy that mode.  The@@ -8,11 +31,15 @@ ;; point acquisition is courtesy `thingatpt'.  The directory search ;; facilities are courtesy `find-lisp'. +;;; Code:++ (require 'scheme) (require 'comint) (require 'thingatpt) (require 'find-lisp) (require 'pulse)+(require 'haskell-mode)  (defvar tidal-buffer   "*tidal*"@@ -31,15 +58,18 @@   t   "*Flag to indicate if we are in literate mode (default=t).") +(defvar tidal-modules nil+  "Additional module imports.  See `tidal-run-region'.")+ (make-variable-buffer-local 'tidal-literate-p)  (defun tidal-unlit (s)-  "Remove bird literate marks"+  "Remove bird literate marks in S."   (replace-regexp-in-string "^> " "" s))  (defun tidal-intersperse (e l)-  (if (null l)-      '()+  "Insert E between every element of list L."+  (when l     (cons e (cons (car l) (tidal-intersperse e (cdr l))))))  (defun tidal-start-haskell ()@@ -104,28 +134,18 @@   (kill-buffer tidal-buffer)   (delete-other-windows)) -(defun tidal-help ()-  "Lookup up the name at point in the Help files."-  (interactive)-  (mapc (lambda (filename)-	  (find-file-other-window filename))-	(find-lisp-find-files tidal-help-directory-			      (concat "^"-				      (thing-at-point 'symbol)-				      "\\.help\\.lhs"))))--(defun chunk-string (n s)-  "Split a string into chunks of 'n' characters."+(defun tidal-chunk-string (n s)+  "Split a string S into chunks of N characters."   (let* ((l (length s))          (m (min l n))          (c (substring s 0 m)))     (if (<= l n)         (list c)-      (cons c (chunk-string n (substring s n))))))+      (cons c (tidal-chunk-string n (substring s n))))))  (defun tidal-send-string (s)   (if (comint-check-proc tidal-buffer)-      (let ((cs (chunk-string 64 (concat s "\n"))))+      (let ((cs (tidal-chunk-string 64 (concat s "\n"))))         (mapcar (lambda (c) (comint-send-string tidal-buffer c)) cs))     (error "no tidal process running?"))) @@ -161,28 +181,35 @@ 	       s)))     (tidal-send-string s*))   (pulse-momentary-highlight-one-line (point))-  (next-line)+  (forward-line)   ) +(defun tidal-eval-multiple-lines ()+  "Eval the current region in the interpreter as a single line."+  (tidal-get-now)+  (mark-paragraph)+  (let* ((s (buffer-substring-no-properties (region-beginning)+                                            (region-end)))+         (s* (if tidal-literate-p+                 (tidal-unlit s)+               s)))+    (tidal-send-string ":{")+    (tidal-send-string s*)+    (tidal-send-string ":}")+    (mark-paragraph)+    (pulse-momentary-highlight-region (mark) (point))+    )+  )+ (defun tidal-run-multiple-lines ()   "Send the current region to the interpreter as a single line."   (interactive)-  (tidal-get-now)-  (save-excursion-   (mark-paragraph)-   (let* ((s (buffer-substring-no-properties (region-beginning)-                                             (region-end)))-          (s* (if tidal-literate-p-                  (tidal-unlit s)-                s)))-     (tidal-send-string ":{")-     (tidal-send-string s*)-     (tidal-send-string ":}")-     (mark-paragraph)-     (pulse-momentary-highlight-region (mark) (point))-     )-    ;(tidal-send-string (replace-regexp-in-string "\n" " " s*))-   )+  (if (>= emacs-major-version 25)+      (save-mark-and-excursion+       (tidal-eval-multiple-lines))+    (save-excursion+     (tidal-eval-multiple-lines))+    )   )  (defun tidal-run-d1 ()@@ -365,7 +392,6 @@   (define-key map [?\C-c ?\C-l] 'tidal-load-buffer)   (define-key map [?\C-c ?\C-i] 'tidal-interrupt-haskell)   (define-key map [?\C-c ?\C-m] 'tidal-run-main)-  (define-key map [?\C-c ?\C-h] 'tidal-help)   (define-key map [?\C-c ?\C-1] 'tidal-run-d1)   (define-key map [?\C-c ?\C-2] 'tidal-run-d2)   (define-key map [?\C-c ?\C-3] 'tidal-run-d3)@@ -397,7 +423,6 @@   (local-set-key [?\C-c ?\C-l] 'tidal-load-buffer)   (local-set-key [?\C-c ?\C-i] 'tidal-interrupt-haskell)   (local-set-key [?\C-c ?\C-m] 'tidal-run-main)-  (local-set-key [?\C-c ?\C-h] 'tidal-help)   (local-set-key [?\C-c ?\C-1] 'tidal-run-d1)   (local-set-key [?\C-c ?\C-2] 'tidal-run-d2)   (local-set-key [?\C-c ?\C-3] 'tidal-run-d3)@@ -444,13 +469,13 @@   (define-key map [menu-bar tidal haskell start-haskell]     '("Start haskell" . tidal-start-haskell))) -(if tidal-mode-map-    ()+(unless tidal-mode-map   (let ((map (make-sparse-keymap "Haskell-Tidal")))     (tidal-mode-keybindings map)     (tidal-mode-menu map)     (setq tidal-mode-map map))) +;;;###autoload (define-derived-mode   literate-tidal-mode   tidal-mode@@ -462,9 +487,12 @@   (setq haskell-literate 'bird)   (turn-on-font-lock)) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.ltidal$" . literate-tidal-mode))-;(add-to-list 'load-path "/usr/share/emacs/site-lisp/haskell-mode/") ;required by olig1905 on linux-;(require 'haskell-mode) ;required by olig1905 on linux+;;(add-to-list 'load-path "/usr/share/emacs/site-lisp/haskell-mode/") ;required by olig1905 on linux+;;(require 'haskell-mode) ;required by olig1905 on linux++;;;###autoload (define-derived-mode   tidal-mode   haskell-mode@@ -475,6 +503,8 @@   (setq tidal-literate-p nil)   (turn-on-font-lock)) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.tidal$" . tidal-mode))  (provide 'tidal)+;;; tidal.el ends here