Skip to content

Commit d885de2

Browse files
smoothdevelopersmoothdeveloper
committed
add test of roundtriping MDKit from / to sysex
1 parent 1d9d6c7 commit d885de2

File tree

6 files changed

+142
-21
lines changed

6 files changed

+142
-21
lines changed

‎Directory.Build.props‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
<Project>
2-
<PropertyGroup>
2+
<PropertyGroup Condition="'$(MSBuildProjectExtension)' == '.fsproj'">
33
<Deterministic>true</Deterministic>
44
<DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
55
<OtherFlags>$(OtherFlags) --warnon:1182</OtherFlags>

‎Midinette.sln‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,9 +20,11 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "bits", "bits", "{4DB40A2C-F
2020
readme.md = readme.md
2121
EndProjectSection
2222
EndProject
23-
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Midinette.Platform.RtMidi", "src\Midinette.Platform.RtMidi\Midinette.Platform.RtMidi.fsproj", "{1BDC05D1-A580-4692-B34D-FEEC335BD163}"
23+
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Midinette.Platform.RtMidi", "src\Midinette.Platform.RtMidi\Midinette.Platform.RtMidi.fsproj", "{1BDC05D1-A580-4692-B34D-FEEC335BD163}"
2424
EndProject
25-
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Midinette.Platform.Tests", "tests\Midinette.Platform.Tests\Midinette.Platform.Tests.fsproj", "{7DB16A0F-815C-45F3-8FF2-2A8892EA58F8}"
25+
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Midinette.Platform.Tests", "tests\Midinette.Platform.Tests\Midinette.Platform.Tests.fsproj", "{7DB16A0F-815C-45F3-8FF2-2A8892EA58F8}"
26+
EndProject
27+
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Midinette.Elektron.Tests", "tests\Midinette.Elektron.Tests\Midinette.Elektron.Tests.fsproj", "{E45F6DEF-20D0-412B-B962-57D4C8705523}"
2628
EndProject
2729
Global
2830
GlobalSection(SolutionConfigurationPlatforms) = preSolution
@@ -54,6 +56,10 @@ Global
5456
{7DB16A0F-815C-45F3-8FF2-2A8892EA58F8}.Debug|Any CPU.Build.0 = Debug|Any CPU
5557
{7DB16A0F-815C-45F3-8FF2-2A8892EA58F8}.Release|Any CPU.ActiveCfg = Release|Any CPU
5658
{7DB16A0F-815C-45F3-8FF2-2A8892EA58F8}.Release|Any CPU.Build.0 = Release|Any CPU
59+
{E45F6DEF-20D0-412B-B962-57D4C8705523}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
60+
{E45F6DEF-20D0-412B-B962-57D4C8705523}.Debug|Any CPU.Build.0 = Debug|Any CPU
61+
{E45F6DEF-20D0-412B-B962-57D4C8705523}.Release|Any CPU.ActiveCfg = Release|Any CPU
62+
{E45F6DEF-20D0-412B-B962-57D4C8705523}.Release|Any CPU.Build.0 = Release|Any CPU
5763
EndGlobalSection
5864
GlobalSection(SolutionProperties) = preSolution
5965
HideSolutionNode = FALSE

‎src/Midinette.Elektron/Elektron.MachineDrum.Parameters.fs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,5 @@
11
module Elektron.MachineDrum.Parameters
22

3-
4-
53
let effectsParameters =
64
[|
75
("AMD", "controls the the modulation depth")
@@ -13,6 +11,7 @@ let effectsParameters =
1311
("FLTQ", "controls the filter quality Q parameter")
1412
("SRR", "controls the amount of sample rate reduction")
1513
|]
14+
|> Array.zip MDTrackParameter.effectsParameters
1615

1716
let routingParameters =
1817
[|
@@ -25,6 +24,8 @@ let routingParameters =
2524
("LFOD", "controls the modulation depth of the LFO")
2625
("LFOM", "controls the mix between the two selectable LFO waveforms")
2726
|]
27+
|> Array.zip MDTrackParameter.routingParameters
28+
2829
type SynthesisParameterName =
2930
| Pitch
3031
| Decay

‎src/Midinette.Elektron/Elektron.MachineDrum.fs‎

Lines changed: 115 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -12,13 +12,13 @@ open Midinette.Sysex
1212

