Skip to content

Commit db129fe

Browse files
smoothdevelopersmoothdeveloper
committed
midinette
1 parent 83498d5 commit db129fe

File tree

3 files changed

+160
-58
lines changed

3 files changed

+160
-58
lines changed

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

Lines changed: 155 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,8 @@ module MachineSpecs =
3131
let patterns = [|0uy..127uy|]
3232
let kits = [|0uy..63uy|]
3333
let songs = [|0uy..31uy|]
34+
35+
3436

3537
[<RequireQualifiedAccess>]
3638
type Track =
@@ -681,7 +683,7 @@ with
681683

682684
type TriggerType =
683685
| TriggerChannel of Track
684-
| TriggerPattern of PatternBank * patternNumber: byte
686+
| TriggerPattern of PatternLocator
685687
| UnknownTrigger of value: byte
686688

687689
type NoteTriggerType = NoteTriggerType of note: byte * TriggerType
@@ -708,14 +710,9 @@ type KeyMapStructure(bytes: byte array) =
708710
| v -> failwithf "bank %i" v
709711
let getTriggerType (value: byte) =
710712
if value < 0x10uy then TriggerChannel (Track.trackForValue value)
711-
elif value < 0x8fuy then TriggerPattern (bankForValue value, value &&& 0xfuy)
713+
elif value < 0x8fuy then TriggerPattern (PatternLocator.PatternLocator(bankForValue value, value &&& 0xfuy))
712714
else UnknownTrigger (value)
713-
(*
714-
let getTrigger (note: byte) (value: byte)=
715-
if value < 0x10uy then TriggerChannel (note, Track.trackForValue value)
716-
elif value < 0x8fuy then TriggerPattern (note, bankForValue value, value &&& 0xfuy)
717-
else Unknown (note, value)
718-
*)
715+
719716
let triggers =
720717
bytes
721718
|> Array.indexed
@@ -790,6 +787,8 @@ type GlobalSettings = {
790787
// Trig mode for keymap
791788
}
792789
with
790+
static member ToSysex globals =
791+
[||]
793792
static member FromSysex (bytes: byte array) =
794793
let originalPosition = bytes.[0x09]
795794
let drumRoutingTable = bytes |> getSlice 0x0a 16 |> Array.map Output.FromByte
@@ -831,6 +830,7 @@ type MachineDrumSysexResponses =
831830
| PatternResponse of MDPattern
832831
| SongResponse of MDSong
833832
| StatusResponse of MachineDrumStatusType * byte
833+
//| UnknownSysexResponse of byte array
834834
with
835835
member x.MessageId =
836836
match x with
@@ -839,14 +839,18 @@ with
839839
| PatternResponse _ -> 0x67uy
840840
| SongResponse _ -> 0x69uy
841841
| StatusResponse _ -> 0x72uy
842-
static member BuildResponse (bytes: byte array) =
843-
match bytes.[6] with
844-
| 0x50uy -> GlobalSettingsResponse (GlobalSettings.FromSysex bytes)
845-
| 0x52uy -> KitResponse (MDKit bytes)
846-
| 0x67uy -> PatternResponse (MDPattern bytes)
847-
| 0x69uy -> SongResponse (MDSong bytes)
848-
| 0x72uy -> StatusResponse (MachineDrumStatusType.FromByte bytes.[7], bytes.[8])
849-
| _ -> failwithf "h:%x response not understood" bytes.[6]
842+
static member BuildResponse (sysex: byte array) =
843+
match sysex.[6] with
844+
| 0x50uy -> Some (GlobalSettingsResponse (GlobalSettings.FromSysex sysex) )
845+
| 0x52uy -> Some (KitResponse (MDKit sysex) )
846+
| 0x67uy -> Some (PatternResponse (MDPattern sysex) )
847+
| 0x69uy -> Some (SongResponse (MDSong sysex) )
848+
| 0x72uy -> Some (StatusResponse (MachineDrumStatusType.FromByte sysex.[7], sysex.[8]))
849+
| _ ->
850+
// failwithf "h:%x response not understood" sysex.[6]
851+
None
852+
//Some (UnknownSysexResponse sysex)
853+
850854

851855
type AssignMachineMode =
852856
| InitSynthesis
@@ -920,6 +924,40 @@ with
920924
| SetReverbParameter(parameter, value) -> [|ReverbParameter.ToByte parameter;value|]
921925
Elektron.Platform.SysexHelper.makeMachineDrumSysexMessage (Array.concat ([|x.MessageId |> Array.singleton; data|]))
922926

