synthesizer-llvm-0.3: src/Synthesizer/LLVM/Server/Common.hs

module Synthesizer.LLVM.Server.Common (
   Real,
   SampleRate(SampleRate),
   Instrument,
   frequency, time, number, control, signal, parameter,
   frequencyConst, timeConst,
   ($/),
   play,
   startMessage,
   piecewiseConstant,
   transposeModulation,
   amplitudeFromVelocity,
   makeNote,
   ) where

import qualified Synthesizer.LLVM.Server.Option as Option
import Synthesizer.LLVM.Server.Option (SampleRate(SampleRate), )

import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Sound.ALSA.Sequencer.Address as Addr
import qualified Sound.ALSA.Sequencer.Client as Client
import qualified Sound.ALSA.Sequencer.Port as Port
import qualified Sound.ALSA.Sequencer.Queue as Queue
import qualified Sound.ALSA.Sequencer.RealTime as RealTime

import qualified Sound.ALSA.PCM as ALSA
import qualified Synthesizer.Storable.ALSA.Play as Play
import qualified Synthesizer.Storable.ALSA.MIDI as AlsaSt
import qualified Synthesizer.PiecewiseConstant.Signal as PC
import qualified Synthesizer.LLVM.ALSA.BendModulation as BM

import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
import qualified Synthesizer.LLVM.Parameter as Param

import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Class as Class
import qualified LLVM.Core as LLVM

import qualified Synthesizer.Storable.Signal      as SigSt

import Foreign.Storable (Storable, )

import Control.Arrow (arr, (^<<), )

import qualified Algebra.Additive  as Additive

import Data.Word (Word8, )

import NumericPrelude.Numeric (zero, round, )
import Prelude hiding (Real, round, break, )



type Real = Float

type Instrument a sig = SampleRate a -> AlsaSt.Instrument a sig


frequency :: (p -> Real) -> Param.T (SampleRate Real, p) Real
frequency param =
   arr (\(SampleRate sampleRate, p) -> param p / sampleRate)

time :: (p -> Real) -> Param.T (SampleRate Real, p) Real
time param =
   arr (\(SampleRate sampleRate, p) -> param p * sampleRate)

number :: (p -> Real) -> Param.T (SampleRate Real, p) Real
number param = arr (param . snd)

control :: (p -> PC.T Real) -> Param.T (SampleRate Real, p) (PC.T Real)
control param = arr (param . snd)

signal :: (p -> SigSt.T a) -> Param.T (SampleRate Real, p) (SigSt.T a)
signal param = arr (param . snd)

parameter :: (p -> a) -> Param.T (SampleRate Real, p) a
parameter param = arr (param . snd)


frequencyConst :: Real -> Param.T (SampleRate Real, p) Real
frequencyConst param =
   arr (\(SampleRate sampleRate, _p) -> param / sampleRate)

timeConst :: Real -> Param.T (SampleRate Real, p) Real
timeConst param =
   arr (\(SampleRate sampleRate, _p) -> param * sampleRate)



($/) :: (Functor f) => f (a -> b) -> a -> f b
f $/ x = fmap ($x) f


-- ToDo: do not record the empty chunk that is inserted for latency
{-# INLINE play #-}
play ::
   (Additive.C y, ALSA.SampleFmt y) =>
   Option.T -> Double -> SigSt.T y -> IO ()
play opts rate =
   Play.auto (Play.makeSink
      (Option.device opts) (Option.periodTime opts) (round rate)) .
   SigSt.append (SigSt.replicate (Option.chunkSize opts) (Option.latency opts) zero)
--   FiltG.delayPosLazySize (Option.chunkSize opts) (Option.latency opts)
--   FiltG.delayPos (Option.latency opts)


startMessage :: String
startMessage =
   "run 'aconnect' to connect to the MIDI controller"


piecewiseConstant ::
   (Storable a,
    Class.MakeValueTuple a al,
    Memory.C al am,
    LLVM.IsSized am as) =>
   Param.T p (PC.T a) -> SigP.T p al
piecewiseConstant pc =
   SigP.piecewiseConstant
      (PC.subdivideLongStrict ^<< pc)

transposeModulation ::
   (Functor stream) =>
   SampleRate Real ->
   Real ->
   stream (BM.T Real) ->
   stream (BM.T Real)
transposeModulation (SampleRate sampleRate) freq =
   fmap (BM.shift (freq/sampleRate))


{-# INLINE amplitudeFromVelocity #-}
amplitudeFromVelocity :: Real -> Real
amplitudeFromVelocity vel = 4**vel


-- cf. synthesizer-alsa:Synthesizer.Storable.ALSA.Server.Test
makeNote :: Event.NoteEv -> Word8 -> Event.T
makeNote typ pit =
   Event.Cons
      { Event.highPriority = False
      , Event.tag = 0
      , Event.queue = Queue.direct
      , Event.timestamp =
           Event.RealTime $ RealTime.fromInteger 0
      , Event.source = Addr.Cons {
           Addr.client = Client.subscribers,
           Addr.port = Port.unknown
        }
      , Event.dest = Addr.Cons {
           Addr.client = Client.subscribers,
           Addr.port = Port.unknown
        }
      , Event.body =
           Event.NoteEv typ
              (Event.simpleNote 0 pit 64)
      }