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.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.CausalParameterized.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 (zero, (*>), )
import Prelude hiding (Real, break, )


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