synthesizer-alsa-0.0.3: src/RealTimeSynthesizer.hs
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)
-}