First reimplementation of the translator.

Beginning a complete change in the translator design. First level of translation has been implemented

diff --git a/Reactogon/Layer/Layer.hs b/Reactogon/Layer/Layer.hs
index 88b13a42418fcea6647cba8ff109e884a65e2682..9c0e914e1ad086782ccc12ae0075e0e4810b1d5b 100644 (file)
--- a/Reactogon/Layer/Layer.hs
+++ b/Reactogon/Layer/Layer.hs
@@ -3,6 +3,7 @@
 module Reactogon.Layer.Layer where
 
 import Reactogon.Semantics
+import Reactogon.Layer.Board
 import Reactogon.Global.Clock
 import FRP.Yampa
 

diff --git a/Reactogon/Semantics.hs b/Reactogon/Semantics.hs
index 70818527aca4ed54e634816e9705b04027bce45d..6f0a4876f79436967bb05a402ca18fb6d38c79ca 100644 (file)
--- a/Reactogon/Semantics.hs
+++ b/Reactogon/Semantics.hs
@@ -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.
 

diff --git a/Reactogon/Translator/Message.hs b/Reactogon/Translator/Message.hs
new file mode 100644 (file)
index 0000000..4fc1db6
--- /dev/null
+++ b/Reactogon/Translator/Message.hs
@@ -0,0 +1,71 @@
+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)))))

diff --git a/Reactogon/Translator/Translator.hs b/Reactogon/Translator/Translator.hs
new file mode 100644 (file)
index 0000000..6a98893
--- /dev/null
+++ b/Reactogon/Translator/Translator.hs
@@ -0,0 +1,12 @@
+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