1313
type NonZeroIndexedArraySegment<'t>(baseLogicalAddress: int, segment: ArraySegment<'t>) =
1414
let checkAddress address =
15-
if address < baseLogicalAddress then failwithf "can't query bellow base logical address"
15+
if address < baseLogicalAddress then failwithf "can't query at %i which is bellow base logical address %i" address baseLogicalAddress
1616
let address = address - baseLogicalAddress
17-
if address >= segment.Count then failwithf "can't query after the segment"
17+
if address >= segment.Count then failwithf "can't query at %i which is past the segment (length: %i)" address segment.Count
1818
address
1919
let checkAddressAndLength address length =
2020
let address = checkAddress address
21-
if length > segment.Count then failwithf "can't query length past segment"
21+
if length > segment.Count then failwithf "can't query at %i elements from %i which is past the segment (length: %i)" length address segment.Count
2222
address
2323
member x.LogicalOffset = baseLogicalAddress
2424
member x.Get address =
@@ -29,7 +29,7 @@ type NonZeroIndexedArraySegment<'t>(baseLogicalAddress: int, segment: ArraySegme
2929
let address = checkAddress address
3030
segment.Array.[segment.Offset + address] <- value
3131

32-
member x.Array = segment.Array.[segment.Offset .. (segment.Count - 1)]
32+
member x.Array = segment.Array.[segment.Offset .. (segment.Offset + (segment.Count - 1))]
3333
member x.GetSlice address length =
3434
let address = checkAddressAndLength address length
3535
let slice = segment.Array.[segment.Offset + address .. (segment.Offset + address + length - 1)]
@@ -89,7 +89,7 @@ module Sysex =
8989
let [<Literal>] kit = 0x4D1
9090
let [<Literal>] patternShort = 0xacd
9191
let [<Literal>] patternLong = 0x1522
92-
92+
let [<Literal>] globalsSettings = 0xc5
9393
module Offsets =
9494
let [<Literal>] messageId = 0x6
9595
module Kit =
@@ -100,6 +100,8 @@ module Sysex =
100100
let [<Literal>] delay = 0x48f
101101
let [<Literal>] equalizer = 0x497
102102
let [<Literal>] compressor = 0x49f
103+
let [<Literal>] checksum = 0x4cc
104+
let [<Literal>] messageLength = 0x4ce
103105
module Pattern =
104106
let [<Literal>] pattern = 0x9
105107
(* let [<Literal>] trigPattern = 0xa
@@ -109,8 +111,39 @@ module Sysex =
109111
let [<Literal>] patternLength = 0xb2
110112
let [<Literal>] multiplier = 0xb3
111113
*)
114+
module Empty =
115+
let newKitBuffer () =
116+
NonZeroIndexedArraySegment<_>(Offsets.Kit.kit, new ArraySegment<_>(Array.zeroCreate Sizes.kit))
117+
module Versions =
118+
module Kit =
119+
let [<Literal>] version = 0x4uy
120+
let [<Literal>] revision = 0x1uy
121+
122+
let makeMachineDrumSysexMessageWithChecksum messageType (messageBluePart: data) : sysex_data =
123+
let version, revision =
124+
match messageType with
125+
| MachineDrumSysexMessageId.Kit -> Versions.Kit.version, Versions.Kit.revision
126+
127+
let sysexEnd = 0xf7uy
128+
let checksumBytes =
129+
checkSum messageBluePart
130+
|> word14To2bytes
112131

113-
132+
let messageLength =
133+
(messageBluePart.Length + 4)
134+
|> word14To2bytes
135+
136+
[|
137+
yield! mdHeader
138+
yield UMX.tag_sysex_data (byte messageType)
139+
yield! UMX.tag_sysex_data [|version;revision|]
140+
yield! UMX.to_sysex_data messageBluePart;
141+
yield! UMX.tag_sysex_data checksumBytes
142+
yield! UMX.tag_sysex_data messageLength
143+
yield UMX.tag_sysex_data sysexEnd
144+
|]
145+
146+
114147
let validateSysexShape (sysex: sysex_data) =
115148
if not (areMachineDrumCheckSumAndLengthValid sysex) then
116149
failwithf "invalid check sum"
@@ -124,6 +157,9 @@ module Sysex =
124157
match sysex.Length with
125158
| Sizes.patternShort | Sizes.patternLong -> ()
126159
| _ -> failwithf "pattern supposed to be %i or %i but got %i" Sizes.patternShort Sizes.patternLong sysex.Length
160+
| MachineDrumSysexMessageId.Global ->
161+
if sysex.Length <> Sizes.globalsSettings then
162+
failwithf "globalsettings supposed to be %i but got %i" Sizes.globalsSettings sysex.Length
127163
| otherwise ->
128164
failwithf "non checked message id %A" otherwise
129165

