jack-0.7.1: examples/Melody.hs

module Main where

import Common (mainWait)

import qualified Sound.JACK.MIDI as JackMidi
import qualified Sound.JACK as Jack
import qualified Sound.MIDI.Message as MIDI
import qualified Sound.MIDI.Message.Channel as Channel
import qualified Sound.MIDI.Message.Channel.Voice as Voice
import qualified Sound.MIDI.Message.Class.Construct as MidiCons

import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class as Trans

import qualified Data.EventList.Absolute.TimeBody as AbsEventList
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Numeric.NonNegative.Wrapper as NonNegW
import Data.IORef (IORef, newIORef, readIORef, writeIORef, )

import qualified Foreign.C.Error as E

import System.Environment (getProgName)


scale :: [Channel.Pitch]
scale = map Channel.toPitch [60, 62, 64, 65, 67, 69, 71, 72]

eventLoop :: EventList.T NonNegW.Double MIDI.T
eventLoop =
    EventList.fromPairList $
    concatMap
        (\p ->
            let note on =
                    MidiCons.note (Channel.toChannel 0)
                        (Voice.normalVelocity, p, on)
            in  [(0, note True), (0.1, note False)])
        scale

main :: IO ()
main = do
    name <- getProgName
    Jack.handleExceptions $
        Jack.withClientDefault name $ \client ->
        Jack.withPort client "output" $ \output -> do
            rate <- fmap fromIntegral $ Trans.lift $ Jack.getSampleRate client
            stateRef <-
                Trans.lift $
                newIORef (EventList.resample rate $ EventList.cycle eventLoop)
            Jack.withProcess client (process stateRef output) $
                mainWait client name

process ::
    IORef (EventList.T NonNegW.Int MIDI.T) ->
    JackMidi.Port Jack.Output ->
    Jack.NFrames ->
    Sync.ExceptionalT E.Errno IO ()
process stateRef output nframes@(Jack.NFrames nframesInt) = do
    events <- Trans.lift $ readIORef stateRef
    let (currentEvents, futureEvents) =
            EventListTM.splitAtTime (fromIntegral nframesInt) events
    Trans.lift $ writeIORef stateRef futureEvents
    JackMidi.writeEventsToPort output nframes $
        AbsEventList.mapTime (Jack.NFrames . NonNegW.toNumber . fromIntegral) $
        EventList.toAbsoluteEventList 0 $
        fst $ EventListTM.viewTimeR currentEvents