Commit 97ed375d by Guerric Chupin

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

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