a5a9f026f3e4 — Chris Cannam 2 years ago
Add StartPaddedBlockStreamFn, which can be seekable with caveats
2 files changed, 147 insertions(+), 17 deletions(-)

M duration-adapting-fn.sml
M test.sml
M duration-adapting-fn.sml +146 -16
@@ 214,7 214,7 @@ functor FixedDurationStatefulStreamFn (S
     
 end
 
-functor PaddedStatefulStreamFn (S : REAL_STATEFUL_SAMPLE_STREAM) :
+functor StartPaddedStatefulStreamFn (S : REAL_STATEFUL_SAMPLE_STREAM) :
         sig
             include REAL_STATEFUL_SAMPLE_STREAM
             val wrap : { padding : int } * S.stream -> stream

          
@@ 385,20 385,20 @@ end
 functor PaddedBlockStreamFn (S : BLOCK_STREAM) :
         sig
             include BLOCK_STREAM
-            val wrap : { pad : int } * S.stream -> stream
+            val wrap : { padding : int } * S.stream -> stream
         end = struct
 
     structure SampleMatrix = S.SampleMatrix
 
     type stream = {
-        pad : int,
+        padding : int,
         startTime : RealTime.t,
         remainingAtStart : int,
         remainingAtEnd : int,
         upstream : S.stream
     }
 
-    type new_args = { pad : int } * S.new_args
+    type new_args = { padding : int } * S.new_args
 
     open SignalTypes SampleStreamLog
                         

          
@@ 406,7 406,7 @@ functor PaddedBlockStreamFn (S : BLOCK_S
     fun channels ({ upstream, ... } : stream) = S.channels upstream
     fun blocksize ({ upstream, ... } : stream) = S.blocksize upstream
 
-    fun time ({ pad, startTime, remainingAtStart, remainingAtEnd, upstream } : stream) =
+    fun time ({ padding, startTime, remainingAtStart, remainingAtEnd, upstream } : stream) =
         let val t = S.time upstream
             val bs = S.blocksize upstream
             val rate = S.rate upstream

          
@@ 414,9 414,9 @@ functor PaddedBlockStreamFn (S : BLOCK_S
             if remainingAtStart > 0
             then RealTime.- (t, RealTime.fromFrame
                                     (FRAME (bs * remainingAtStart), rate))
-            else if remainingAtEnd < pad
+            else if remainingAtEnd < padding
             then RealTime.+ (t, RealTime.fromFrame
-                                    (FRAME (bs * (pad - remainingAtEnd)), rate))
+                                    (FRAME (bs * (padding - remainingAtEnd)), rate))
             else t
         end
 

          
@@ 430,6 430,9 @@ functor PaddedBlockStreamFn (S : BLOCK_S
        2. It has no way to know whether a seek at the end of the
        stream should land within the end padding or not, since the
        duration of the wrapped stream cannot be directly queried.
+
+       Note that the similar StartPaddedBlockStreamFn is seekable,
+       with caveats, if its upstream is.
      *)
     fun seekable (s : stream) = SampleStreamTypes.NON_SEEKABLE
 

          
@@ 440,10 443,10 @@ functor PaddedBlockStreamFn (S : BLOCK_S
                             },
                             SampleMatrix.zeroValue)
         
-    fun read ({ pad, startTime, remainingAtStart, remainingAtEnd, upstream } : stream)
+    fun read ({ padding, startTime, remainingAtStart, remainingAtEnd, upstream } : stream)
         : (stream * SampleMatrix.matrix) option =
         if remainingAtStart > 0
-        then SOME ({ pad = pad,
+        then SOME ({ padding = padding,
                      startTime = startTime,
                      remainingAtStart = remainingAtStart - 1,
                      remainingAtEnd = remainingAtEnd,

          
@@ 451,7 454,7 @@ functor PaddedBlockStreamFn (S : BLOCK_S
                    }, paddingBlockFor upstream)
         else case S.read upstream of
                  SOME (upstream', m) =>
-                 SOME ({ pad = pad,
+                 SOME ({ padding = padding,
                          startTime = startTime,
                          remainingAtStart = remainingAtStart,
                          remainingAtEnd = remainingAtEnd,

          
@@ 459,7 462,7 @@ functor PaddedBlockStreamFn (S : BLOCK_S
                        }, m)
                | NONE =>
                  if remainingAtEnd > 0
-                 then SOME ({ pad = pad,
+                 then SOME ({ padding = padding,
                               startTime = startTime,
                               remainingAtStart = remainingAtStart,
                               remainingAtEnd = remainingAtEnd - 1,

          
@@ 471,14 474,14 @@ functor PaddedBlockStreamFn (S : BLOCK_S
                           
     fun foldl f = BlockStreamFolder.makeFoldl (read, f)
 
-    fun wrap ({ pad : int }, upstream) =
+    fun wrap ({ padding : int }, upstream) =
         let open SampleStreamLog
-            val () = debug (fn () => ["PaddedBlockStreamFn.wrap: pad = %1", Log.I pad])
+            val () = debug (fn () => ["PaddedBlockStreamFn.wrap: padding = %1", Log.I padding])
         in
-            { pad = pad,
+            { padding = padding,
               startTime = S.time upstream,
-              remainingAtStart = pad,
-              remainingAtEnd = pad,
+              remainingAtStart = padding,
+              remainingAtEnd = padding,
               upstream = upstream
             }
         end

          
@@ 487,3 490,130 @@ functor PaddedBlockStreamFn (S : BLOCK_S
         wrap (myArgs, S.new theirArgs)
 
 end
+
+(** Augment a block stream with a number of zero blocks at the start.
+ *)
+functor StartPaddedBlockStreamFn (S : BLOCK_STREAM) :
+        sig
+            include BLOCK_STREAM
+            val wrap : { padding : int } * S.stream -> stream
+        end = struct
+
+    structure SampleMatrix = S.SampleMatrix
+
+    type stream = {
+        padding : int,
+        startTime : RealTime.t,
+        hop : RealTime.t,
+        remainingAtStart : int,
+        upstream : S.stream
+    }
+
+    type new_args = { padding : int } * S.new_args
+
+    open SignalTypes SampleStreamLog
+
+    structure Helper = BlockStreamRateHelperFn (S)
+                     
+    fun rate ({ upstream, ... } : stream) = S.rate upstream
+    fun channels ({ upstream, ... } : stream) = S.channels upstream
+    fun blocksize ({ upstream, ... } : stream) = S.blocksize upstream
+
+    fun time ({ padding, startTime, hop, remainingAtStart, upstream } : stream) =
+        let val t = S.time upstream
+        in
+            if remainingAtStart > 0
+            then RealTime.- (t, RealTime.* (hop, remainingAtStart))
+            else t
+        end
+
+    (* Although PaddedBlockStreamFn is not seekable,
+       StartPaddedBlockStreamFn can be, with caveats.
+
+       We avoid objection 2 listed in PaddedBlockStreamFn because we
+       don't pad the end, so that's ok.
+
+       We answer objection 1 (no way to do partial block seeks in the
+       start padding) by always rounding the seek target to a block
+       boundary regardless of where it is, and then expecting the
+       caller to check where their seek actually landed. After all,
+       the seek position is a RealTime which is not guaranteed to
+       correspond to an exact sample position in any stream anyway.
+
+       This might not be suitable behaviour for any given pipeline -
+       if not, consider a PaddedBlockStreamFn without seek support and
+       finding another solution.
+     *)
+    fun seekable ({ upstream, ... } : stream) = S.seekable upstream
+
+    fun paddingBlockFor (upstream : S.stream) =
+        SampleMatrix.const (SampleMatrix.ROW_MAJOR,
+                            { rows = S.channels upstream,
+                              columns = S.blocksize upstream
+                            },
+                            SampleMatrix.zeroValue)
+        
+    fun read ({ padding, startTime, hop, remainingAtStart, upstream } : stream)
+        : (stream * SampleMatrix.matrix) option =
+        if remainingAtStart > 0
+        then SOME ({ padding = padding,
+                     startTime = startTime,
+                     hop = hop,
+                     remainingAtStart = remainingAtStart - 1,
+                     upstream = upstream
+                   }, paddingBlockFor upstream)
+        else case S.read upstream of
+                 SOME (upstream', m) =>
+                 SOME ({ padding = padding,
+                         startTime = startTime,
+                         hop = hop,
+                         remainingAtStart = 0,
+                         upstream = upstream'
+                       }, m)
+               | NONE => NONE
+
+    fun seek ({ padding, startTime, hop, upstream, ... } : stream, mode, t) =
+        let val snapped = RealTime.snap (RealTime.- (t, startTime), hop)
+        in
+            if RealTime.< (snapped, RealTime.zeroTime)
+            then let val hops = ~ (RealTime.chunk (snapped, hop))
+                 in
+                     if hops > padding
+                     then NONE
+                     else SOME { padding = padding,
+                                 startTime = startTime,
+                                 hop = hop,
+                                 remainingAtStart = hops,
+                                 upstream = upstream
+                               }
+                 end
+            else case S.seek (upstream, mode, snapped) of
+                     NONE => NONE
+                   | SOME upstream' => SOME { padding = padding,
+                                              startTime = startTime,
+                                              hop = hop,
+                                              remainingAtStart = 0,
+                                              upstream = upstream'
+                                            }
+        end
+                     
+    fun foldl f = BlockStreamFolder.makeFoldl (read, f)
+
+    fun wrap ({ padding : int }, upstream) =
+        let open SampleStreamLog
+            val () = debug (fn () => ["StartPaddedBlockStreamFn.wrap: padding = %1", Log.I padding])
+            val blockRate = Helper.deduceBlockRate upstream
+            val hop = RealTime.fromFrame (SignalTypes.FRAME 1, blockRate)
+        in
+            { padding = padding,
+              startTime = S.time upstream,
+              hop = hop,
+              remainingAtStart = padding,
+              upstream = upstream
+            }
+        end
+
+    fun new (myArgs, theirArgs) =
+        wrap (myArgs, S.new theirArgs)
+
+end

          
M test.sml +1 -1
@@ 102,7 102,7 @@ structure TestPadded : TESTS = struct
 
     val name = "padded"
 
-    structure P = PaddedStatefulStreamFn
+    structure P = StartPaddedStatefulStreamFn
                       (StatefulSampleStreamFromStatelessFn
                            (StatelessSyntheticStream))