module Synthesizer.LLVM.Server.Scalar.Run where import qualified Synthesizer.LLVM.Server.Scalar.Instrument as Instr import qualified Synthesizer.LLVM.Server.Option as Option import Synthesizer.LLVM.Server.ALSA (Output, play, startMessage, ) import Synthesizer.LLVM.Server.Common import qualified Sound.ALSA.Sequencer.Event as Event import qualified Data.EventList.Relative.TimeBody as EventList import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.MIDI as MIDIL import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Storable.Signal as SigStL import qualified Synthesizer.LLVM.Wave as WaveL import Synthesizer.LLVM.Causal.Process (($<#), ($*), ) import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.ALSA.EventList as Ev import qualified Synthesizer.MIDI.PiecewiseConstant as PC import qualified Synthesizer.MIDI.Generic as Gen import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg import Control.Arrow ((<<<), arr, ) import Control.Monad.Trans.State (evalState, ) import Control.Exception (bracket, ) import NumericPrelude.Numeric (fromIntegral, zero, (*), (*>), (/), ) import NumericPrelude.Base import Prelude (Double) {-# INLINE withMIDIEvents #-} withMIDIEvents :: Option.T -> Output handle signal a -> (SigSt.ChunkSize -> SampleRate Real -> EventList.T Ev.StrictTime [Event.T] -> signal) -> IO a withMIDIEvents opt output process = do putStrLn startMessage case output opt of (open,close,write) -> bracket open (close . snd) $ \((chunkSize,rate),h) -> let rrate = fromIntegral rate :: Double in Ev.withMIDIEvents (Option.clientName opt) (fromIntegral chunkSize / rrate) rrate (write h . process (SigSt.chunkSize chunkSize) (Option.SampleRate $ fromIntegral rate)) freq :: Option.SampleRate Real -> Real -> Real freq (Option.SampleRate sampleRate) f = f / sampleRate pitchBend :: IO () pitchBend = do opt <- Option.get osc <- SigP.runChunky ((CausalP.osciSimple WaveL.triangle $<# (zero::Real)) $* piecewiseConstant (arr id)) withMIDIEvents opt play $ \chunkSize sampleRate -> (id :: SigSt.T Real -> SigSt.T Real) . osc chunkSize . evalState (PC.pitchBend (Option.channel opt) 2 (freq sampleRate 880)) frequencyModulation :: IO () frequencyModulation = do opt <- Option.get osc <- SigP.runChunky (((CausalP.osciSimple WaveL.triangle $<# (zero::Real)) <<< (MIDIL.frequencyFromBendModulation (frequencyConst (10::Real)))) $* piecewiseConstant (arr (\(sr,ctrl) -> transposeModulation sr 880 ctrl))) withMIDIEvents opt play $ \chunkSize sampleRate -> (id :: SigSt.T Real -> SigSt.T Real) . osc chunkSize . (,) sampleRate . evalState (PC.bendWheelPressure (Option.channel opt) 2 0.04 (0.03::Real)) keyboard :: IO () keyboard = do opt <- Option.get -- sound <- Instr.pingDur {- sound <- fmap (\s vel _freq dur -> s vel dur) $ (Instr.pingReleaseEnvelope $/ 0.4 $/ 0.1) -} sound <- Instr.pingRelease $/ 0.4 $/ 0.1 amp <- CausalP.runStorableChunky (CausalP.amplify (arr id)) arrange <- SigStL.makeArranger withMIDIEvents opt play $ \chunkSize sampleRate -> (amp :: Real -> SigSt.T Real -> SigSt.T Real) 0.2 . arrange chunkSize . evalState (Gen.sequence (Option.channel opt) (sound chunkSize sampleRate)) keyboardStereo :: IO () keyboardStereo = do opt <- Option.get sound <- Instr.pingStereoRelease $/ 0.4 $/ 0.1 amp <- CausalP.runStorableChunky (CausalP.amplifyStereo (arr id)) arrange <- SigStL.makeArranger withMIDIEvents opt play $ \chunkSize sampleRate -> (amp :: Real -> SigSt.T (Stereo.T Real) -> SigSt.T (Stereo.T Real)) 0.2 . arrange chunkSize . evalState (Gen.sequence (Option.channel opt) (sound chunkSize sampleRate)) keyboardMulti :: IO () keyboardMulti = do opt <- Option.get png <- Instr.pingDur pngRel <- Instr.pingRelease $/ 0.4 $/ 0.1 $/ Option.chunkSize opt tin <- Instr.tine $/ 0.4 $/ 0.1 $/ Option.chunkSize opt arrange <- SigStL.makeArranger withMIDIEvents opt play $ \chunkSize sampleRate -> -- playALSA (Bld.put :: Int16 -> Bld.Builder Int16) (sampleRate opt::Real) . SigSt.map (0.2*) . arrange chunkSize . evalState (Gen.sequenceMultiProgram (Option.channel opt) (VoiceMsg.toProgram 2) (map ($ sampleRate) [png, pngRel, tin])) keyboardStereoMulti :: IO () keyboardStereoMulti = do opt <- Option.get png <- Instr.pingStereoRelease $/ 0.4 $/ 0.1 tin <- Instr.tineStereo $/ 0.4 $/ 0.1 str <- Instr.softString arrange <- SigStL.makeArranger withMIDIEvents opt play $ \chunkSize sampleRate -> -- playALSA (Bld.put :: Int16 -> Bld.Builder Int16) (sampleRate opt::Real) . SigSt.map ((0.2::Real)*>) . arrange chunkSize . evalState (Gen.sequenceMultiProgram (Option.channel opt) (VoiceMsg.toProgram 1) (map (\sound -> sound chunkSize sampleRate) [png, tin, const str]))