Commit 374ee82b authored by Guerric Chupin's avatar Guerric Chupin

First reimplementation of the translator.

Beginning a complete change in the translator design. First level of translation has been implemented
parent f101a375
......@@ -3,6 +3,7 @@
module Reactogon.Layer.Layer where
import Reactogon.Semantics
import Reactogon.Layer.Board
import Reactogon.Global.Clock
import FRP.Yampa
......
......@@ -26,6 +26,20 @@ import Data.Ratio
-- Unipolar control value; [0, 1]
type UCtrl = Double
-- Unipolar control values are usually between 0 and 127.
toUCtrl :: Int -> UCtrl
toUCtrl x = fromIntegral x / 127
fromUCtrl :: UCtrl -> Int
fromUCtrl x = floor $ x * 127
-- Bipolar control values are usually between -127 and 127.
toBCtrl :: Int -> BCtrl
toBCtrl = toUCtrl
fromBCtrl :: BCtrl -> Int
fromBCtrl = fromUCtrl
-- Bipolar control value; [-1, 1]
type BCtrl = Double
......@@ -130,9 +144,9 @@ type RelPitch = Int
-- Articulation
-- Each layer has a setting that indicate how strongly the notes
-- should normally be played as a percentage of full strength.
-- (In the real application, this settig can be set to a fixed value
-- or set to be derived from teh last input note, "as played").
-- should normally be played as a percentage of full strength. (In
-- the real application, this setting can be set to a fixed value or
-- set to be derived from the last input note, "as played").
-- Individual notes can tehn be accented (played more strongly),
-- either unconditionally or as a function of the beat count.
......
module Reactogon.Translator.Message ( SampleRate
, RawMessage
) where
import Reactogon.Semantics
import qualified Sound.MIDI.Message as Message
import qualified Sound.MIDI.Message.Channel as Channel
import qualified Sound.MIDI.Message.Channel.Voice as Voice
type SampleRate = Int
type RawMessage = Message.T
type MidiVoice = Voice.T
type Channel = Channel.Channel
type ControllerIdx = Voice.Controller
-- Each channel is linked to a particular translation signal function
-- itself linked to a particular layer. Therefore we will dispose of
-- the channel number as soon as possible.
-- !!! This is dangerous as it only treats unipolar control values.
data Message = NoteOn Channel Pitch Strength
| NoteOff Channel Pitch Strength
| Control Channel ControllerIdx UCtrl
deriving(Show)
-- 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
fromRawPitch p = Pitch $ Voice.fromPitch p
toRawPitch :: Pitch -> Voice.Pitch
toRawPitch (Pitch p) = Voice.toPitch p
isNoteOn :: Message -> Bool
isNoteOn (NoteOn _ _ _) = True
isNoteOn _ = False
isNoteOff :: Message -> Bool
isNoteOff (NoteOff _ _ _) = True
isNoteOff _ = False
isControl :: Message -> Bool
isControl (Control _ _ _) = True
isControl _ = False
fromRawMessage :: RawMessage -> Maybe Message
fromRawMessage (Message.Channel (Channel.Cons c
(Channel.Voice (Voice.NoteOn p v)))) =
Just $ NoteOn c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
fromRawMessage (Message.Channel (Channel.Cons c
(Channel.Voice (Voice.NoteOff p v)))) =
Just $ NoteOff c (fromRawPitch p) (toUCtrl $ Voice.fromVelocity v)
fromRawMessage (Message.Channel (Channel.Cons c
(Channel.Voice (Voice.Control n v)))) =
Just $ Control c n (toUCtrl v)
fromRawMessage _ = Nothing
toRawMessage :: Message -> RawMessage
toRawMessage (NoteOn c p v) =
(Message.Channel $ Channel.Cons c
(Channel.Voice $ Voice.NoteOn (toRawPitch p) (Voice.toVelocity $ fromUCtrl v)))
toRawMessage (NoteOff c p v) =
(Message.Channel $ Channel.Cons c
(Channel.Voice $ Voice.NoteOff (toRawPitch p) (Voice.toVelocity $ fromUCtrl v)))
toRawMessage (Control c n v) =
(Message.Channel (Channel.Cons c
(Channel.Voice (Voice.Control n (fromUCtrl v)))))
module Reactogon.Translator.Translator where
import Reactogon.Translator.Message
import Reactogon.Semantics
-- Takes a stream of raw messages and translates them by type.
fromRaw :: SF RawMessage (Note, SystemMessage, RawMessage)
fromRaw = undefined
-- Takes a stream of high level messages and translates them by type.
toRaw :: SF (Note, SystemMessage, RawMessage) RawMessage
toRaw = undefined
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