module Common where

import qualified Sound.Hassampler.Basic.Pitch as Pitch

import qualified Synthesizer.LLVM.Server.Packed.Instrument as Instr
import Synthesizer.LLVM.Server.Common (SampleRate(SampleRate), Real, )

import qualified Synthesizer.MIDI.PiecewiseConstant as PC
import Synthesizer.MIDI.EventList (LazyTime, )

import qualified Synthesizer.Generic.Cut as CutG

import qualified Data.StorableVector.Lazy as SVL

import qualified Data.EventList.Relative.BodyTime as EventListBT

import qualified Numeric.NonNegative.Chunky as NonNegChunky
import qualified Numeric.NonNegative.Wrapper as NonNegW

import Control.Category (id, )

import Prelude hiding (Real, id, )


constCtrl :: a -> PC.T a
constCtrl x =
   let xs = EventListBT.cons x 10000 xs
   in  xs

controlPeriod :: Real
controlPeriod = 0.01

sampleRate :: (Fractional a) => SampleRate a
sampleRate = SampleRate 44100

vectorChunkSize :: SVL.ChunkSize
vectorChunkSize = SVL.chunkSize 4096

vectorRate :: (Fractional a) => a
vectorRate = Instr.vectorRate sampleRate

controlRate :: Real
controlRate = controlPeriod*vectorRate

linearCtrl :: Real -> (Real,Real) -> PC.T Real
linearCtrl dur (x0,x1) =
   let slope = (x1-x0) * controlPeriod/dur
   in  CutG.take (round (vectorRate*dur)) $
       EventListBT.fromPairList $
       map (flip (,) (round controlRate)) $
       iterate (slope+) x0

exponentialCtrl :: Real -> (Real,Real) -> PC.T Real
exponentialCtrl dur (x0,x1) =
   fmap exp $ linearCtrl dur (log x0, log x1)

freqFromPitch :: Pitch.T -> Real
freqFromPitch p =
   Pitch.absToFreq $ Pitch.toAbs p

vtime :: Real -> LazyTime
vtime t =
   let rate = vectorRate
       n = round (t*rate)
       (q,r) = divMod n (round rate)
   in  NonNegChunky.fromChunks $
       (if r==0
          then id
          else ((NonNegW.fromNumberMsg "firework.time" $
                 fromIntegral $ NonNegW.toNumber r) :)) $
       replicate (NonNegW.toNumber q) (round rate)