Commit 97ed375d authored by Guerric Chupin's avatar Guerric Chupin

Translation from high to low level progressing. Should be finished soon.

parent 46d44d48
...@@ -2,10 +2,9 @@ ...@@ -2,10 +2,9 @@
module RCMA.Layer.Layer where module RCMA.Layer.Layer where
import RCMA.Semantics
import RCMA.Layer.Board
import RCMA.Global.Clock
import FRP.Yampa import FRP.Yampa
import RCMA.Global.Clock
import RCMA.Semantics
-- Data representing the state of a layer. It is updated continuously. -- Data representing the state of a layer. It is updated continuously.
data Layer = Layer { relTempo :: Double data Layer = Layer { relTempo :: Double
......
...@@ -62,6 +62,12 @@ toBCtrl = toUCtrl ...@@ -62,6 +62,12 @@ toBCtrl = toUCtrl
fromBCtrl :: BCtrl -> Int fromBCtrl :: BCtrl -> Int
fromBCtrl = fromUCtrl fromBCtrl = fromUCtrl
------------------------------------------------------------------------------
-- Tempo
------------------------------------------------------------------------------
type Tempo = Int
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Time and Beats -- Time and Beats
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
...@@ -128,7 +134,9 @@ type MIDICV = Int ...@@ -128,7 +134,9 @@ type MIDICV = Int
-- (Handled through subsequent translation to low-level MIDI events.) -- (Handled through subsequent translation to low-level MIDI events.)
data MIDICVRnd = MIDICV MIDICV | MIDICVRnd deriving (Eq, Show) data MIDICVRnd = MIDICV MIDICV | MIDICVRnd deriving (Eq, Show)
-- TEMPORARY
data Controller = Lol
--
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Notes -- Notes
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
......
...@@ -34,6 +34,9 @@ getChannel (NoteOn c _ _) = Channel.fromChannel c ...@@ -34,6 +34,9 @@ getChannel (NoteOn c _ _) = Channel.fromChannel c
getChannel (NoteOff c _ _) = Channel.fromChannel c getChannel (NoteOff c _ _) = Channel.fromChannel c
getChannel (Control c _ _) = Channel.fromChannel c getChannel (Control c _ _) = Channel.fromChannel c
makeChannel :: Int -> Channel
makeChannel = Channel.toChannel
-- Function to go back and forth with the representations of pitches, -- Function to go back and forth with the representations of pitches,
-- as they are different in our model and in the Jack API model. -- as they are different in our model and in the Jack API model.
fromRawPitch :: Voice.Pitch -> Pitch fromRawPitch :: Voice.Pitch -> Pitch
...@@ -55,6 +58,10 @@ isControl :: Message -> Bool ...@@ -55,6 +58,10 @@ isControl :: Message -> Bool
isControl (Control _ _ _) = True isControl (Control _ _ _) = True
isControl _ = False isControl _ = False
switchOnOff :: Message -> Message
switchOnOff (NoteOn c p v) = NoteOff c p v
switchOnOff (NoteOff c p v) = NoteOn c p v
fromRawMessage :: RawMessage -> Maybe Message fromRawMessage :: RawMessage -> Maybe Message
fromRawMessage (Message.Channel (Channel.Cons c fromRawMessage (Message.Channel (Channel.Cons c
(Channel.Voice (Voice.NoteOn p v)))) = (Channel.Voice (Voice.NoteOn p v)))) =
......
module Note where {-# LANGUAGE Arrows #-}
import MIDI module RCMA.Translator.Note where
isNoteOn :: Message -> Bool import Data.Ratio
isNoteOn (NoteOn _ _ _) = True import FRP.Yampa
isNoteOn _ = False import RCMA.Global.Clock
import RCMA.Layer.Layer
isNoteOff :: Message -> Bool import RCMA.Semantics
isNoteOff (NoteOff _ _ _) = True import RCMA.Translator.Message
isNoteOff _ = False
messageToNote :: Message -> Note
changePitch :: (Pitch -> Pitch) -> Message-> Message messageToNote (NoteOn _ p s) = Note { notePch = p
changePitch f (NoteOn c p v) = NoteOn c (f p) v , noteStr = s
changePitch f (NoteOff c p v) = NoteOff c (f p) v , noteDur = 1 % 4
, noteOrn = noOrn
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) -- noteToMessage gives a pair of two time-stamped messages. The one on
-- the left is a note message, the other a note off.
switchOnOff :: Message-> Message --
switchOnOff (NoteOn c p v) = NoteOff c p v -- For now this is only a tuple but a list will probably be necessary.
switchOnOff (NoteOff c p v) = NoteOn c p v noteToMessages :: Tempo -> Layer -> Int -> (Time,Note)
-> ((Time,Message),(Time,Message))
perfectFifth :: Message-> Message noteToMessages tempo l@(Layer { relTempo = rt }) chan =
perfectFifth = changePitch (toPitch . (+7) . fromPitch) proc m@(t,n@Note { notePch = p
, noteStr = s
majorThird :: Message-> Message , noteDur = d
majorThird = changePitch (toPitch . (+4) . fromPitch) , noteOrn = noOrn
}) -> do
minorThird :: Message-> Message nm <- noteOnToMessage l chan -< n
minorThird = changePitch (toPitch . (+3) . fromPitch) t' <- returnA -< t + fromRational $ d * tempoToDTime $ rt * fromIntegral tempo
returnA -< ((t,nm),(t',switchOnOff nm))
noteOnToMessage :: Int -> Note -> Message
noteOnToMessage c (Note { notePch = p
, noteStr = s
}) = NoteOn (makeChannel c) p s
convertControl :: Message -> Controller
convertControl _ = Lol
...@@ -15,10 +15,7 @@ import Data.Ratio ...@@ -15,10 +15,7 @@ import Data.Ratio
import FRP.Yampa import FRP.Yampa
import RCMA.Semantics import RCMA.Semantics
import RCMA.Translator.Message import RCMA.Translator.Message
import RCMA.Translator.Note
-- TEMPORARY
data Controller = Lol
--
sortRawMessages :: [(Frames, RawMessage)] sortRawMessages :: [(Frames, RawMessage)]
-> ([(Frames,Message)], [(Frames,RawMessage)]) -> ([(Frames,Message)], [(Frames,RawMessage)])
...@@ -53,29 +50,6 @@ sortNotes = sortNotes' ([],[]) ...@@ -53,29 +50,6 @@ sortNotes = sortNotes' ([],[])
convertMessages :: ([(Frames,Message)], [(Frames,Message)]) convertMessages :: ([(Frames,Message)], [(Frames,Message)])
-> ([(Frames,Note)], [(Frames,Controller)]) -> ([(Frames,Note)], [(Frames,Controller)])
convertMessages = proc (notes, ctrl) -> do convertMessages = proc (notes, ctrl) -> do
notes' <- arr $ map (BF.second convertNotes) -< notes notes' <- arr $ map (BF.second messageToNote) -< notes
ctrl' <- arr $ map (BF.second convertControl) -< ctrl ctrl' <- arr $ map (BF.second messageToControl) -< ctrl
returnA -< (notes', ctrl') returnA -< (notes', ctrl')
-- /!\ Unsafe function that shouldn't be exported.
convertNotes :: Message -> Note
convertNotes (NoteOn _ p s) = Note { notePch = p
, noteStr = s
, noteDur = 1 % 4
, noteOrn = noOrn
}
-- /!\ Unsafe function that shouldn't be exported.
convertControl :: Message -> Controller
convertControl _ = Lol
gatherMessages :: ([Note], [Controller], [RawMessage]) -> [Message]
gatherMessages ([], [], []) = []
gatherMessages _ = undefined
readMessages :: [(Frames,RawMessage)]
-> ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
readMessages = proc r -> do
(mes, raw) <- sortRawMessages -< r
(notes, ctrl) <- convertMessages <<< sortNotes -< mes
returnA -< (notes, ctrl, raw)
...@@ -2,17 +2,24 @@ ...@@ -2,17 +2,24 @@
module RCMA.Translator.Translator where module RCMA.Translator.Translator where
import qualified Data.Bifunctor as BF
import FRP.Yampa import FRP.Yampa
import RCMA.Semantics import RCMA.Semantics
import RCMA.Translator.Message import RCMA.Translator.Message
import RCMA.Translator.SortMessage import RCMA.Translator.SortMessage
-- Takes a stream of raw messages and translates them by type. -- Uses function defined in SortMessage. This is a pure function and
fromRaw :: SF [(Frames, RawMessage)] -- it might not need to be a signal function.
([(Frames, Note)], [(Frames, Controller)], [(Frames, RawMessage)]) readMessages :: [(Frames,RawMessage)]
fromRaw = proc input -> do -> ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
returnA -< undefined readMessages = proc r -> do
(mes, raw) <- sortRawMessages -< r
(notes, ctrl) <- convertMessages <<< sortNotes -< mes
returnA -< (notes, ctrl, raw)
-- Takes a stream of high level messages and translates them by type. gatherMessages :: ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
toRaw :: SF (Note, Controller, RawMessage) RawMessage -> [(Frames, RawMessage)]
toRaw = undefined gatherMessages = proc (notes, ctrl, raw) -> do
rawNotes <- map (BF.second toRawMessage) -< notes
rawCtrl <- map (BF.second toRawMessage) -< ctrl
returnA -< rawNotes ++ rawCtrl ++ raw
module Note where
import MIDI
isNoteOn :: Message -> Bool
isNoteOn (NoteOn _ _ _) = True
isNoteOn _ = False
isNoteOff :: Message -> Bool
isNoteOff (NoteOff _ _ _) = True
isNoteOff _ = False
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) -> 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 :: Message-> Message
switchOnOff (NoteOn c p v) = NoteOff c p v
switchOnOff (NoteOff c p v) = NoteOn c p v
perfectFifth :: Message-> Message
perfectFifth = changePitch (toPitch . (+7) . fromPitch)
majorThird :: Message-> Message
majorThird = changePitch (toPitch . (+4) . fromPitch)
minorThird :: Message-> Message
minorThird = changePitch (toPitch . (+3) . fromPitch)
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