synthesizer-alsa-0.1: src/RealTimeSynthesizerDim.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Rank2Types #-}
module Main where
import qualified Synthesizer.Dimensional.ALSA.Play as Play
import qualified Synthesizer.Dimensional.ALSA.MIDI as MIDI
import qualified Sound.Alsa as ALSA
import qualified Sound.Alsa.Sequencer as AlsaMidi
import qualified Synthesizer.EventList.ALSA.MIDI as MIDIEv
import qualified Synthesizer.Storable.ALSA.Play as PlaySt
import qualified Synthesizer.Dimensional.Causal.Process as Causal
import qualified Synthesizer.Dimensional.Causal.Oscillator as Osci
import qualified Synthesizer.Dimensional.Causal.Filter as Filt
import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CProc
import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Dimensional.Rate.Cut as CutR
import qualified Synthesizer.Dimensional.Rate.Control as CtrlR
import qualified Synthesizer.Dimensional.Rate.Oscillator as OsciR
import qualified Synthesizer.Dimensional.Rate.Filter as FiltR
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Amplitude.Cut as CutA
import qualified Synthesizer.Dimensional.Amplitude.Control as CtrlA
import qualified Synthesizer.Dimensional.Amplitude.Displacement as DispA
import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat
import qualified Synthesizer.Dimensional.Amplitude.Analysis as AnaA
import qualified Synthesizer.Dimensional.Amplitude.Filter as FiltA
import qualified Synthesizer.Dimensional.RateAmplitude.Control as CtrlD
import qualified Synthesizer.Dimensional.ChunkySize.Signal as SigC
import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Wave as WaveD
import Synthesizer.Dimensional.Causal.Process ((<<<), )
import Synthesizer.Dimensional.Wave ((&*~), )
import Synthesizer.Dimensional.Process (($:), (.:), )
import Synthesizer.Dimensional.Signal ((&*^), )
import Control.Applicative (liftA2, liftA3, )
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Frame.Stereo as Stereo
-- import Foreign.Storable (Storable, )
-- import Data.Int (Int16, )
import qualified Synthesizer.Storable.Signal as SigSt
-- import qualified Synthesizer.State.Signal as SigS
import qualified Sound.MIDI.Message.Channel as ChannelMsg
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Data.EventList.Relative.TimeBody as EventList
-- import qualified Numeric.NonNegative.Class as NonNeg
-- import qualified Numeric.NonNegative.Wrapper as NonNegW
-- import qualified Numeric.NonNegative.ChunkyPrivate as NonNegChunky
import qualified Algebra.Module as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.DimensionTerm as Dim
import qualified Number.DimensionTerm as DN
import NumericPrelude
import PreludeBase hiding (break, )
channel :: ChannelMsg.Channel
channel = ChannelMsg.toChannel 0
sampleRate :: Ring.C a => DN.Frequency a
sampleRate = DN.frequency 48000
-- sampleRate = 44100
latency :: Field.C a => DN.Time a
latency = DN.time 0.01
{-
chunkSize :: SVL.ChunkSize
chunkSize = Play.defaultChunkSize
-}
type Real = Float
{-# INLINE withMIDIEvents #-}
withMIDIEvents ::
Ring.C t =>
(DN.Frequency t -> a -> IO b) ->
(EventList.T MIDIEv.StrictTime (Maybe AlsaMidi.Event) -> a) -> IO b
withMIDIEvents action proc =
MIDIEv.withMIDIEventsNonblock
(DN.toNumberWithDimension Dim.frequency sampleRate :: Double) $
action sampleRate . proc
{-# INLINE play #-}
play ::
(Module.C y yv, ALSA.SampleFmt yv, RealField.C t) =>
DN.Frequency t ->
(forall s. Proc.T s Dim.Time t
(Play.StorableSignal s Dim.Voltage y yv)) ->
IO ()
play rate sig =
Play.renderTimeVoltageStorable rate
(FiltR.delay latency $: sig)
channelVolume :: VoiceMsg.Controller
channelVolume = VoiceMsg.modulation
exampleVolume :: IO ()
exampleVolume =
putStrLn "run 'aconnect' to connect to the MIDI controller" >>
(withMIDIEvents play $
\evs ->
liftA3
(\env osci vol ->
Causal.apply
(Causal.applySnd env osci) $ vol)
Filt.envelopeScalarDimension
(OsciR.static (DN.voltage 1 &*~ Wave.sine) zero (DN.frequency (880::Real)))
(MIDI.runFilter evs (MIDI.getControllerSignal channel channelVolume
(DN.scalar 0, DN.scalar 1) (DN.scalar (1::Real)))))
examplePitchBend :: IO ()
examplePitchBend =
withMIDIEvents play $
\evs ->
liftA2 Causal.apply
(Osci.freqMod (DN.voltage (1::Real) &*~ Wave.sine) zero)
(MIDI.runFilter evs (MIDI.getPitchBendSignal channel 2 (DN.frequency (880::Real))))
-- preserve chunk structure of channel volume
exampleVolumePitchBend0 :: IO ()
exampleVolumePitchBend0 =
putStrLn "run 'aconnect' to connect to the MIDI controller" >>
(withMIDIEvents play $
\evs ->
liftA3
(\osci env (freq,vol) ->
Causal.apply
(Causal.applySnd env (osci $ SigA.restore freq)) $ vol)
(OsciR.freqMod (DN.voltage 1 &*~ Wave.sine) zero)
Filt.envelopeScalarDimension
(MIDI.runFilter evs $ liftA2 (,)
(MIDI.getPitchBendSignal channel 2 (DN.frequency (880::Real)))
(MIDI.getControllerSignal channel channelVolume
(DN.scalar 0, DN.scalar 1) (DN.scalar (1::Real)))))
-- preserve chunk structure of pitch bender
exampleVolumePitchBend1 :: IO ()
exampleVolumePitchBend1 =
putStrLn "run 'aconnect' to connect to the MIDI controller" >>
(withMIDIEvents play $
\evs ->
liftA3
(\osci env (freq,vol) ->
Causal.apply
(Causal.applyFst env (SigA.restore vol) <<< osci)
freq)
(Osci.freqMod (DN.voltage 1 &*~ Wave.sine) zero)
Filt.envelopeScalarDimension
(MIDI.runFilter evs $ liftA2 (,)
(MIDI.getPitchBendSignal channel 2 (DN.frequency (880::Real)))
(MIDI.getControllerSignal channel channelVolume
(DN.scalar 0, DN.scalar 1) (DN.scalar (1::Real)))))
{-# INLINE ping #-}
ping :: MIDI.Instrument s Dim.Time Dim.Voltage Real Real
ping vel freq =
fmap (flip SigC.store)
(FiltR.envelope
$: CtrlR.exponential2 (DN.time 0.2)
$: OsciR.static (DN.voltage (4**vel) &*~ Wave.saw) zero freq)
exampleKeyboard :: IO ()
exampleKeyboard =
withMIDIEvents play $
\evs ->
MIDI.runFilter evs
(MIDI.getNoteSignal PlaySt.defaultChunkSize (DN.voltage 1) channel ping)
{-
Generating the envelope requires great care:
- you must avoid an append function that determines the common volume automatically,
because the volume of the second part is only known after the first part is complete
- you must terminate the release phase,
otherwise you get an infinite signal for every played note
-}
{-# INLINE pingReleaseEnvelope #-}
pingReleaseEnvelope ::
Real ->
Proc.T s Dim.Time Real
(MIDI.LazyTime s ->
SigA.T (Rate.Phantom s) (Amp.Dimensional Dim.Scalar Real) (SigSt.T Real))
pingReleaseEnvelope vel =
Proc.withParam $ \dur ->
do decay <-
fmap (SigC.store dur) $
CtrlR.exponential2 (DN.time 0.4)
end <- fmap (AnaA.endPrimitive zero) $ fmap ($decay) SigA.embedSampleRate
release <-
SigA.store (DN.time 0.01) $:
(CutR.take (DN.time 0.3) $:
fmap Flat.canonicalize
(DN.scalar end &*^ CtrlR.exponential2 (DN.time 0.1)))
append <- CutR.append
return $ (DispA.inflate (DN.fromNumber $ 4**vel) (append decay release))
-- return $ DispA.inflate (DN.fromNumber $ 4**vel) decay
{-
Proc.withParam $ \dur ->
liftA2
(\embed env ->
let x = SigC.store dur env
y = AnaA.end $ embed x
in )
SigA.embedSampleRate
(FiltR.envelope
$: CtrlR.exponential2 (DN.time 0.2)
$: OsciR.static (DN.voltage (4**vel) &*~ Wave.saw) zero freq)
-}
{-# INLINE pingRelease #-}
pingRelease :: MIDI.Instrument s Dim.Time Dim.Voltage Real Real
pingRelease vel freq =
liftA3
(\env ctrl osci dur ->
Causal.apply
(env <<< Causal.feedSnd osci)
(ctrl dur))
Filt.envelopeScalarDimension
(pingReleaseEnvelope vel)
(OsciR.static (DN.voltage 1 &*~ Wave.saw) zero freq)
exampleKeyboardMulti :: IO ()
exampleKeyboardMulti =
withMIDIEvents play $
\evs ->
MIDI.runFilter evs
(MIDI.getNoteSignalMultiProgram PlaySt.defaultChunkSize (DN.voltage 1) channel
(VoiceMsg.toProgram 0)
[ping, pingRelease])
-- [string])
{-# INLINE pingReleaseFM #-}
pingReleaseFM ::
MIDI.ModulatedInstrument s Dim.Time Real
(MIDI.Signal s Dim.Scalar Real Real ->
MIDI.Signal s Dim.Voltage Real Real)
pingReleaseFM vel freq =
liftA3
(\env ctrl osci dur fm ->
Causal.apply
(env <<<
Causal.feedSnd (osci (FiltA.amplifyScalarDimension freq $ SigA.restore fm)))
(ctrl dur))
Filt.envelopeScalarDimension
(pingReleaseEnvelope vel)
(OsciR.freqMod (DN.voltage 1 &*~ Wave.saw) zero)
exampleKeyboardFM :: IO ()
exampleKeyboardFM =
withMIDIEvents play $
\evs ->
fmap (FiltA.amplify 0.3) $
(MIDI.runFilter evs
(MIDI.getNoteSignalModulated PlaySt.defaultChunkSize (DN.voltage 1) channel pingReleaseFM $:
MIDI.getFMSignalFromBendWheelPressure channel 2 (DN.frequency 10) 0.04 0.03))
-- MIDI.getPitchBendSignal channel (2 ** recip 12) (DN.scalar one)))
{-# INLINE pingStereoDetuneFM #-}
pingStereoDetuneFM ::
MIDI.ModulatedInstrument s Dim.Time Real
(MIDI.Signal s Dim.Scalar Real Real ->
MIDI.Signal s Dim.Scalar Real Real ->
MIDI.Signal s Dim.Voltage Real (Stereo.T Real))
pingStereoDetuneFM vel freq =
liftA3
(\env ctrl osci dur detuneSt fmSt ->
let fm = SigA.restore fmSt
detune = SigA.restore detuneSt
osciChan d =
osci (FiltA.amplifyScalarDimension freq
(FiltA.envelope (DispA.raise 1 d) fm))
in SigA.rewriteAmplitudeDimension Dim.identityLeft $
Causal.apply
(env <<<
Causal.feedSnd (CutA.mergeStereo
(osciChan detune)
(osciChan $ FiltA.negate detune)))
(ctrl dur))
Filt.envelopeVectorDimension
(pingReleaseEnvelope vel)
(OsciR.freqMod (DN.voltage 1 &*~ Wave.saw) zero)
extraController :: VoiceMsg.Controller
extraController =
VoiceMsg.vectorX
-- VoiceMsg.toController 21
extraController1 :: VoiceMsg.Controller
extraController1 =
VoiceMsg.modulation
-- VoiceMsg.vectorY
-- VoiceMsg.toController 22
exampleKeyboardDetuneFM :: IO ()
exampleKeyboardDetuneFM =
withMIDIEvents play $
\evs ->
fmap (FiltA.amplify 0.3) $
(MIDI.runFilter evs
(MIDI.getNoteSignalMultiModulated PlaySt.defaultChunkSize (DN.voltage 1) channel pingStereoDetuneFM
(fmap MIDI.applyModulation
(MIDI.getFMSignalFromBendWheelPressure channel 2 (DN.frequency 10) 0.04 0.03) .:
fmap MIDI.applyModulation
(MIDI.getControllerSignal channel extraController (0, 0.005) 0))
))
{- INLINE stringReleaseEnvelope -}
stringReleaseEnvelope ::
Real ->
Proc.T s Dim.Time Real
(MIDI.LazyTime s ->
SigA.T (Rate.Phantom s) (Amp.Dimensional Dim.Scalar Real) (SigSt.T Real))
stringReleaseEnvelope vel =
Proc.withParam $ \dur ->
do let attackTime = DN.time 1
cnst <- CtrlR.constant
{-
release <- take attackTime beginning
would yield a space leak, thus we first split 'beginning'
and then concatenate it again
-}
{-
We can not easily generate attack and sustain separately,
because we want to use the chunk structure implied by 'dur'.
-}
(attack, sustain) <-
CutR.splitAt attackTime $:
(fmap (SigC.store dur .
flip CutA.appendPrimitive cnst .
DispA.map sin . Flat.canonicalize)
(CtrlD.line attackTime (0, DN.scalar (pi/2))))
let release = CutA.reverse attack
-- infixr 5 append
append <- CutR.append
return $
DispA.inflate (DN.fromNumber $ 4**vel) $
attack `append` sustain `append` release
{- INLINE string -}
string ::
MIDI.ModulatedInstrument s Dim.Time Real
(MIDI.Signal s Dim.Voltage Real (Stereo.T Real))
string vel freq =
liftA3
(\env ctrl osci dur ->
SigA.rewriteAmplitudeDimension Dim.identityLeft $
Causal.apply
(env <<< Causal.feedSnd osci)
(ctrl dur))
Filt.envelopeVectorDimension
(stringReleaseEnvelope vel)
(Proc.pure CutA.mergeStereo
$: (Proc.pure DispA.mix
$: OsciR.static (DN.voltage 0.5 &*~ Wave.saw) zero (DN.scale 1.005 freq)
$: OsciR.static (DN.voltage 0.5 &*~ Wave.saw) zero (DN.scale 0.998 freq))
$: (Proc.pure DispA.mix
$: OsciR.static (DN.voltage 0.5 &*~ Wave.saw) zero (DN.scale 1.002 freq)
$: OsciR.static (DN.voltage 0.5 &*~ Wave.saw) zero (DN.scale 0.995 freq)))
exampleKeyboardFilter :: IO ()
exampleKeyboardFilter =
withMIDIEvents play $
\evs ->
liftA3
(\osci filt (music,speed,depth) ->
(Filt.lowpassFromUniversal <<<
filt (CtrlA.constant 10)
(DispA.mapExponential 4 (DN.frequency 1000) $
FiltA.envelope (SigA.restore depth) $
osci (SigA.restore speed)))
`Causal.apply`
FiltA.amplify 0.2 music)
(OsciR.freqMod (WaveD.flat Wave.sine) zero)
(CProc.runSynchronous2 Filt.universal)
-- FiltR.universal
(MIDI.runFilter evs
(liftA3 (,,)
(MIDI.getNoteSignal PlaySt.defaultChunkSize (DN.voltage 1) channel string)
(MIDI.getControllerSignalExp channel extraController
(DN.frequency 0.1, DN.frequency 5) (DN.frequency 0.2))
(MIDI.getControllerSignal channel extraController1
(0, 1 :: DN.Scalar Real) 0.5)
))
main :: IO ()
main =
-- exampleVolume
-- examplePitchBend
-- exampleVolumePitchBend1
-- exampleKeyboard
exampleKeyboardMulti
-- exampleKeyboardFM
-- exampleKeyboardDetuneFM
-- exampleKeyboardFilter