Make MIDI velocity reflect the assembly volume

midi velocity = 8 * (asm volume + 1) - 1
Part of #16

Makefile

@@ -3,7 +3,7 @@
 release := $(shell release/version)
 
 .PHONY: all osx linux win32
-all: release/${release}-osx-x64.zip release/${release}-linux-x64.tar.gz release/${release}-win32-x86.zip
+all: osx linux win32
 osx: release/${release}-osx-x64.zip
 linux: release/${release}-linux-x64.tar.gz
 win32: release/${release}-win32-x86.zip

src/AssemblyToMidi.hs

@@ -14,12 +14,12 @@ import qualified Data.Map as Map
 
 loopFormToMidi :: Channel -> LoopForm Int -> RTB.T NN.Rational M.Event
 loopFormToMidi ch (begin, loop) = let
-  go inLoop speed octave insts = case insts of
+  go inLoop speed vol octave insts = case insts of
     [] -> if inLoop
       then RTB.singleton 0 M.End
       else case loop of
         Nothing -> RTB.singleton 0 M.End
-        Just l  -> RTB.cons 0 M.Begin $ go True speed octave l
+        Just l  -> RTB.cons 0 M.Begin $ go True speed vol octave l
     i : is -> case i of
       Note k tks pbend -> let
         addBend = case pbend of
@@ -29,29 +29,37 @@ loopFormToMidi ch (begin, loop) = let
           Ch3 -> octave + 1
           _   -> octave + 2
         in addBend
-          $ RTB.cons 0 (M.On pitch)
+          $ RTB.cons 0 (M.On pitch midiVelocity)
           $ RTB.cons (ticksToLen tks) (M.Off pitch)
-          $ go inLoop speed octave is
+          $ go inLoop speed vol octave is
       DNote tks d -> let
         pitch = fromEnum d
-        in RTB.cons 0 (M.On pitch) $ RTB.cons (ticksToLen tks) (M.Off pitch) $
-          go inLoop speed octave is
-      Rest tks -> RTB.delay (ticksToLen tks) $ go inLoop speed octave is
-      NoteType speed' vol fade ->
-        RTB.cons 0 (M.NoteType vol fade) $ go inLoop speed' octave is
-      DSpeed speed' -> go inLoop speed' octave is
-      Octave octave' -> go inLoop speed octave' is
-      Vibrato x y z -> RTB.cons 0 (M.Vibrato x y z) $ go inLoop speed octave is
-      Duty x -> RTB.cons 0 (M.Duty x) $ go inLoop speed octave is
-      Volume l r -> RTB.cons 0 (M.Volume l r) $ go inLoop speed octave is
-      StereoPanning x -> RTB.cons 0 (M.StereoPanning x) $ go inLoop speed octave is
-      Tempo x -> RTB.cons 0 (M.Tempo x) $ go inLoop speed octave is
-      TogglePerfectPitch -> RTB.cons 0 M.TogglePerfectPitch $ go inLoop speed octave is
+        in RTB.cons 0 (M.On pitch midiVelocity)
+          $ RTB.cons (ticksToLen tks) (M.Off pitch)
+          $ go inLoop speed vol octave is
+      Rest tks -> RTB.delay (ticksToLen tks) $ go inLoop speed vol octave is
+      NoteType speed' vol' fade ->
+        RTB.cons 0 (M.NoteType vol' fade) $ go inLoop speed' vol' octave is
+      DSpeed speed' -> go inLoop speed' vol octave is
+      Octave octave' -> go inLoop speed vol octave' is
+      Vibrato x y z -> RTB.cons 0 (M.Vibrato x y z) $ go inLoop speed vol octave is
+      Duty x -> RTB.cons 0 (M.Duty x) $ go inLoop speed vol octave is
+      Volume l r -> RTB.cons 0 (M.Volume l r) $ go inLoop speed vol octave is
+      StereoPanning x -> RTB.cons 0 (M.StereoPanning x) $ go inLoop speed vol octave is
+      Tempo x -> RTB.cons 0 (M.Tempo x) $ go inLoop speed vol octave is
+      TogglePerfectPitch -> RTB.cons 0 M.TogglePerfectPitch $ go inLoop speed vol octave is
       -- TODO
-      ExecuteMusic -> go inLoop speed octave is
-      DutyCycle _ -> go inLoop speed octave is
+      ExecuteMusic -> go inLoop speed vol octave is
+      DutyCycle _ -> go inLoop speed vol octave is
       where ticksToLen tks = (fromIntegral tks / 4) * (fromIntegral speed / 12)
-  in go False undefined 3 begin
+            midiVelocity = 8 * (vol + 1) - 1
+            -- This maps [0 .. 15] to [7, 15 .. 127].
+  in go
+    False -- is in loop
+    (error "loopFormToMidi: note speed not defined") -- speed
+    (error "loopFormToMidi: note volume not defined") -- volume
+    3 -- octave (don't rely on this default)
+    begin -- list of instructions to process
 
 channelTracks :: String -> Graph String Int -> [(String, RTB.T NN.Rational M.Event)]
 channelTracks prefix g = do

src/Midi.hs

@@ -42,7 +42,7 @@ data Event
   | PitchBend Int Int
   | Tempo Int
   | TogglePerfectPitch
-  | On Int
+  | On Int Int -- ^ On pitch velocity
   deriving (Eq, Ord, Show, Read)
 
 -- | Defined in recent versions of Text.Read,
@@ -55,7 +55,9 @@ readMaybe s = case reads s of
 getEvent :: E.T -> Maybe Event
 getEvent e = case e of
   E.MIDIEvent (C.Cons _ch (C.Voice (V.NoteOn p v))) ->
-    Just $ (if V.fromVelocity v /= 0 then On else Off) $ V.fromPitch p
+    Just $ if V.fromVelocity v /= 0
+      then On (V.fromPitch p) (V.fromVelocity v)
+      else Off $ V.fromPitch p
   E.MIDIEvent (C.Cons _ch (C.Voice (V.NoteOff p _v))) ->
     Just $ Off $ V.fromPitch p
   E.MetaEvent (M.TextEvent str) -> case words str of
@@ -89,7 +91,7 @@ fromEvent midiChannel e = case e of
   PitchBend x y -> textCmd "pitchbend" [x, y]
   Tempo x -> E.MetaEvent $ M.SetTempo $ round $ (toRational x / 320) * 1000000
   TogglePerfectPitch -> E.MetaEvent $ M.TextEvent "toggleperfectpitch"
-  On p -> voice0 $ V.NoteOn (V.toPitch p) (V.toVelocity 96)
+  On p v -> voice0 $ V.NoteOn (V.toPitch p) (V.toVelocity v)
   where voice0 = E.MIDIEvent . C.Cons midiChannel . C.Voice
         textCmd cmd args = E.MetaEvent $ M.TextEvent $ cmd ++ if null args
           then ""

src/MidiToAssembly.hs

@@ -91,7 +91,7 @@ simplify ch = go NNC.zero defaultNote . RTB.normalize where
       M.StereoPanning a -> RTB.delay dt <$> go' (fn { stereoPanning = Just a })
       M.PitchBend a b -> RTB.delay dt <$> go' (fn { pitchBend = Just (a, b) })
       M.Tempo a -> RTB.cons dt (Tempo a) <$> go' fn
-      M.On p -> case findOff p rtb' of
+      M.On p _ -> case findOff p rtb' of
         Nothing -> Left
           ( NNC.add posn dt
           , "simplify: note-on with pitch " ++ show p ++ " has no note-off"