@@ -205,6 +241,8 @@ type MasterEffect =
205241
with
206242
static member asByte = function | Delay -> 0x5duy | Reverb -> 0x5euy | Equalizer -> 0x5fuy | Compressor -> 0x60uy
207243

244+
245+
208246
type MDMachine =
209247
| GND_EM = 00uy | GND_SN = 01uy | GND_NS = 02uy | GND_IM = 03uy
210248
| TRX_BD = 16uy | TRX_SD = 17uy | TRX_XT = 18uy | TRX_CP = 19uy | TRX_RS = 20uy | TRX_CB = 21uy | TRX_CH = 22uy | TRX_OH = 23uy
@@ -245,9 +283,69 @@ type MDUWMachine =
245283
| RAM_P3 = 39uy
246284
| RAM_P4 = 40uy
247285

286+
287+
type MDMachineKind =
288+
| GND
289+
| TRX
290+
| EFM
291+
| E12
292+
| PI
293+
| INP
294+
| MID
295+
| CTR
296+
| ROM
297+
| RAM
298+
248299
type MDMachineType =
249300
| MD of MDMachine
250301
| MDUW of MDUWMachine
302+
member x.Kind =
303+
match x with
304+
| MD m ->
305+
match m with
306+
|MDMachine.GND_EM|MDMachine.GND_IM|MDMachine.GND_NS|MDMachine.GND_SN -> GND
307+
|MDMachine.TRX_BD|MDMachine.TRX_SD|MDMachine.TRX_XT|MDMachine.TRX_CP
308+
|MDMachine.TRX_RS|MDMachine.TRX_CB|MDMachine.TRX_CH|MDMachine.TRX_OH
309+
|MDMachine.TRX_CY|MDMachine.TRX_MA|MDMachine.TRX_CL|MDMachine.TRX_XC|MDMachine.TRX_B2 -> TRX
310+
|MDMachine.EFM_BD|MDMachine.EFM_SD|MDMachine.EFM_XT|MDMachine.EFM_CP
311+
|MDMachine.EFM_RS|MDMachine.EFM_CB|MDMachine.EFM_HH|MDMachine.EFM_CY -> EFM
312+
|MDMachine.E12_BD|MDMachine.E12_SD|MDMachine.E12_HT |MDMachine.E12_LT|MDMachine.E12_CP|MDMachine.E12_RS|MDMachine.E12_CB|MDMachine.E12_CH
313+
|MDMachine.E12_OH|MDMachine.E12_RC|MDMachine.E12_CC |MDMachine.E12_BR|MDMachine.E12_TA|MDMachine.E12_TR|MDMachine.E12_SH|MDMachine.E12_BC -> E12
314+
|MDMachine.P_I_BD|MDMachine.P_I_SD|MDMachine.P_I_MT|MDMachine.P_I_ML|MDMachine.P_I_MA|MDMachine.P_I_RS|MDMachine.P_I_RC|MDMachine.P_I_CC
315+
|MDMachine.P_I_HH -> PI
316+
|MDMachine.INP_GA|MDMachine.INP_GB|MDMachine.INP_FA|MDMachine.INP_FB|MDMachine.INP_EA|MDMachine.INP_EB -> INP
317+
|MDMachine.MID_01|MDMachine.MID_02|MDMachine.MID_03|MDMachine.MID_04|MDMachine.MID_05|MDMachine.MID_06|MDMachine.MID_07|MDMachine.MID_08
318+
|MDMachine.MID_09|MDMachine.MID_10|MDMachine.MID_11|MDMachine.MID_12|MDMachine.MID_13|MDMachine.MID_14|MDMachine.MID_15|MDMachine.MID_16 -> MID
319+
|MDMachine.CTR_AL|MDMachine.CTR_8P|MDMachine.CTR_RE|MDMachine.CTR_GB|MDMachine.CTR_EQ|MDMachine.CTR_DX -> CTR
320+
| _ -> failwithf "kind %A" m
321+
| MDUW m ->
322+
match m with
323+
|MDUWMachine.ROM_01|MDUWMachine.ROM_17|MDUWMachine.ROM_33
324+
|MDUWMachine.ROM_02|MDUWMachine.ROM_18|MDUWMachine.ROM_34
325+
|MDUWMachine.ROM_03|MDUWMachine.ROM_19|MDUWMachine.ROM_35
326+
|MDUWMachine.ROM_04|MDUWMachine.ROM_20|MDUWMachine.ROM_36
327+
|MDUWMachine.ROM_05|MDUWMachine.ROM_21|MDUWMachine.ROM_37
328+
|MDUWMachine.ROM_06|MDUWMachine.ROM_22|MDUWMachine.ROM_38
329+
|MDUWMachine.ROM_07|MDUWMachine.ROM_23|MDUWMachine.ROM_39
330+
|MDUWMachine.ROM_08|MDUWMachine.ROM_24|MDUWMachine.ROM_40
331+
|MDUWMachine.ROM_09|MDUWMachine.ROM_25|MDUWMachine.ROM_41
332+
|MDUWMachine.ROM_10|MDUWMachine.ROM_26|MDUWMachine.ROM_42
333+
|MDUWMachine.ROM_11|MDUWMachine.ROM_27|MDUWMachine.ROM_43
334+
|MDUWMachine.ROM_12|MDUWMachine.ROM_28|MDUWMachine.ROM_44
335+
|MDUWMachine.ROM_13|MDUWMachine.ROM_29|MDUWMachine.ROM_45
336+
|MDUWMachine.ROM_14|MDUWMachine.ROM_30|MDUWMachine.ROM_46
337+
|MDUWMachine.ROM_15|MDUWMachine.ROM_31|MDUWMachine.ROM_47
338+
|MDUWMachine.ROM_16|MDUWMachine.ROM_32|MDUWMachine.ROM_48 -> ROM
339+
|MDUWMachine.RAM_R1
340+
|MDUWMachine.RAM_R2
341+
|MDUWMachine.RAM_P1
342+
|MDUWMachine.RAM_P2
343+
|MDUWMachine.RAM_R3
344+
|MDUWMachine.RAM_R4
345+
|MDUWMachine.RAM_P3
346+
|MDUWMachine.RAM_P4 -> RAM
347+
| _ -> failwithf "kind uw %A" m
348+
251349
member x.HasPitch =
252350
match x with
253351
| MDUW (MDUWMachine.RAM_R1|MDUWMachine.RAM_R2|MDUWMachine.RAM_R3|MDUWMachine.RAM_R4) -> false
@@ -292,8 +390,11 @@ with
292390
FilterBaseFrequency ; FilterWidth ; FilterQ ; SampleRateReduction
293391
Distortion ; Volume ; Pan ; DelaySend
294392
ReverbSend ; LFOSpeed ; LFOAmount ; LFOShapeMix
295-
296393
|]
394+
static member synthesisParameters = MDTrackParameter.all.[0..7]
395+
static member effectsParameters = MDTrackParameter.all.[8..15]
396+
static member routingParameters = MDTrackParameter.all.[16..23]
397+
297398
static member fromCCOffset offset =
298399
match UMX.untag_byte_7bits offset with
299400
| 00uy -> MachineParameter1 | 01uy -> MachineParameter2 | 02uy -> MachineParameter3 | 03uy -> MachineParameter4
@@ -700,7 +801,6 @@ type MDKit private (bytes: NonZeroIndexedArraySegment<byte_7bits>) =
700801
let dataSlice = bytes.GetSlice address length
701802
dataSlice
702803
|> dataToByte
703-
704804
member x.Position = bytes.Get Sysex.Offsets.Kit.kit
705805
member x.Name
706806
with get () = bytes.GetSlice 0x0a 16 |> unbox |> ASCIIEncoding.Default.GetString
@@ -779,9 +879,11 @@ type MDKit private (bytes: NonZeroIndexedArraySegment<byte_7bits>) =
779879
let segment = NonZeroIndexedArraySegment(Sysex.Offsets.Kit.kit, segment)
780880
MDKit segment
781881

