module Synthesizer.Storable.ALSA.MIDI (
chunkSizesFromLazyTime,
piecewiseConstant,
piecewiseConstantInit,
piecewiseConstantInitWith,
controllerLinear,
controllerExponential,
pitchBend,
channelPressure,
bendWheelPressure,
Instrument, Bank,
sequenceCore,
sequence,
sequenceModulated,
sequenceMultiModulated,
applyModulation,
advanceModulationLazy,
advanceModulationStrict,
advanceModulationChunky,
sequenceMultiProgram,
Gen.renderInstrument,
Gen.renderInstrumentIgnoreProgram,
Gen.evaluateVectorHead,
Gen.advanceModulationChunk,
) where
import Synthesizer.EventList.ALSA.MIDI
(LazyTime, StrictTime, Filter, Note,
Program, Channel, Controller,
getControllerEvents, getSlice,
maybePitchBend, maybeChannelPressure,
chopLongTime, )
import qualified Synthesizer.Generic.ALSA.MIDI as Gen
import qualified Synthesizer.MIDIValue as MV
import qualified Synthesizer.Storable.Cut as CutSt
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy.Pattern as SigStV
import qualified Data.StorableVector.Lazy as SVL
import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.State.Oscillator as OsciS
import qualified Synthesizer.State.Displacement as DispS
import qualified Synthesizer.State.Filter.NonRecursive as FiltNRS
import qualified Synthesizer.Basic.Wave as Wave
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Data.EventList.Relative.BodyTime as EventListBT
import qualified Data.EventList.Relative.TimeBody as EventList
import Foreign.Storable (Storable, )
import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Numeric.NonNegative.Chunky as NonNegChunky
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Field as Field
import qualified Algebra.Additive as Additive
import Control.Monad.Trans.State (State, evalState, state, modify, put, get, )
import Control.Monad (liftM, )
import Data.Traversable (traverse, )
import Data.Foldable (traverse_, )
import NumericPrelude.Base hiding (sequence, )
import NumericPrelude.Numeric
chunkSizesFromStrictTime :: StrictTime -> NonNegChunky.T SigSt.ChunkSize
chunkSizesFromStrictTime =
NonNegChunky.fromChunks .
map (SVL.ChunkSize . fromInteger . NonNegW.toNumber) .
chopLongTime
chunkSizesFromLazyTime :: LazyTime -> NonNegChunky.T SigSt.ChunkSize
chunkSizesFromLazyTime =
NonNegChunky.fromChunks .
map (SVL.ChunkSize . fromInteger . NonNegW.toNumber) .
concatMap chopLongTime .
NonNegChunky.toChunks .
NonNegChunky.normalize
piecewiseConstant ::
(Storable y) =>
EventListBT.T StrictTime y -> SigSt.T y
piecewiseConstant =
EventListBT.foldrPair
(\y t -> SigSt.append (SigStV.replicate (chunkSizesFromStrictTime t) y))
SigSt.empty
piecewiseConstantInit ::
(Storable y) =>
y -> EventList.T StrictTime y -> SigSt.T y
piecewiseConstantInit initial =
(\ ~(t,rest) ->
SigSt.append (SigStV.replicate (chunkSizesFromStrictTime t) initial) rest)
.
EventList.foldr
(,)
(\y ~(t,rest) ->
SigSt.append (SigStV.replicate (chunkSizesFromStrictTime t) y) rest)
(0, SigSt.empty)
piecewiseConstantInitWith ::
(Storable c) =>
(y -> c) ->
c -> EventList.T StrictTime [y] -> SigSt.T c
piecewiseConstantInitWith f initial =
piecewiseConstantInit initial .
flip evalState initial .
traverse (\evs -> traverse_ (put . f) evs >> get)
controllerLinear ::
(Storable y, Field.C y) =>
Channel -> Controller ->
(y,y) -> y ->
Filter (SigSt.T y)
controllerLinear chan ctrl bnd initial =
liftM (piecewiseConstantInitWith (MV.controllerLinear bnd) initial) $
getControllerEvents chan ctrl
controllerExponential ::
(Storable y, Trans.C y) =>
Channel -> Controller ->
(y,y) -> y ->
Filter (SigSt.T y)
controllerExponential chan ctrl bnd initial =
liftM (piecewiseConstantInitWith (MV.controllerExponential bnd) initial) $
getControllerEvents chan ctrl
pitchBend ::
(Storable y, Trans.C y) =>
Channel ->
y -> y ->
Filter (SigSt.T y)
pitchBend chan range center =
liftM (piecewiseConstantInitWith (MV.pitchBend range center) center) $
getSlice (maybePitchBend chan)
channelPressure ::
(Storable y, Trans.C y) =>
Channel ->
y -> y ->
Filter (SigSt.T y)
channelPressure chan maxVal initVal =
liftM (piecewiseConstantInitWith (MV.controllerLinear (0,maxVal)) initVal) $
getSlice (maybeChannelPressure chan)
bendWheelPressure ::
(Storable y, RealRing.C y, Trans.C y) =>
Channel ->
Int -> y -> y -> y ->
Filter (SigSt.T y)
bendWheelPressure chan
pitchRange speed wheelDepth pressDepth =
do bend <- pitchBend chan (2^?(fromIntegral pitchRange/12)) 1
fm <- controllerLinear chan VoiceMsg.modulation (0,wheelDepth) 0
press <- channelPressure chan pressDepth 0
return $
flip (SigS.zipWithStorable (*)) bend $
SigS.map (1+) $
FiltNRS.envelope
(DispS.mix
(SigS.fromStorableSignal fm)
(SigS.fromStorableSignal press))
(OsciS.static Wave.sine zero speed)
type Instrument y yv = Gen.Instrument y (SigSt.T yv)
type Bank y yv = Gen.Bank y (SigSt.T yv)
sequenceCore ::
(Storable yv, Additive.C yv) =>
SVL.ChunkSize ->
Channel ->
Program ->
Gen.Modulator Note (SigSt.T yv) ->
Filter (SigSt.T yv)
sequenceCore chunkSize =
Gen.sequenceCore (CutSt.arrangeEquidist chunkSize)
sequence ::
(Storable yv, Additive.C yv, Trans.C y) =>
SVL.ChunkSize ->
Channel ->
Instrument y yv ->
Filter (SigSt.T yv)
sequence chunkSize =
Gen.sequence (CutSt.arrangeEquidist chunkSize)
sequenceModulated ::
(Storable c, Storable yv, Additive.C yv, Trans.C y) =>
SVL.ChunkSize ->
SigSt.T c ->
Channel ->
(SigSt.T c -> Instrument y yv) ->
Filter (SigSt.T yv)
sequenceModulated chunkSize =
Gen.sequenceModulated (CutSt.arrangeEquidist chunkSize)
sequenceMultiModulated ::
(Storable yv, Additive.C yv, Trans.C y) =>
SVL.ChunkSize ->
Channel ->
instrument ->
Gen.Modulator (instrument, Note) (Instrument y yv, Note) ->
Filter (SigSt.T yv)
sequenceMultiModulated chunkSize =
Gen.sequenceMultiModulated (CutSt.arrangeEquidist chunkSize)
applyModulation ::
(Storable c) =>
SigSt.T c ->
Gen.Modulator (SigSt.T c -> instr, note) (instr, note)
applyModulation =
Gen.applyModulation
advanceModulationLazy, advanceModulationStrict, advanceModulationChunky ::
(Storable a) =>
LazyTime -> State (SigSt.T a) LazyTime
advanceModulationLazy t =
modify (SigStV.drop (chunkSizesFromLazyTime t)) >> return t
advanceModulationStrict t = state $ \xs ->
let ys = SigStV.drop (chunkSizesFromLazyTime t) xs
in (Gen.evaluateVectorHead ys t, ys)
advanceModulationChunky =
Gen.advanceModulation
sequenceMultiProgram ::
(Storable yv, Additive.C yv, Trans.C y) =>
SVL.ChunkSize ->
Channel ->
Program ->
[Instrument y yv] ->
Filter (SigSt.T yv)
sequenceMultiProgram chunkSize =
Gen.sequenceMultiProgram (CutSt.arrangeEquidist chunkSize)