{-# 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