Run.hs

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.Common

import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Data.EventList.Relative.TimeBody  as EventList

import qualified Synthesizer.EventList.ALSA.MIDI as Ev
import qualified Synthesizer.PiecewiseConstant.ALSA.MIDI as PC
import qualified Synthesizer.Generic.ALSA.MIDI as Gen

import qualified Synthesizer.LLVM.Frame.Stereo as Stereo

import qualified Synthesizer.LLVM.ALSA.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.CausalParameterized.Process (($<#), ($*), )
import Synthesizer.LLVM.Parameterized.Signal (($#), )

import qualified Synthesizer.Storable.Signal      as SigSt

import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg

import Control.Arrow ((<<<), arr, )
import Control.Monad.Trans.State (evalState, )

import NumericPrelude.Numeric (zero, (*>), )
import Prelude hiding (Real, break, )


sampleRate :: Num a => Option.T -> a
sampleRate opt =
   case Option.sampleRate opt of
      SampleRate sr -> sr

{-# INLINE withMIDIEvents #-}
withMIDIEvents ::
   Option.T ->
   (Option.T -> Double -> a -> IO b) ->
   (EventList.T Ev.StrictTime [Event.T] -> a) -> IO b
withMIDIEvents opt action proc =
   let rate = sampleRate opt
   in  do
          putStrLn startMessage
          Ev.withMIDIEvents
             (Option.clientName opt) (Option.periodTime opt) rate $
             action opt rate . proc



pitchBend :: IO ()
pitchBend = do
   opt <- Option.get
   osc <-
      SigP.runChunky
         ((CausalP.osciSimple WaveL.triangle $<# (zero::Real))
             $* piecewiseConstant (arr id))
   withMIDIEvents opt play $
      (id :: SigSt.T Real -> SigSt.T Real) .
      osc (Option.chunkSize opt) .
      evalState (PC.pitchBend (Option.channel opt) 2 (880/sampleRate opt::Real))


frequencyModulation :: IO ()
frequencyModulation = do
   opt <- Option.get
   osc <-
      SigP.runChunky
         (((CausalP.osciSimple WaveL.triangle $<# (zero::Real))
              <<< (MIDIL.frequencyFromBendModulation $# (10/sampleRate opt::Real)))
           $* piecewiseConstant (arr (transposeModulation (Option.sampleRate opt) 880)))
   withMIDIEvents opt play $
      (id :: SigSt.T Real -> SigSt.T Real) .
      osc (Option.chunkSize opt) .
      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 $# 0.2)
   arrange <- SigStL.makeArranger
   withMIDIEvents opt play $
      (amp () :: SigSt.T Real -> SigSt.T Real) .
      arrange (Option.chunkSize opt) .
      evalState
         (Gen.sequence
            (Option.channel opt)
            (sound (Option.chunkSize opt) (Option.sampleRate opt)))

keyboardStereo :: IO ()
keyboardStereo = do
   opt <- Option.get
   sound <- Instr.pingStereoRelease $/ 0.4 $/ 0.1
   amp <- CausalP.runStorableChunky (CausalP.amplifyStereo $# 0.2)
   arrange <- SigStL.makeArranger
   withMIDIEvents opt play $
      (amp () :: SigSt.T (Stereo.T Real) -> SigSt.T (Stereo.T Real)) .
      arrange (Option.chunkSize opt) .
      evalState
         (Gen.sequence
            (Option.channel opt)
            (sound (Option.chunkSize opt) (Option.sampleRate opt)))

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 $
--      playALSA (Bld.put :: Int16 -> Bld.Builder Int16) (sampleRate opt::Real) .
      SigSt.map (0.2*) .
      arrange (Option.chunkSize opt) .
      evalState (Gen.sequenceMultiProgram (Option.channel opt)
         (VoiceMsg.toProgram 2)
         (map (\sound -> sound $ Option.sampleRate opt) $
              [png, pngRel, tin]))

keyboardStereoMulti :: IO ()
keyboardStereoMulti = do
   opt <- Option.get
   png <- Instr.pingStereoRelease $/ 0.4 $/ 0.1 $/ Option.chunkSize opt
   tin <- Instr.tineStereo $/ 0.4 $/ 0.1 $/ Option.chunkSize opt
   str <- Instr.softString
   arrange <- SigStL.makeArranger
   withMIDIEvents opt play $
--      playALSA (Bld.put :: Int16 -> Bld.Builder Int16) (sampleRate opt::Real) .
      SigSt.map ((0.2::Real)*>) .
      arrange (Option.chunkSize opt) .
      evalState (Gen.sequenceMultiProgram (Option.channel opt)
         (VoiceMsg.toProgram 1)
         (map (\sound -> sound $ Option.sampleRate opt) $
              [png, tin, str]))