stream fns

minipat/src/Minipat/Interp.hs

@@ -18,7 +18,6 @@ import Bowtie (Anno (..))
 import Control.Exception (Exception)
 import Control.Monad.Except (Except, runExcept)
 import Control.Monad.Trans (lift)
-import Data.Foldable (foldMap')
 import Data.Foldable1 (foldl1')
 import Data.Ratio ((%))
 import Data.Sequence (Seq (..))
@@ -44,18 +43,20 @@ import Minipat.Ast
   , SpeedDir (..)
   , factorValue
   )
-import Minipat.Rand qualified as D
 import Minipat.Rewrite (RwErr, RwT, rewriteM, throwRw)
 import Minipat.Stream
   ( Stream (..)
+  , streamAlt
   , streamConcat
   , streamDegradeBy
+  , streamEuclid
   , streamFast
   , streamFastBy
+  , streamRand
   , streamReplicate
   , streamSlow
   )
-import Minipat.Time (Cycle (..), CycleDelta (..), spanActive, spanSplit)
+import Minipat.Time (CycleDelta (..))
 
 -- | A function that processes a 'Select'
 type Sel e a = Select -> Stream a -> Either (InterpErr e) (Stream a)
@@ -122,22 +123,13 @@ lookInterp sel proj = \case
       GroupTypeSeq _ -> pure (streamConcat els', 1)
       GroupTypePar -> pure (foldl1' (<>) (fmap fst els'), 1)
       GroupTypeRand ->
-        -- TODO pull this out as a stream fn - but fmap to speed up first
-        let l = NESeq.length els
-            f arc' =
-              let s = D.arcSeed arc'
-                  i = D.randInt l s
-                  (el, w) = NESeq.index els' i
-              in  unStream (streamFastBy (unCycleDelta w) el) arc'
-        in  pure (Stream (foldMap' (f . spanActive . snd) . spanSplit), 1)
+        let els'' = fmap (\(el, w) -> streamFastBy (unCycleDelta w) el) els'
+            s = streamRand els''
+        in  pure (s, 1)
       GroupTypeAlt ->
-        -- TODO pull this out as a stream fn - but fmap to speed up first
-        let l = NESeq.length els
-            f z arc' =
-              let i = mod (fromInteger (unCycle z)) l
-                  (el, w) = NESeq.index els' i
-              in  unStream (streamFastBy (unCycleDelta w) el) arc'
-        in  pure (Stream (foldMap' (\(z, sp) -> f z (spanActive sp)) . spanSplit), 1)
+        let els'' = fmap (\(el, w) -> streamFastBy (unCycleDelta w) el) els'
+            s = streamAlt els''
+        in  pure (s, 1)
   PatMod (Mod melw md) ->
     case md of
       ModTypeSpeed (Speed dir spat) -> do
@@ -159,11 +151,10 @@ lookInterp sel proj = \case
         let el' = streamDegradeBy d el
         pure (el', w)
       ModTypeEuclid euc -> do
-        -- TODO pull this out as a stream fn
+        let (Euclid (fromInteger -> filled) (fromInteger -> steps) (fmap fromInteger -> mshift)) = euc
         (el, _) <- lift melw
-        let s = streamConcat (eucSeq euc (el, 1) (mempty, 1))
-            d = eucSteps euc
-        pure (s, fromInteger d)
+        let s = streamEuclid filled steps mshift el
+        pure (s, fromIntegral steps)
   PatPoly (Poly _ _) -> error "TODO"
 
 eucSeq :: Euclid -> r -> r -> NESeq r

minipat/src/Minipat/Stream.hs

@@ -37,19 +37,23 @@ module Minipat.Stream
   , streamDegradeBy
   , streamDegrade
   , streamCont
+  , streamEuclid
+  , streamRand
+  , streamAlt
   )
 where
 
 import Control.Monad (ap)
-import Data.Foldable (foldl', toList)
+import Data.Foldable (foldMap', foldl', toList)
 import Data.Foldable1 (foldMap1')
 import Data.Heap (Entry (..), Heap)
 import Data.Heap qualified as H
+import Data.Maybe (fromMaybe)
 import Data.Semigroup (Semigroup (..), Sum (..))
 import Data.Sequence.NonEmpty (NESeq)
 import Data.Sequence.NonEmpty qualified as NESeq
 import Data.String (IsString (..))
-import Minipat.Rand (randFrac, spanSeed)
+import Minipat.Rand (arcSeed, randFrac, randInt, spanSeed)
 import Minipat.Time
   ( Arc (..)
   , Cycle (..)
@@ -215,28 +219,59 @@ streamDegradeBy r (Stream k) = Stream (tapeDegradeBy r . k)
 streamDegrade :: Stream Rational -> Stream a -> Stream a
 streamDegrade = streamAdjust streamDegradeBy
 
--- Sketch: split arc into cycles, for each render the streamtern over the cycle, slowing by length, then speed everything
--- up by whole amount to fit all into one cycle
+-- Sketch: split arc into cycles, for each render the stream over the cycle, slowing
+-- by length, then speed everything up by whole amount to fit all into one cycle
 goConcat :: CycleDelta -> NESeq (Stream a, CycleDelta) -> Arc -> Tape a
-goConcat w streams arc = foldl' go1 mempty (spanSplit arc)
+goConcat w ss arc = foldl' go1 mempty (spanSplit arc)
  where
   go1 t (i, Span subArc _) = t <> tapeFastBy i (unCycleDelta w) (snd (go2 i subArc))
-  go2 i subArc = foldl' (go3 i subArc) (0, mempty) streams
+  go2 i subArc = foldl' (go3 i subArc) (0, mempty) ss
   go3 i subArc (o, t) (p, v) =
     (o + v, t <> tapeLateBy o (tapeSlowBy i (unCycleDelta v) (unStream p subArc)))
 
 streamConcat :: NESeq (Stream a, CycleDelta) -> Stream a
-streamConcat streams =
-  let w = getSum (foldMap1' (Sum . snd) streams)
-  in  Stream (goConcat w streams)
+streamConcat ss =
+  let w = getSum (foldMap1' (Sum . snd) ss)
+  in  Stream (goConcat w ss)
 
 -- TODO implement stream repeat more efficiently than just using streamConcat
 streamReplicate :: Int -> Stream a -> Stream a
-streamReplicate n p = streamConcat (NESeq.replicate n (p, 1))
+streamReplicate n s = streamConcat (NESeq.replicate n (s, 1))
 
 streamCont :: (CycleTime -> a) -> Stream a
 streamCont f = Stream (tapeSingleton . evCont f)
 
+goEuclid :: Int -> Int -> Maybe Int -> r -> r -> NESeq r
+goEuclid filled steps (fromMaybe 0 -> shift) activeEl passiveEl =
+  NESeq.fromFunction steps $ \ix0 ->
+    let ix1 = ix0 + shift
+        ix = if ix1 >= steps then ix1 - steps else ix1
+        active = mod ix filled == 0
+    in  if active then activeEl else passiveEl
+
+streamEuclid :: Int -> Int -> Maybe Int -> Stream a -> Stream a
+streamEuclid filled steps mshift s =
+  streamConcat (goEuclid filled steps mshift (s, 1) (mempty, 1))
+
+streamRand :: NESeq (Stream a) -> Stream a
+streamRand ss =
+  let l = NESeq.length ss
+      f arc =
+        let s = arcSeed arc
+            i = randInt l s
+            t = NESeq.index ss i
+        in  unStream t arc
+  in  Stream (foldMap' (f . spanActive . snd) . spanSplit)
+
+streamAlt :: NESeq (Stream a) -> Stream a
+streamAlt ss =
+  let l = NESeq.length ss
+      f z arc =
+        let i = mod (fromInteger (unCycle z)) l
+            t = NESeq.index ss i
+        in  unStream t arc
+  in  Stream (foldMap' (\(z, sp) -> f z (spanActive sp)) . spanSplit)
+
 -- TODO move to module with continuous primitives
 -- fnSine :: Rational -> Time -> Double
 -- fnSine freq t = sin (2 * pi * fromRational (freq * t))