little_things/
manuals/
midi_linux.md
+*.eventlog
+tmp/
\ No newline at end of file
import Sound.JACK ( NFrames
)
+import FRP.Yampa
data ClientState = ClientState { rate :: Int
, buffSize :: NFrames
+ , clientClock :: Time
}
import MIDI
-isOn :: Note -> Bool
-isOn (NoteOn _ _ _) = True
-isOn _ = False
+isNoteOn :: Message -> Bool
+isNoteOn (NoteOn _ _ _) = True
+isNoteOn _ = False
-isOff :: Note -> Bool
-isOff = not . isOn
+isNoteOff :: Message -> Bool
+isNoteOff (NoteOff _ _ _) = True
+isNoteOff _ = False
-changePitch :: (Pitch -> Pitch) -> Note -> Note
+changePitch :: (Pitch -> Pitch) -> Message-> Message
changePitch f (NoteOn c p v) = NoteOn c (f p) v
changePitch f (NoteOff c p v) = NoteOff c (f p) v
-changeVelocity :: (Velocity -> Velocity) -> Note -> Note
+changeVelocity :: (Velocity -> Velocity) -> Message-> Message
changeVelocity f (NoteOn c p v) = NoteOn c p (f v)
changeVelocity f (NoteOff c p v) = NoteOff c p (f v)
-switchOnOff :: Note -> Note
+switchOnOff :: Message-> Message
switchOnOff (NoteOn c p v) = NoteOff c p v
switchOnOff (NoteOff c p v) = NoteOn c p v
-perfectFifth :: Note -> Note
+perfectFifth :: Message-> Message
perfectFifth = changePitch (toPitch . (+7) . fromPitch)
-majorThird :: Note -> Note
+majorThird :: Message-> Message
majorThird = changePitch (toPitch . (+4) . fromPitch)
-minorThird :: Note -> Note
+minorThird :: Message-> Message
minorThird = changePitch (toPitch . (+3) . fromPitch)
module Reactimation where
-import Data.Map (Map)
+import Data.Map ( Map
+ , empty
+ )
import qualified Data.Map as M
import FRP.Yampa
import Control.Concurrent.MVar
+import Sound.JACK ( NFrames(NFrames)
+ )
import MIDI
-import Arpeggiated
+import ClientState
+--import Arpeggiated
-mainReact :: IO ()
-mainReact = reactimate (initialize inRef) (sensing synthRef) actuation mainSF
+mainReact :: MVar EventQueue
+ -> MVar EventQueue
+ -> MVar ClientState
+ -> IO ()
+mainReact inRef outRef clientRef =
+ reactimate (initialize inRef) (sensing clientRef inRef) (actuation outRef) mainSF
initialize :: MVar EventQueue -> IO EventQueue
-initialize = readMVar
+initialize inRef = readMVar inRef
-sensing :: MVar (SynthState)
- -> MVar (Map Time a)
+sensing :: MVar ClientState
+ -> MVar EventQueue
-> Bool
- -> IO (DTime, Maybe (Map Time a))
-sensing synthRef inRef _ = do
- input <- readMVar inref
- synth <- readMVar synthRef
- let dt = (fromIntegral $ rate synth)/(fromIntegral $ outBuffSize synth)
+ -> IO (DTime, Maybe EventQueue)
+sensing clientRef inRef _ = do
+ client <- readMVar clientRef
+ input <- takeMVar inRef
+ let (NFrames buff) = buffSize client
+ dt = (fromIntegral $ rate client)/(fromIntegral buff)
return (dt, Just input)
+actuation :: MVar EventQueue
+ -> Bool
+ -> EventQueue
+ -> IO Bool
+actuation outRef _ output = do
+ out <- takeMVar outRef
+ putMVar outRef $ M.union output out
+ return True
-actuation = undefined
-
-mainSF :: (Message a) => SF (Map Time a) (Map Time a)
+mainSF :: SF EventQueue EventQueue
mainSF = identity
import Auxiliary
import MIDI
import ClientState
---import Reactimation
+import Reactimation
import qualified Sound.JACK as Jack
import qualified Sound.JACK.MIDI as JMIDI
Jack.withPort client inPortName $ \input -> do
clientState <- Trans.lift $ newEmptyMVar
Jack.withProcess client
- (jackLoop client clientState outState input output) $
+ (jackLoop client clientState inState outState input output) $
Jack.withActivation client $ do
- --frpid <- Trans.lift $ forkIO mainReact
+ frpid <- Trans.lift $ forkIO $ mainReact inState outState clientState
Jack.connect client (reactogonName ++ ":" ++ outPortName) fsPortName
Trans.lift $ putStrLn $ "Started " ++ reactogonName
Trans.lift $ Jack.waitForBreak
jackLoop :: Jack.Client
-> MVar ClientState -- ^ MVar containing the client state (rate and buff size)
+ -> MVar EventQueue -- ^ MVar containing incoming events
-> MVar EventQueue -- ^ MVar containing exiting events
-> JMIDI.Port Jack.Input -- ^ Jack input port
-> JMIDI.Port Jack.Output -- ^ Jack output port
-> Jack.NFrames -- ^ Buffer size for the ports
-> Sync.ExceptionalT E.Errno IO ()
-jackLoop client clientState outRef input output nframes@(Jack.NFrames nframesInt) = do
- rate <- Trans.lift $ Jack.getSampleRate client
- isEmptyState <- Trans.lift $ isEmptyMVar clientState
- let updateClient c v = if isEmptyState then putMVar c v else void $ swapMVar c v
- Trans.lift $ updateClient clientState $ ClientState { rate = rate
- , buffSize = nframes
- }
- outEvents <- Trans.lift $ takeMVar outRef
- lframe <- Trans.lift $ Jack.lastFrameTime client
- inEventsT <- JMIDI.readEventsFromPort input nframes
- let rateD = fromIntegral rate
- (Jack.NFrames lframeInt) = lframe
- currentTime = fromIntegral lframeInt / rateD
- inEvents :: EventQueue
- inEvents = M.mapMaybe fromRawMessage $
- M.fromList $ map (\(Jack.NFrames n,e) -> (currentTime + fromIntegral n/rateD, e)) $
- EventListAbs.toPairList inEventsT
- playableEvents = M.filterWithKey
- (\t _ -> t - currentTime > - fromIntegral nframesInt / rateD) $
- M.union inEvents outEvents
- (processableEvents, futureEvents) = breakMap currentTime playableEvents
- processableEvents' = M.toList processableEvents
- Trans.lift $ print currentTime
- Trans.lift $ putMVar outRef futureEvents
- {-if null processableEvents
- then Trans.lift $ putStrLn "No events in queue."
- else Trans.lift $ putStrLn "Event!"-}
- let smartSub x y = if x < y then y - x else x - y
- (firstTime,_) = head processableEvents'
- Trans.lift $ print $
- map ((* rateD) . smartSub firstTime . fst) processableEvents'
- JMIDI.writeEventsToPort output nframes $
- EventListAbs.fromPairList $
- map (\(t,e) -> (Jack.NFrames $ floor $ rateD * smartSub t currentTime
- , toRawMessage e)) $
- M.toList processableEvents
+jackLoop client clientState inRef outRef
+ input output nframes@(Jack.NFrames nframesInt) = do
+ rate <- Trans.lift $ Jack.getSampleRate client
+ lframe <- Trans.lift $ Jack.lastFrameTime client
+ isEmptyState <- Trans.lift $ isEmptyMVar clientState
+ let updateClient = if isEmptyState
+ then putMVar
+ else \c v -> void $ swapMVar c v
+ rateD = fromIntegral rate
+ (Jack.NFrames lframeInt) = lframe
+ currentTime = fromIntegral lframeInt / rateD
+ Trans.lift $ updateClient clientState $ ClientState { rate = rate
+ , buffSize = nframes
+ , clientClock = currentTime
+ }
+ outEvents <- Trans.lift $ takeMVar outRef
+ inEventsT <- JMIDI.readEventsFromPort input nframes
+ let inEvents :: EventQueue
+ inEvents = M.mapMaybe fromRawMessage $
+ M.fromList $
+ map (\(Jack.NFrames n,e) -> (currentTime + fromIntegral n/rateD, e)) $
+ EventListAbs.toPairList inEventsT
+ Trans.lift $ swapMVar inRef inEvents
+ let playableEvents = M.filterWithKey
+ (\t _ -> t - currentTime > - fromIntegral nframesInt / rateD) $
+ M.union inEvents outEvents
+ (processableEvents, futureEvents) = breakMap currentTime playableEvents
+ processableEvents' = M.toList processableEvents
+ Trans.lift $ print currentTime
+ Trans.lift $ putMVar outRef futureEvents
+ let smartSub x y = if x < y then y - x else x - y
+ (firstTime,_) = head processableEvents'
+ Trans.lift $ print $
+ map ((* rateD) . smartSub firstTime . fst) processableEvents'
+ JMIDI.writeEventsToPort output nframes $
+ EventListAbs.fromPairList $
+ map (\(t,e) -> (Jack.NFrames $ floor $ rateD * smartSub t currentTime
+ , toRawMessage e)) $
+ M.toList processableEvents
{-
else JMIDI.writeEventsToPort output nframes $
--- /dev/null
+#!/bin/bash
+
+mkdir -p ~/.log
+
+jackd -d alsa --device hw:0 --rate 44100 --period 1024 &> ~/.log/jack.log &
+
+sleep 5
+
+qjackctl &
+
+fluidsynth -a jack -m jack /usr/share/soundfonts/FluidR3_GM2-2.sf2 \
+ &> ~/.log/fluidsynth.log
+++ /dev/null
-module Main where
-
-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)
-
-import Debug.Trace
-
-scale :: [Channel.Pitch]
-scale = map Channel.toPitch [60, 62, 64, 65, 67, 69, 71, 72]
-
--- events :: EventList.T Jack.NFrames MIDI.T
-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
-
-{-
-eventList :: Jack.NFrames -> EventList.T Jack.NFrames MIDI.T
-eventList nframes = EventList.fromPairList $
- zip (map ((mappend nframes) . Jack.NFrames) [22050,44100..] ) $
- [MIDI.Channel $ Channel.Cons
- { Channel.messageChannel = Channel.toChannel 0
- , Channel.messageBody =
- Channel.Voice $ Voice.NoteOn (Voice.toPitch s) (Voice.toVelocity 100)
- } | s <- scale]
--}
-
-main :: IO ()
-main = do
- name <- getProgName
- stateRef <- newIORef (EventList.cycle eventLoop)
- Jack.handleExceptions $
- Jack.withClientDefault name $ \client ->
- Jack.withPort client "output" $ \output -> do
- Jack.withProcess client (process client stateRef output) $
- Jack.withActivation client $ do
- Jack.connect client "Melody:output" "fluidsynth:midi"
- Trans.lift $ putStrLn $ "started " ++ name ++ "..."
- Trans.lift $ Jack.waitForBreak
-
-process ::
- Jack.Client ->
- IORef (EventList.T NonNegW.Double MIDI.T) ->
- JackMidi.Port Jack.Output ->
- Jack.NFrames ->
- Sync.ExceptionalT E.Errno IO ()
-process client stateRef output nframes@(Jack.NFrames nframesInt) = do
- rate <- fmap fromIntegral $ Trans.lift $ Jack.getSampleRate client
- events <- Trans.lift $ readIORef stateRef
- let (currentEvents, futureEvents) =
- EventListTM.splitAtTime (fromIntegral nframesInt / rate) events
- Trans.lift $ writeIORef stateRef futureEvents
- JackMidi.writeEventsToPort output nframes $
- AbsEventList.mapTime (Jack.NFrames . NonNegW.toNumber) $
- EventList.toAbsoluteEventList 0 $
- EventList.resample rate $
- fst $ EventListTM.viewTimeR currentEvents
sourcephile / git / tmp / julm / arpeggigon.git / commitdiff