882+
static member toSysex (mdKit: MDKit) =
883+
Sysex.makeMachineDrumSysexMessageWithChecksum MachineDrumSysexMessageId.Kit mdKit.ContentAsBytes
884+
782885
static member drumModelsAreAllEmpty (kit: MDKit) = kit.SelectedDrumModel = Array.create 16 (MDMachineType.MD MDMachine.GND_EM)
783-
784-
886+
static member empty = Sysex.Empty.newKitBuffer () |> MDKit
785887
type MDTempoMultiplier =
786888
| One
787889
| Two
@@ -970,7 +1072,8 @@ type GlobalSettings = {
9701072
with
9711073
static member ToSysex globals =
9721074
[||]
973-
static member FromSysex (bytes: sysex_data) =
1075+
static member fromSysex (bytes: sysex_data) =
1076+
Sysex.validateSysexShape bytes
9741077
let originalPosition = bytes.[0x09]
9751078
let drumRoutingTable = bytes |> SysexBufferEdit.getDataSlice 0x0a 16 |> Array.map Output.FromByte
9761079
let keymapStructure =
@@ -1021,7 +1124,7 @@ with
10211124
| StatusResponse _ -> 0x72uy
10221125
static member BuildResponse (sysex: sysex_data) =
10231126
match UMX.untag_sysex sysex.[6] with
1024-
| 0x50uy -> Some (GlobalSettingsResponse (GlobalSettings.FromSysex sysex) )
1127+
| 0x50uy -> Some (GlobalSettingsResponse (GlobalSettings.fromSysex sysex) )
10251128
| 0x52uy -> Some (KitResponse (MDKit.fromSysex sysex) )
10261129
| 0x67uy -> Some (PatternResponse (MDPattern.fromSysex sysex) )
10271130
| 0x69uy -> Some (SongResponse (MDSong sysex) )
@@ -1198,7 +1301,6 @@ type MachineDrum<'timestamp>(inPort: IMidiInput<'timestamp>, outPort: IMidiOutpu
11981301

11991302
member x.EventToMidiMessages (mdEvent: MachineDrumEvent) globals =
12001303
let channel = globals.MidiBaseChannel
1201-
//globals.KeymapStructure.GetTriggerNotesForBank
12021304
let track = mdEvent.Track
12031305
let note =
12041306
match track with

‎tests/Midinette.Elektron.Tests/Midinette.Elektron.Tests.fsproj‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@
1313
</Content>
1414
</ItemGroup>
1515
<ItemGroup>
16+
<ProjectReference Include="..\..\..\ElektronControl\ToolLib\ToolLib.fsproj" />
1617
<ProjectReference Include="..\..\src\Midinette.Elektron\Midinette.Elektron.fsproj" />
1718
<ProjectReference Include="..\..\src\Midinette\Midinette.fsproj" />
1819
</ItemGroup>

‎tests/Midinette.Elektron.Tests/Program.fs‎

Lines changed: 14 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ open Hopac
55
open Logary
66
open Logary.Configuration
77
open Logary.Adapters.Facade
8-
8+
open PrettyPrint
99
open Elektron.MachineDrum
1010
open System.IO
1111
open System.Text
@@ -66,13 +66,24 @@ let tests =
6666
printfn "parsed kit %i %s" kit.Position kit.Name
6767
printfn "\t - drum models: %A" kit.SelectedDrumModel
6868
printfn "\t - compressor: %A" kit.CompressorSettings
69-
69+
let actual = MDKit.toSysex kit
70+
let arrays = Seq.zip actual k |> Seq.indexed
71+
72+
for i , (a,b) in arrays do
73+
if a <> b then
74+
printBytes (actual.[i ..] )
75+
printBytes k.[i..]
76+
Expect.equal a b (sprintf "roundtrip of kit ends up being different at %i %i <> %i" i a b)
77+
Expect.equal actual.Length k.Length "kit sysex has unexpected length"
7078
for p in indexedMessages.[MachineDrumSysexMessageId.Pattern] do
7179
let pattern = MDPattern.fromSysex p
7280
printfn "parsed pattern %i (%i steps)" pattern.OriginalPosition pattern.NumberOfSteps
7381
printTrigPattern pattern
82+
for p in indexedMessages.[MachineDrumSysexMessageId.Global] do
83+
let globalSettings = GlobalSettings.fromSysex p
84+
printfn "parsed global settings %i" globalSettings.OriginalPosition
85+
printfn "\t - keymap: %A" globalSettings.KeymapStructure
7486

75-
()
7687
}
7788
]
7889
[<EntryPoint>]

0 commit comments

Comments
 (0)