Commit 8d13572d authored by Guerric Chupin's avatar Guerric Chupin

Did some work on the translation. Work of precision needs to be done now.

parent 7aee3999
......@@ -18,3 +18,4 @@ midi_linux.md
tmp/
div/
dump/
*.sh
\ No newline at end of file
......@@ -16,7 +16,7 @@ Target levels
Feature Summary
---------------
* Modelled after the origial Reactogon
* Modelled after the original Reactogon
* Up to 16 layers. Each layer an extended version of the original Reactogon.
Extensions include:
- Each tile has an associated "repeat count" n. The play head stays
......
-- Contains function to currify/uncurrify functions with more than
-- two arguments. It might be useful to use Template Haskell there.
module Reactogon.Auxiliary.Curry where
curry3 :: ((a,b,c) -> d) -> a -> b -> c -> d
curry3 f a b c = f (a,b,c)
uncurry3 :: (a -> b -> c -> d) -> (a,b,c) -> d
uncurry3 f (a,b,c) = f a b c
curry4 :: ((a,b,c,d) -> e) -> a -> b -> c -> d -> e
curry4 f a b c d = f (a,b,c,d)
uncurry4 :: (a -> b -> c -> d -> e) -> (a,b,c,d) -> e
uncurry4 f (a,b,c,d) = f a b c d
-- Contains function for scheduling and filtering events given the
-- correct informations.
module Reactogon.Translator.Filter where
import Data.Bifunctor as BF
import Data.List (group, sortBy)
import Data.Ord
import FRP.Yampa
import Reactogon.Semantics
import Reactogon.Translator.Message
import Sound.JACK (NFrames (NFrames))
-- Takes a list of time stamped "things", a sample rate and a buffer
-- size. The function argument is a function that needs to tell which
-- arguments are kept in the case where two would come into
-- contact. On the left are the events that can be thrown into the
-- buffer, on the right are the events that will need to wait. Both
-- list are sorted.
--
-- /!\ The time is relative. A preprocessing operation removing all
-- events to soon to be happening and shifting them is necessary.
schedule :: (Eq a) =>
SampleRate
-> NFrames
-> [(Time, a)]
-> ([(NFrames,a)], [(Time,a)])
schedule sr (NFrames size) = BF.first convertTime . break ((>= maxTime) . fst)
. sortBy (comparing fst)
where srd = fromIntegral sr
maxTime = fromIntegral size / srd
convertTime :: (Eq a) => [(Time, a)] -> [(NFrames, a)]
convertTime = map (BF.first (NFrames . floor . (srd *)))
-- The function choose between the event in case two are in conflict.
--
-- /!\ That functional argument is a bit unsatisfying, it would be
-- probably better if we'd try to push events to the next frame if
-- they conflict and only remove them if it's impossible to do
-- otherwise.
nubDuplicate :: (Eq a) => ([a] -> a) -> [(NFrames, a)] -> [(NFrames, a)]
nubDuplicate f = map (BF.second f)
. map (\l@((n,_):_) -> (n,map snd l)) . group
chooseDuplicate :: [a] -> a
chooseDuplicate = undefined
{-# LANGUAGE Arrows #-}
-- Contains all the information and functions necessary to run a Jack
-- port and exchange information through reactive values and Yampa.
module Reactogon.Translator.Jack where
import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class as Trans
import qualified Foreign.C.Error as E
import Hails.Yampa
import Reactogon.Translator.Message
import qualified Sound.JACK as Jack
import qualified Sound.JACK.MIDI as JMIDI
reactogonName :: String
reactogonName = "Reactogon"
inPortName :: String
inPortName = "input"
outPortName :: String
outPortName = "output"
jackSetup :: IO ()
jackSetup = Jack.handleExceptions $
Jack.withClientDefault reactogonName $ \client ->
Jack.withPort client outPortName $ \output ->
Jack.withPort client inPortName $ \input ->
jackRun client input output (jackCallBack client input output)
jackRun client input output callback =
Jack.withProcess client callback $ do
Trans.lift $ putStrLn $ "Started " ++ reactogonName
Trans.lift $ Jack.waitForBreak
jackCallBack client input output = undefined
......@@ -5,6 +5,7 @@ import qualified Sound.MIDI.Message as Message
import qualified Sound.MIDI.Message.Channel as Channel
import qualified Sound.MIDI.Message.Channel.Voice as Voice
-- We might want to move that to Semantics.
type SampleRate = Int
type RawMessage = Message.T
......
{-# LANGUAGE Arrows #-}
-- The idea is that the stream of data coming from the MIDI input port
-- will be sorted in three categories: note on events, controller
-- events and other events. The latter will be transmitted as is
......@@ -22,7 +24,9 @@ sortRawMessages = sortRawMessages' ([],[])
| otherwise = sortRawMessages' ((fromJust nm) :m, rm) xs
where nm = fromRawMessage x
sortNotes :: [Message] -> ([Note], [Control])
-- NoteOn messages are on the right, other Control messages are on the
-- left. For now we throw away NoteOff messages.
sortNotes :: [Message] -> ([Message], [Message])
sortNotes = sortNotes' ([],[])
where sortNotes' r [] = r
sortNotes' (n, c) (x:xs)
......@@ -30,10 +34,21 @@ sortNotes = sortNotes' ([],[])
| isNoteOff x = sortNotes' (n,c) xs
| isControl x = sortNotes' (n,x:c) xs
| otherwise = sortNotes' (n,c) xs
{-
sortMessages :: [RawMessage] -> ([Note], [Control], [RawMessage])
sortMessages = (\((a,b),c) -> (a,b,c)) . BF.first sortNotes . sortRawMessages
-}
-- Note messages are converted to PlayHeads
sortMessages :: SF ([Message], [Message]) ([Note], [Control])
sortMessages = proc (notes, ctrl) -> do
notes' <- convertNotes -< notes
ctrl' <- convertControl -< ctrl
returnA -< (notes', ctrl')
gatherMessages :: ([Note], [Control], [RawMessage]) -> [Message]
gatherMessages ([], [], []) = []
gatherMessages _ = undefined
readMessages :: SF ([RawMessage]) ([Note], [Control], [RawMessages])
readMessages = undefined
{-# LANGUAGE Arrows #-}
module Reactogon.Translator.Translator where
import Reactogon.Translator.Message
import Reactogon.Semantics
import Reactogon.Translator.Message
-- Takes a stream of raw messages and translates them by type.
fromRaw :: SF RawMessage (Note, SystemMessage, RawMessage)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment