Skip to content

Commit

Permalink
Add experimental sequence datatype
Browse files Browse the repository at this point in the history
  • Loading branch information
yaxu committed Jul 25, 2022
1 parent 277eb4d commit 0f76b13
Show file tree
Hide file tree
Showing 4 changed files with 109 additions and 1 deletion.
40 changes: 40 additions & 0 deletions src/Sound/Tidal/Common.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,40 @@
module Sound.Tidal.Common where

import Sound.Tidal.Pattern as Pat
import Sound.Tidal.Core as Pat
-- import Sound.Tidal.UI as Pat

import Sound.Tidal.Sequence as Seq

This comment has been minimized.

Copy link
@polymorphicengine

polymorphicengine Jul 25, 2022

Collaborator

as i mentioned in the club thread https://club.tidalcycles.org/t/thoughts-about-better-support-of-sequences-and-beat-wise-rather-than-cycle-wise-operations-in-tidalcycles/4149/14

i think the typeclass definiton should rather be expecting a type of kind * -> * like Pattern or Branch

class Transformable a where
rev :: a -> a
cat :: [a] -> a

instance Transformable (Pattern a) where
rev = Pat.rev
cat = Pat.cat

instance Transformable (Branch a) where
rev = Seq.rev
cat = Seq.cat

seqPat :: Seq.Branch a -> Pat.Pattern a
seqPat (Seq.Atom _ a) = pure a
seqPat (Seq.Silence _) = Pat.silence
seqPat (Seq.Sequence bs) = Pat.timecat $ map (\b -> (seqSpan b, seqPat b)) bs
seqPat (Seq.Stack Expand bs) = Pat.stack $ map seqPat bs
seqPat b@(Seq.Stack JustifyLeft bs) =
Pat.stack $ map (\b' -> _fastGap (seqSpan b / seqSpan b') $ seqPat b') bs
seqPat b@(Seq.Stack JustifyRight bs) =
Pat.stack $
map (\b' -> rotR (1- (1/(seqSpan b / seqSpan b'))) $ _fastGap (seqSpan b / seqSpan b') $ seqPat b') bs
seqPat b@(Seq.Stack Centre bs) = Pat.stack $
map (\b' -> rotR (1.5/(seqSpan b / seqSpan b')) $ _fastGap (seqSpan b / seqSpan b') $ seqPat b') bs

{-
data Strategy = JustifyBoth
| Expand
| TruncateMax
| TruncateMin
| RepeatLCM
-}
4 changes: 3 additions & 1 deletion src/Sound/Tidal/Context.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,13 +22,15 @@ import Prelude hiding ((<*), (*>))

import Data.Ratio as C

import Sound.Tidal.Common as C
import Sound.Tidal.Config as C
import Sound.Tidal.Control as C
import Sound.Tidal.Core as C
import Sound.Tidal.Core as C hiding (rev, cat)
import Sound.Tidal.Params as C
import Sound.Tidal.ParseBP as C
import Sound.Tidal.Pattern as C
import Sound.Tidal.Scales as C
import Sound.Tidal.Sequence as C hiding (rev, cat)
import Sound.Tidal.Show as C
import Sound.Tidal.Simple as C
import Sound.Tidal.Stream as C
Expand Down
64 changes: 64 additions & 0 deletions src/Sound/Tidal/Sequence.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,64 @@

{-
Sequence.hs - core representation of Tidal sequences
Copyright (C) 2022 Alex McLean and contributors
This library 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 library 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 library. If not, see <http://www.gnu.org/licenses/>.
-}

module Sound.Tidal.Sequence where

import Prelude hiding (span)
import Data.Ratio

data Strategy = JustifyLeft
| JustifyRight
| JustifyBoth
| Expand
| TruncateMax
| TruncateMin
| RepeatLCM
| Centre
deriving Show

data Branch a = Atom Rational a
| Silence Rational
| Sequence [Branch a]
| Stack Strategy [Branch a]
deriving Show

rev :: Branch a -> Branch a
rev (Sequence bs) = Sequence $ reverse $ map rev bs
rev (Stack strategy bs) = Stack strategy $ map rev bs
rev b = b

cat :: [Branch a] -> Branch a
cat [] = Silence 0
cat [b] = b
cat bs = Sequence bs

seqSpan :: Branch a -> Rational
seqSpan (Atom s _) = s
seqSpan (Silence s) = s
seqSpan (Sequence bs) = sum $ map seqSpan bs
seqSpan (Stack _ []) = 0
seqSpan (Stack RepeatLCM [b]) = seqSpan b
seqSpan (Stack RepeatLCM (b:bs)) = foldr lcmRational (seqSpan b) $ map seqSpan bs
seqSpan (Stack TruncateMin (b:bs)) = minimum $ map seqSpan bs
seqSpan (Stack _ bs) = maximum $ map seqSpan bs

lcmRational a b = (lcm (f a) (f b)) % d
where d = lcm (denominator a) (denominator b)
f x = numerator x * (d `div` denominator x)

2 changes: 2 additions & 0 deletions tidal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ library

Exposed-modules: Sound.Tidal.Bjorklund
Sound.Tidal.Chords
Sound.Tidal.Common
Sound.Tidal.Config
Sound.Tidal.Control
Sound.Tidal.Context
Expand All @@ -40,6 +41,7 @@ library
Sound.Tidal.Scales
Sound.Tidal.Safe.Context
Sound.Tidal.Safe.Boot
Sound.Tidal.Sequence
Sound.Tidal.Show
Sound.Tidal.Simple
Sound.Tidal.Stream
Expand Down

0 comments on commit 0f76b13

Please sign in to comment.