module Main where import Synthesizer.Storable.ALSA.MIDI import qualified Synthesizer.Storable.Cut as CutSt import qualified Synthesizer.Storable.Oscillator as OsciSt import qualified Synthesizer.Basic.Wave as Wave 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.Control as CtrlS import qualified Synthesizer.State.Oscillator as OsciS import qualified Synthesizer.State.Filter.NonRecursive as FiltNRS import qualified Synthesizer.Plain.Filter.Recursive as FiltR import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter import qualified Data.EventList.Relative.TimeBody as EventList import qualified Data.EventList.Relative.TimeTime as EventListTT import qualified Data.EventList.Relative.MixedBody as EventListMB -- import qualified Data.EventList.Relative.BodyMixed as EventListBM import qualified Data.EventList.Relative.TimeMixed as EventListTM import qualified Data.EventList.Relative.MixedTime as EventListMT import Data.EventList.Relative.MixedBody ((/.), (./), ) import Control.Monad.Trans.State (state, evalState, ) -- import qualified Numeric.NonNegative.Class as NonNeg import qualified Numeric.NonNegative.Wrapper as NonNegW import qualified Numeric.NonNegative.ChunkyPrivate as NonNegChunky import qualified Algebra.RealField as RealField import NumericPrelude (zero, round, ) import Prelude hiding (round, break, ) exampleVolume :: IO () exampleVolume = putStrLn "run 'aconnect' to connect to the MIDI controller" >> (withMIDIEventsNonblock defaultSampleRate $ playMono defaultSampleRate . SigSt.zipWith (*) (OsciSt.static defaultChunkSize Wave.sine zero (800/defaultSampleRate)) . evalState (getControllerSignal 0 7 (0,1) 0)) exampleFrequency :: IO () exampleFrequency = withMIDIEventsNonblock defaultSampleRate $ playMono defaultSampleRate . OsciSt.freqMod defaultChunkSize Wave.sine zero . evalState (getControllerSignal 0 7 (400/defaultSampleRate, 1200/defaultSampleRate) (800/defaultSampleRate)) testFrequency1 :: IO () testFrequency1 = withMIDIEventsNonblock defaultSampleRate $ const (playMono (defaultSampleRate::Double) $ OsciSt.static defaultChunkSize Wave.sine zero (800/defaultSampleRate)) testFrequency2 :: IO () testFrequency2 = withMIDIEventsNonblock defaultSampleRate $ print . evalState (getControllerEvents 0 7) testFrequency3 :: IO () testFrequency3 = withMIDIEventsNonblock defaultSampleRate $ print . evalState (getSlice Just) testFrequency4 :: IO () testFrequency4 = withMIDIEventsNonblock defaultSampleRate $ print . evalState (fmap (EventListTT.catMaybesR . flip EventListTM.snocTime 0 . EventList.mapTime NonNegChunky.fromNumber) $ state (partitionMaybe (maybe (Just Nothing) (fmap Just . Just)))) examplePitchBend :: IO () examplePitchBend = withMIDIEventsNonblock defaultSampleRate $ playMono defaultSampleRate . OsciSt.freqMod defaultChunkSize Wave.sine zero . evalState (getPitchBendSignal 0 2 (880/defaultSampleRate)) exampleVolumeFrequency :: IO () exampleVolumeFrequency = putStrLn "run 'aconnect' to connect to the MIDI controller" >> (withMIDIEventsNonblock defaultSampleRate $ playMono defaultSampleRate . evalState (do vol <- getControllerSignal 0 7 (0,1) 0 freq <- getPitchBendSignal 0 2 (880/defaultSampleRate) return $ SigSt.zipWith (*) vol (OsciSt.freqMod defaultChunkSize Wave.sine zero freq))) {-# INLINE ping #-} ping :: Double -> Double -> SigSt.T Double ping vel freq = SigS.toStorableSignal defaultChunkSize $ FiltNRS.envelope (CtrlS.exponential2 (0.2*defaultSampleRate) (4**vel)) $ OsciS.static Wave.saw zero (freq/defaultSampleRate) pingDur :: Instrument pingDur dur vel freq = SigStV.take (chunkSizesFromLazyTime dur) $ ping vel freq pingRelease :: Instrument pingRelease dur vel freq = let env = SigSt.switchR SigSt.empty (\body x -> SigSt.append body $ SigS.toStorableSignal defaultChunkSize $ SigS.take (round (0.3*defaultSampleRate :: Double)) $ CtrlS.exponential2 (0.1*defaultSampleRate) x) $ SigS.toStorableSignalVary (chunkSizesFromLazyTime dur) $ CtrlS.exponential2 (0.4*defaultSampleRate) (4**vel) in SigS.zipWithStorable (*) (OsciS.static Wave.saw zero (freq/defaultSampleRate)) env exampleKeyboard :: IO () exampleKeyboard = withMIDIEventsNonblock defaultSampleRate $ playMono defaultSampleRate . SigSt.map (0.2*) . evalState (getNoteSignal 0 pingRelease) exampleKeyboardFilter :: IO () exampleKeyboardFilter = withMIDIEventsNonblock defaultSampleRate $ playMono defaultSampleRate . SigSt.map (0.2*) . evalState (do music <- getNoteSignal 0 pingRelease freq <- getControllerSignal 0 21 (100/defaultSampleRate, 5000/defaultSampleRate) (700/defaultSampleRate) return $ SigS.toStorableSignal defaultChunkSize $ SigS.map UniFilter.lowpass $ SigS.modifyModulated UniFilter.modifier (SigS.map UniFilter.parameter $ SigS.zipWith FiltR.Pole (SigS.repeat 5) (SigS.fromStorableSignal freq)) $ SigS.fromStorableSignal music) testKeyboard1 :: IO () testKeyboard1 = withMIDIEventsNonblock defaultSampleRate $ const (playMono defaultSampleRate $ ping 0 440) testKeyboard2 :: SigSt.T Double testKeyboard2 = let music :: Double -> EventList.T StrictTime (SigSt.T Double) music x = 5 /. SigSt.replicate defaultChunkSize 6 x ./ music (x+1) in CutSt.arrange defaultChunkSize $ EventList.mapTime fromIntegral $ music 42 testKeyboard3 :: SigSt.T Double testKeyboard3 = let time :: Double -> Int time t = round (t * defaultSampleRate) music :: Double -> EventList.T StrictTime (SigSt.T Double) music x = fromIntegral (time 0.2) /. SigSt.take (time 0.4) (ping 0 x) ./ music (x*1.01) in CutSt.arrange defaultChunkSize $ EventList.mapTime fromIntegral $ music 110 makeLazyTime :: Double -> LazyTime makeLazyTime t = NonNegChunky.fromNumber $ NonNegW.fromNumberMsg "keyboard time" $ round (t * defaultSampleRate) testKeyboard4 :: SigSt.T Double testKeyboard4 = let {- idInstr :: Double -> Double -> SigSt.T Double idInstr _vel freq = SigSt.repeat defaultChunkSize freq -} -- inf = time 0.4 + inf music :: Int -> EventListTT.T LazyTime (Int,Int,LazyTime) music p = makeLazyTime 0.2 EventListMT./. -- (p, 64, inf) EventListMT../ (p, 64, makeLazyTime 0.4) EventListMT../ music (p+1) in CutSt.arrange defaultChunkSize $ EventListTM.switchTimeR const $ EventListTT.mapTime fromIntegral $ insertBreaks $ makeInstrumentSounds pingDur $ music 0 exampleNotes0 :: Int -> EventListTT.T LazyTime (Int,Int,Bool) exampleNotes0 p = makeLazyTime 0.2 EventListMT./. (let (oct,pc) = divMod p 12 in (50 + pc, 64, even oct)) EventListMT../ exampleNotes0 (p+1) exampleNotes1 :: EventListTT.T LazyTime (Int,Int,Bool) exampleNotes1 = makeLazyTime 0.2 EventListMT./. (50, 64, True) EventListMT../ makeLazyTime 0.2 EventListMT./. (52, 64, True) EventListMT../ makeLazyTime 0.2 EventListMT./. (54, 64, True) EventListMT../ makeLazyTime 0.2 EventListMT./. -- (50, 64, False) EventListMT../ undefined testKeyboard5 :: SigSt.T Double testKeyboard5 = CutSt.arrange defaultChunkSize $ EventListTM.switchTimeR const $ EventListTT.mapTime fromIntegral $ insertBreaks $ makeInstrumentSounds pingDur $ matchNoteEvents $ exampleNotes0 0 testKeyboard6 :: EventListTT.T LazyTime (Int,Int,LazyTime) testKeyboard6 = matchNoteEvents exampleNotes1 testKeyboard7 :: EventListTT.T LazyTime (Int,Int) testKeyboard7 = EventListTT.mapBody (\ ~(p,v,_b) -> (p,v)) $ testKeyboard6 main :: IO () main = -- print testKeyboard3 -- playMono defaultSampleRate testKeyboard3 -- examplePitchBend -- exampleKeyboard exampleKeyboardFilter {- main :: IO () main = do putStrLn "Starting." h <- open default_seq_name OpenInput Block set_client_name h "HS1" putStrLn "Created sequencer." p1 <- create_simple_port h "one" (caps [cap_write,cap_subs_write]) type_midi_generic p2 <- create_simple_port h "two" (caps [cap_write,cap_subs_write]) type_midi_generic putStrLn "Created ports." let loop = do putStrLn "waiting for an event:" e <- event_input h print e loop loop delete_port h p1 delete_port h p2 putStrLn "Deleted ports." close h putStrLn "Closed sequencer." `alsa_catch` \e -> putStrLn ("Problem: " ++ exception_description e) -}