927+
type LFOEvent =
928+
| AssignTrack of Track
929+
| AssignDestination of MDTrackParameter
930+
| AssignShape1 of LFOShape
931+
| AssignShape2 of LFOShape
932+
| AssignType of LFOType
933+
934+
type MachineDrumEvent =
935+
| TrackLevel of Track * value: byte
936+
| TrackParameter of Track * MDTrackParameter * value: byte
937+
| TrackTrigger of Track * velocity: byte
938+
| TrackRelease of Track
939+
| PatternChanged of byte
940+
| LFOSetting of Track * LFOEvent
941+
| DelaySetting of DelayParameter * value: byte
942+
| ReverbSetting of ReverbParameter * value: byte
943+
| EqualizerSetting of EqualizerParameter * value: byte
944+
| CompressorSetting of CompressorParameter * value: byte
945+
| Unknown of MidiMessage
946+
| MachineDrumSysex of MachineDrumSysexResponses
947+
| Sysex of byte array
948+
| KitChanged of byte
949+
with
950+
member x.Track =
951+
match x with
952+
| TrackLevel (track, _)
953+
| TrackParameter(track,_,_)
954+
| TrackTrigger(track, _)
955+
| TrackRelease track
956+
| LFOSetting(track, _)
957+
-> Some track
958+
| _ -> None
959+
960+
923961
module Sysex =
924962
let mdHeader = [|
925963
0xf0uy
@@ -930,12 +968,17 @@ module Sysex =
930968
0x00uy
931969
|]
932970

971+
[<RequireQualifiedAccess>]
972+
type MidiOutputData =
973+
| Message of MidiMessage
974+
| Sysex of bytes: byte array
975+
933976
type MachineDrum(inPort: IMidiInput<int>, outPort: IMidiOutput<int>, getSysexNowTimestamp: unit -> int) =
934977
let helpGetMDSysex maxMessage (timeout: TimeSpan) (request: MachineDrumSysexRequests) inPort : Async<MachineDrumSysexResponses option> =
935978
#if FABLE_COMPILER
936979
failwithf "TODO FABLE"
937980
#else
938-
Midi.Sysex.helpGetSysex maxMessage timeout (fun sysex -> sysex.[0..5] = Sysex.mdHeader && sysex.[6] = request.ResponseMessageId) request.BuildResponse inPort
981+
Midi.Sysex.helpGetSysex maxMessage timeout (fun sysex -> sysex.[0..5] = Sysex.mdHeader && sysex.[6] = request.ResponseMessageId) (request.BuildResponse >> Option.get) inPort
939982
#endif
940983

