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
...@@ -17,4 +17,5 @@ midi_linux.md ...@@ -17,4 +17,5 @@ midi_linux.md
*.eventlog *.eventlog
tmp/ tmp/
div/ div/
dump/ dump/
\ No newline at end of file *.sh
\ No newline at end of file
...@@ -6,17 +6,17 @@ as see fit. ...@@ -6,17 +6,17 @@ as see fit.
Target levels Target levels
------------- -------------
- [ ] Baseline: text interface only, not necessarily (very) interactive, - [ ] Baseline: text interface only, not necessarily (very) interactive,
but at the very least able to record a performance as a MIDI file. but at the very least able to record a performance as a MIDI file.
- [ ] Basic system with a GUI running on a Linux desktop. At least able - [ ] Basic system with a GUI running on a Linux desktop. At least able
to generate sound to generate sound
- [ ] Full-featured system with GUI running on a Linux desktop. - [ ] Full-featured system with GUI running on a Linux desktop.
- [ ] Mobile version, subject to cooperation with Ivan/Keera Studios - [ ] Mobile version, subject to cooperation with Ivan/Keera Studios
Feature Summary 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. * Up to 16 layers. Each layer an extended version of the original Reactogon.
Extensions include: Extensions include:
- Each tile has an associated "repeat count" n. The play head stays - Each tile has an associated "repeat count" n. The play head stays
...@@ -39,7 +39,7 @@ Feature Summary ...@@ -39,7 +39,7 @@ Feature Summary
- Pan pot - Pan pot
- Layer transposition - Layer transposition
- A layer can be set to be unpitched: the pitch of all output notes - A layer can be set to be unpitched: the pitch of all output notes
are set to a specific pitch (useful for e.g. rythm layers). are set to a specific pitch (useful for e.g. rythm layers).
- Muting and Soloing of layers - Muting and Soloing of layers
* MIDI integration * MIDI integration
- synchronization to external MIDI clock if selected and available - synchronization to external MIDI clock if selected and available
...@@ -60,7 +60,7 @@ Feature Summary ...@@ -60,7 +60,7 @@ Feature Summary
- Mute (inhibits all MIDI out messages, but layer continues to run) - Mute (inhibits all MIDI out messages, but layer continues to run)
- Solo (messages from all other layers inhibited, but mute status - Solo (messages from all other layers inhibited, but mute status
preserved; only one layer at a time can be soloed) preserved; only one layer at a time can be soloed)
These controls duplicated on each layer These controls duplicated on each layer
* Saving & loading of configurations * Saving & loading of configurations
* Loading of individual layers from stored configurations. * Loading of individual layers from stored configurations.
* Directly recolrding to/generating a MIDI file. Record button? * Directly recolrding to/generating a MIDI file. Record button?
...@@ -68,7 +68,7 @@ Feature Summary ...@@ -68,7 +68,7 @@ Feature Summary
Clocking Clocking
-------- --------
The system beat, relative to which the overall tempo is given (in BPM) The system beat, relative to which the overall tempo is given (in BPM)
is defined to be one quarter note. is defined to be one quarter note.
The layer beats is specified separately but defaults to one quarter note. The layer beats is specified separately but defaults to one quarter note.
...@@ -86,7 +86,7 @@ beat would thus be given by 50, 0 50. ...@@ -86,7 +86,7 @@ beat would thus be given by 50, 0 50.
Only beat numbers as defined by the layer's beats per bar would be used, Only beat numbers as defined by the layer's beats per bar would be used,
and beat numbers beyond 4 would be played straight. and beat numbers beyond 4 would be played straight.
Or one might want to allow the number of numbers to be beats per bar minus 1. Or one might want to allow the number of numbers to be beats per bar minus 1.
Overall Structure Overall Structure
----------------- -----------------
...@@ -123,14 +123,14 @@ Gloal, Layers, and MIDI translator are all FRP (Yampa) moduled. ...@@ -123,14 +123,14 @@ Gloal, Layers, and MIDI translator are all FRP (Yampa) moduled.
limited capacity of a standard MIDI connection into account limited capacity of a standard MIDI connection into account
(more corse grained translation of continous control signals (more corse grained translation of continous control signals
if too busy? dropping notes in case of excessive polyphony per if too busy? dropping notes in case of excessive polyphony per
channel and/or overall?) channel and/or overall?)
* The GUI manipulates a model of the system tailored to the needs of the * The GUI manipulates a model of the system tailored to the needs of the
GUI. Control signals are derived from this for Global and each GUI. Control signals are derived from this for Global and each
layer (e.g. the configuration of a board, the board transposition). layer (e.g. the configuration of a board, the board transposition).
The GUI also needs to observe the output from Global and Layers The GUI also needs to observe the output from Global and Layers
to animate layers as the play heads move around and to display to animate layers as the play heads move around and to display
the system tempo in case this is derived from external MIDI clock. the system tempo in case this is derived from external MIDI clock.
The GUI also needs to talk to the MIDI translator to send e.g. The GUI also needs to talk to the MIDI translator to send e.g.
......
-- 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 ...@@ -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 as Channel
import qualified Sound.MIDI.Message.Channel.Voice as Voice import qualified Sound.MIDI.Message.Channel.Voice as Voice
-- We might want to move that to Semantics.
type SampleRate = Int type SampleRate = Int
type RawMessage = Message.T type RawMessage = Message.T
......
{-# LANGUAGE Arrows #-}
-- The idea is that the stream of data coming from the MIDI input port -- The idea is that the stream of data coming from the MIDI input port
-- will be sorted in three categories: note on events, controller -- will be sorted in three categories: note on events, controller
-- events and other events. The latter will be transmitted as is -- events and other events. The latter will be transmitted as is
...@@ -22,7 +24,9 @@ sortRawMessages = sortRawMessages' ([],[]) ...@@ -22,7 +24,9 @@ sortRawMessages = sortRawMessages' ([],[])
| otherwise = sortRawMessages' ((fromJust nm) :m, rm) xs | otherwise = sortRawMessages' ((fromJust nm) :m, rm) xs
where nm = fromRawMessage x 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' ([],[]) sortNotes = sortNotes' ([],[])
where sortNotes' r [] = r where sortNotes' r [] = r
sortNotes' (n, c) (x:xs) sortNotes' (n, c) (x:xs)
...@@ -30,10 +34,21 @@ sortNotes = sortNotes' ([],[]) ...@@ -30,10 +34,21 @@ sortNotes = sortNotes' ([],[])
| isNoteOff x = sortNotes' (n,c) xs | isNoteOff x = sortNotes' (n,c) xs
| isControl x = sortNotes' (n,x:c) xs | isControl x = sortNotes' (n,x:c) xs
| otherwise = sortNotes' (n,c) xs | otherwise = sortNotes' (n,c) xs
{-
sortMessages :: [RawMessage] -> ([Note], [Control], [RawMessage]) sortMessages :: [RawMessage] -> ([Note], [Control], [RawMessage])
sortMessages = (\((a,b),c) -> (a,b,c)) . BF.first sortNotes . sortRawMessages 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 :: ([Note], [Control], [RawMessage]) -> [Message]
gatherMessages ([], [], []) = [] gatherMessages ([], [], []) = []
gatherMessages _ = undefined gatherMessages _ = undefined
readMessages :: SF ([RawMessage]) ([Note], [Control], [RawMessages])
readMessages = undefined
{-# LANGUAGE Arrows #-}
module Reactogon.Translator.Translator where module Reactogon.Translator.Translator where
import Reactogon.Translator.Message
import Reactogon.Semantics import Reactogon.Semantics
import Reactogon.Translator.Message
-- Takes a stream of raw messages and translates them by type. -- Takes a stream of raw messages and translates them by type.
fromRaw :: SF RawMessage (Note, SystemMessage, RawMessage) 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