module Sound.Signal.Block where
import Data.Array (Array, (!), listArray)
import qualified Sound.Signal as Signal
import qualified Synthesizer.Plain.Signal as ListSignal
import qualified Data.List as List
import Data.Maybe.HT (toMaybe)
import Prelude hiding ((++), iterate, foldl, zipWith, tail, head)
instance Signal.C T where
singleton = singleton
unfoldR = unfoldR defaultChunkSize
reduceL = reduceL
mapAccumL = mapAccumL defaultChunkSize
(++) = append
zipWith = zipWith defaultChunkSize
type ChunkSize = Int
defaultChunkSize :: ChunkSize
defaultChunkSize = 256
newtype T a = Cons {
chunks :: [Chunk a]
}
deriving (Show)
data Chunk a = Chunk {
offset :: Int,
size :: ChunkSize,
body :: Array Int a
}
deriving (Show)
singleton :: a -> T a
singleton x = Cons [Chunk 0 1 (listArray (0,0) [x])]
isEmpty :: T a -> Bool
isEmpty (Cons x) = null x
head :: T a -> a
head (Cons xt) =
case xt of
[] -> error "Signal.Block.head: empty list"
(Chunk start _ arr : _) -> arr ! start
tail :: T a -> T a
tail (Cons xt) =
case xt of
[] -> error "Signal.Block.tail: empty list"
(Chunk start sz arr : xs) -> Cons
(if sz>1
then Chunk (succ start) (pred sz) arr : xs
else xs)
tails :: T a -> [T a]
tails =
List.unfoldr
(\x -> toMaybe (not (isEmpty x))
(let tailX = tail x in (tailX,tailX)))
toList :: T a -> [a]
toList =
List.concatMap
(\(Chunk start sz arr) ->
take sz (map (arr!) [start..])) . chunks
toListAlt :: T a -> [a]
toListAlt = List.init . map head . tails
fromList :: ChunkSize -> [a] -> T a
fromList chunkSize =
let recourse [] = []
recourse xs =
let actSize = minLength chunkSize xs
in Chunk 0 actSize (listArray (0,actSize1) xs) :
if actSize < chunkSize
then []
else recourse (drop chunkSize xs)
in Cons . recourse
minLength :: Int -> [a] -> Int
minLength =
let recourse seenSoFar expected xt =
case xt of
[] -> seenSoFar
(_:xs) ->
if expected == 0
then seenSoFar
else recourse (succ seenSoFar) (pred expected) xs
in recourse 0
unfoldR :: ChunkSize -> (acc -> Maybe (y, acc)) -> acc -> (acc, T y)
unfoldR chunkSize f acc =
let (accEnd, xs) = ListSignal.unfoldR f acc
in (accEnd, fromList chunkSize xs)
reduceL :: (a -> acc -> Maybe acc) -> acc -> T a -> acc
reduceL f start =
ListSignal.reduceL f start . toList
mapAccumL :: ChunkSize ->
(x -> acc -> Maybe (y, acc)) -> acc -> T x -> (acc, T y)
mapAccumL chunkSize f accStart xs =
let (accEnd, ys) = ListSignal.mapAccumL f accStart (toList xs)
in (accEnd, fromList chunkSize ys)
append :: T a -> T a -> T a
append (Cons x) (Cons y) = Cons (x List.++ y)
zipWith :: ChunkSize -> (a -> b -> c) -> (T a -> T b -> T c)
zipWith chunkSize f x y =
fromList chunkSize $
List.zipWith f (toList x) (toList y)