941984
let performSysExRequest (requestMessage: MachineDrumSysexRequests) =
@@ -952,13 +995,65 @@ type MachineDrum(inPort: IMidiInput<int>, outPort: IMidiOutput<int>, getSysexNow
952995
#endif
953996
else
954997
None
998+
999+
9551000
member x.MidiOutPort = inPort
956-
member x.MidiInPort = outPort
957-
member x.QueryStatus statusType =
958-
performSysExRequest (QueryStatus statusType)
1001+
member x.MidiInPort = outPort
1002+
1003+
member x.EventToMidiMessages (mdEvent: MachineDrumEvent) globals =
1004+
let channel = globals.MidiBaseChannel
1005+
//globals.KeymapStructure.GetTriggerNotesForBank
1006+
let track = mdEvent.Track
1007+
let note =
1008+
match track with
1009+
| Some track -> globals.KeymapStructure.GetTriggerNoteForChannel track
1010+
| None -> None
1011+
1012+
let makeNote note velocity isOn =
1013+
match note with
1014+
| None -> None
1015+
| Some note ->
1016+
if isOn then
1017+
Some (MidiOutputData.Message (MidiMessage.NoteOn channel note velocity))
1018+
else
1019+
Some (MidiOutputData.Message (MidiMessage.NoteOff channel note velocity))
1020+
1021+
let makeProgramChange program =
1022+
MidiMessage.ProgramChange channel program
1023+
|> MidiOutputData.Message
1024+
1025+
let none = Array.empty
1026+
let some = Array.singleton
1027+
match mdEvent with
1028+
| TrackTrigger(track, velocity) -> makeNote note velocity true |> Option.get |> some
1029+
| TrackRelease(track) -> makeNote note 0uy false |> Option.get |> some
1030+
| TrackLevel(track, level) -> none
1031+
| TrackParameter(track, parameter, value) -> none
1032+
| PatternChanged pattern -> none
1033+
| Unknown message -> message |> MidiOutputData.Message |> some
1034+
| Sysex data -> data |> MidiOutputData.Sysex |> some
1035+
| MachineDrumSysex sysex -> none
1036+
| KitChanged kit -> makeProgramChange kit |> some
1037+
| _ -> none
1038+
9591039

960-
member x.Dump dumpRequest =
961-
performSysExRequest dumpRequest
1040+
1041+
member x.SendEvents mdGlobals mdEvents getNow =
1042+
match mdGlobals with
1043+
| Some globals ->
1044+
let now = getNow ()
1045+
for timestamp, mdEvent in mdEvents do
1046+
x.EventToMidiMessages mdEvent globals
1047+
|> Array.iter (
1048+
function
1049+
| MidiOutputData.Message message -> outPort.WriteMessage (timestamp + now) message
1050+
| MidiOutputData.Sysex sysex -> outPort.WriteSysex now sysex
1051+
)
1052+
| None -> ()
1053+
1054+
member x.QueryStatus statusType = performSysExRequest (QueryStatus statusType)
1055+
1056+
member x.Dump dumpRequest = performSysExRequest dumpRequest
9621057
member x.CurrentGlobalSettingsSlot =
9631058
match x.Dump (QueryStatus(MachineDrumStatusType.GlobalSlot)) with
9641059
| Some (MachineDrumSysexResponses.StatusResponse(GlobalSlot, slot)) -> Some slot
@@ -989,7 +1084,11 @@ type MachineDrum(inPort: IMidiInput<int>, outPort: IMidiOutput<int>, getSysexNow
9891084
(AssignMachine (track, machine, mode)).Sysex
9901085
|> outPort.WriteSysex (getSysexNowTimestamp())
9911086

992-
(*
1087+
member x.ChangeTrackParameter globals track parameter value =
1088+
let cc = MDTrackParameter.GetCCForTrack parameter track
1089+
MidiMessage.CC (globals.MidiBaseChannel) cc value
1090+
|> outPort.WriteMessage (getSysexNowTimestamp())
1091+
(*
9931092
member x.DumpKit kit =
9941093
performSysExRequest (DumpKit kit)
9951094
@@ -1005,35 +1104,18 @@ module MachineDrumEventParser =
10051104
message.MessageType = MidiMessageType.ControllerChange
10061105
&& isMachineDrumChannel midiBaseChannel message.Channel.Value
10071106
&& (message.Data1 >= 16uy && message.Data1 <= 119uy)
1008-
1009-
type LFOEvent =
1010-
| AssignTrack of Track
1011-
| AssignDestination of MDTrackParameter
1012-
| AssignShape1 of LFOShape
1013-
| AssignShape2 of LFOShape
1014-
| AssignType of LFOType
1015-
1016-
type MachineDrumEvent =
1017-
| TrackLevel of Track * value: byte
1018-
| TrackParameter of Track * MDTrackParameter * value: byte
1019-
| TrackTrigger of Track * velocity: byte
1020-
| TrackRelease of Track
1021-
| PatternChanged of byte
1022-
| LFOSetting of Track * LFOEvent
1023-
| DelaySetting of DelayParameter * value: byte
1024-
| ReverbSetting of ReverbParameter * value: byte
1025-
| EqualizerSetting of EqualizerParameter * value: byte
1026-
| CompressorSetting of CompressorParameter * value: byte
1027-
| Unknown of MidiMessage
1028-
| MachineDrumSysex of MachineDrumSysexResponses
1029-
| Sysex of byte array
1107+
let trackOffset cc =
1108+
if cc <= 39uy then 0uy
1109+
elif cc <= 63uy then 1uy
1110+
elif cc <= 95uy then 2uy
1111+
else 3uy
10301112

10311113
type TimestampedMessage<'t> = {
10321114
Timestamp : int
10331115
Message: 't
10341116
}
10351117

1036-
type MachineDrumEventListener(md: MachineDrum, getTimestamp : unit -> int) =
1118+
type MachineDrumEventListener(md: MachineDrum, getNow : unit -> int) =
10371119
let mutable mdGlobalSettings = md.CurrentGlobalSettings
10381120
let midiIn = md.MidiOutPort
10391121
//let mutable lastKit = {Timestamp = 0; Message = None }
@@ -1050,11 +1132,8 @@ type MachineDrumEventListener(md: MachineDrum, getTimestamp : unit -> int) =
10501132
elif MachineDrumEventParser.isMachineDrumControlChange midiBaseChannel message then
10511133
let channel = message.Channel.Value
10521134
let cc = message.Data1
1053-
let trackOffset =
1054-
if cc <= 39uy then 0uy
1055-
elif cc <= 63uy then 1uy
1056-
elif cc <= 95uy then 2uy
1057-
else 3uy
1135+
let trackOffset = MachineDrumEventParser.trackOffset cc
1136+
10581137
let midiChannelOffset = channel - midiBaseChannel
10591138
let track = Track.trackForValue ((midiChannelOffset * 4uy) + trackOffset)
10601139
let parameter = MDTrackParameter.GetParameterForCC cc
@@ -1124,7 +1203,7 @@ type MachineDrumEventListener(md: MachineDrum, getTimestamp : unit -> int) =
11241203
| _ -> Sysex sysex
11251204
| _ ->
11261205
if sysex.[0..5] = Sysex.mdHeader then
1127-
MachineDrumSysex (MachineDrumSysexResponses.BuildResponse sysex)
1206+
MachineDrumSysex (MachineDrumSysexResponses.BuildResponse sysex).Value
11281207
else
11291208
Sysex sysex
11301209

@@ -1134,7 +1213,7 @@ type MachineDrumEventListener(md: MachineDrum, getTimestamp : unit -> int) =
11341213
)
11351214
let sysexListener = midiIn.SysexReceived.Subscribe(fun m ->
11361215
// TODO TODO
1137-
let timestamp = getTimestamp()
1216+
let timestamp = getNow()
11381217
let message = onSysexMessage m
11391218
{ Timestamp = timestamp; Message = message } |> event.Trigger
11401219
)
@@ -1145,6 +1224,29 @@ type MachineDrumEventListener(md: MachineDrum, getTimestamp : unit -> int) =
11451224

11461225
[<CLIEvent>] member x.Event = event.Publish
11471226

1227+
let mdDetection getTimestamp inputs outputs onSysex withMachineDrum =
1228+
let queryMessage = QueryStatus(GlobalSlot)
1229+
let onSysex =
1230+
match onSysex with
1231+
| Some onSysex -> onSysex
1232+
| _ ->
1233+
(fun sysex ->
1234+
match MachineDrumSysexResponses.BuildResponse sysex with
1235+
| Some(MachineDrumSysexResponses.GlobalSettingsResponse globals) -> true
1236+
| _ -> false
1237+
)
1238+
1239+
Sysex.deviceInquiry inputs outputs
1240+
onSysex
1241+
(fun midiOut ->
1242+
midiOut.WriteSysex 0 (QueryStatus(GlobalSlot).Sysex)
1243+
)
1244+
(fun midiIn midiOut ->
1245+
let md = MachineDrum(midiIn, midiOut, getTimestamp)
1246+
withMachineDrum md
1247+
{ new System.IDisposable with member x.Dispose () = () }
1248+
)
1249+
11481250

11491251

11501252
let effectsParameters =

‎src/Midinette.Elektron/Midinette.Elektron.fsproj

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,17 +1,16 @@
1-
<?xml version="1.0" encoding="utf-8"?>
2-
<Project Sdk="Microsoft.NET.Sdk">
1+
<Project Sdk="Microsoft.NET.Sdk">
32
<PropertyGroup>
43
<TargetFrameworks>netstandard2.0;net45</TargetFrameworks>
54
<OutputPath>..\..\build\$(Configuration)\$(Platform)</OutputPath>
65
</PropertyGroup>
6+
<ItemGroup>
7+
<ProjectReference Include="..\Midinette\Midinette.fsproj" />
8+
</ItemGroup>
79
<ItemGroup>
810
<Compile Include="Elektron.fs" />
911
<Compile Include="Elektron.Platform.fs" />
1012
<Compile Include="Elektron.MachineDrum.fs" />
1113
<Compile Include="Elektron.MonoMachine.fs" />
1214
</ItemGroup>
13-
<ItemGroup>
14-
<ProjectReference Include="..\Midinette\Midinette.fsproj" />
15-
</ItemGroup>
1615
<Import Project="..\..\.paket\Paket.Restore.targets" />
1716
</Project>

‎src/Midinette/Midi.fs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -63,6 +63,7 @@ type [<Struct>] MidiMessage private(value:int) =
6363
MidiMessage.Encode (MidiMessage.StatusWithChannel messageType channel) data1 data2
6464
static member NoteOn channel note velocity = MidiMessage.EncodeChannelMessage MidiMessageType.NoteOn channel note velocity
6565
static member NoteOff channel note velocity = MidiMessage.EncodeChannelMessage MidiMessageType.NoteOff channel note velocity
66+
static member ProgramChange channel program = MidiMessage.EncodeChannelMessage MidiMessageType.ProgramChange channel program 0uy
6667
static member CC channel control value = MidiMessage.EncodeChannelMessage MidiMessageType.ControllerChange channel control value
6768
static member FromWord word = MidiMessage word
6869
member x.Word = value

0 commit comments

Comments
 (0)