FEAT: initial MIDI port scheme implementation (Windows only so far)

Oldes · Oldes · commit 3591edf11358 · 2019-02-06T13:58:10.000+01:00
Here is example how to list available input/output MIDI devices:
```
&gt;&gt; query midi://
== make object! [
    devices-in: ["Launch Control XL"]
    devices-out: ["Microsoft GS Wavetable Synth" "Launch Control XL"]
]

```
This will open MIDI port in write only mode and play a chord (Middle-C, E and G):
```
synth: open/write midi://1
write synth #{903C7F00 90407F00 90437F00}
```

The scheme is low-level so supports only binary for read/write. There can be made higher level scheme which could support a dialect for preparing the data.

This is example how to get MIDI input using port's `awake`:
```
launch: open/read midi://device:1
launch/awake: function [event [event!]][
	switch event/type [
		read  [ probe read event/port     ]
		open  [ print "MIDI port opened!" ]
		close [ print "MIDI port closed!" ]
	]
	true
]
```
If the `awake` is defined like above and you are in some sort of `wait` loop, than whenever MIDI input is received, you would see the data from it printed in console.

TODO:
    * support SYSEX messages
    * at least macOS support
diff --git a/src/boot/sysobj.r b/src/boot/sysobj.r
@@ -252,7 +252,13 @@ standard: context [
 		scheme: 'checksum
 		method: none
 	]
-	
+
+	port-spec-midi: make port-spec-head [
+		scheme:    'midi
+		device-in:  
+		device-out: none
+	]
+
 	file-info: context [
 		name:
 		size:
@@ -284,6 +290,12 @@ standard: context [
 			none
 	]
 
+	midi-info: context [
+		devices-in:
+		devices-out:
+			none
+	]
+
 	extension: context [
 		lib-base:	; handle to DLL
 		lib-file:	; file name loaded
diff --git a/src/boot/words.r b/src/boot/words.r
@@ -220,3 +220,6 @@ buffer-cols
 buffer-rows
 window-cols
 window-rows
+
+devices-in
+devices-out
diff --git a/src/core/p-midi.c b/src/core/p-midi.c
@@ -0,0 +1,214 @@
+/***********************************************************************
+**
+**  REBOL [R3] Language Interpreter and Run-time Environment
+**
+**  Copyright 2012 REBOL Technologies
+**  Copyright 2012-2019 Rebol Open Source Developers
+**  REBOL is a trademark of REBOL Technologies
+**
+**  Licensed under the Apache License, Version 2.0 (the "License");
+**  you may not use this file except in compliance with the License.
+**  You may obtain a copy of the License at
+**
+**  http://www.apache.org/licenses/LICENSE-2.0
+**
+**  Unless required by applicable law or agreed to in writing, software
+**  distributed under the License is distributed on an "AS IS" BASIS,
+**  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+**  See the License for the specific language governing permissions and
+**  limitations under the License.
+**
+************************************************************************
+**
+**  Module:  p-midi.c
+**  Summary: MIDI port interface
+**  Section: ports
+**  Author:  Oldes
+**  Notes:
+**
+***********************************************************************/
+
+#include "sys-core.h"
+
+/***********************************************************************
+**
+*/	static REBOOL Query_MIDI_Field(REBSER *obj, REBCNT field, REBVAL *ret)
+/*
+**		Set a value with MIDI related data according specified field
+**		The `obj` must be system/standard/midi-info with filled info
+**
+***********************************************************************/
+{
+	switch (field) {
+	case SYM_DEVICES_IN:
+		*ret = *Get_Field(obj, STD_MIDI_INFO_DEVICES_IN);
+		return TRUE;
+	case SYM_DEVICES_OUT:
+		*ret = *Get_Field(obj, STD_MIDI_INFO_DEVICES_OUT);
+		return TRUE;
+	default:
+		return FALSE;
+	}
+}
+
+/***********************************************************************
+**
+*/	static int MIDI_Actor(REBVAL *ds, REBSER *port, REBCNT action)
+/*
+***********************************************************************/
+{
+	REBREQ *req;
+	REBINT result;
+	REBVAL *arg;
+	REBCNT args = 0;
+	REBINT len, n;
+	REBSER *ser;
+	REBVAL *spec;
+	REBVAL *val1, *val2;
+
+	//printf("MIDI_Actor action: %i\n", action);
+
+	Validate_Port(port, action);
+
+	req = Use_Port_State(port, RDI_MIDI, sizeof(REBREQ));
+
+	switch (action) {
+
+	case A_READ:
+		// This device is opened on the READ:
+		if (!IS_OPEN(req)) Trap_Port(RE_NOT_OPEN, port, -12);
+
+		result = OS_DO_DEVICE(req, RDC_READ);
+		if (result < 0) Trap_Port(RE_READ_ERROR, port, req->error);
+
+		// Copy and set the string result:
+		arg = OFV(port, STD_PORT_DATA);
+		//arg = D_ARG(1);
+		SET_BINARY(arg, Copy_Bytes(req->data, req->actual));
+		req->data = 0;
+		*D_RET = *arg;
+		return R_RET;
+
+	case A_WRITE:
+		if (!IS_OPEN(req)) Trap_Port(RE_NOT_OPEN, port, -12);
+		arg = D_ARG(2);
+		if(IS_BINARY(arg)) {
+			req->data = VAL_BIN(arg);
+			req->length = VAL_LEN(arg);
+
+			result = OS_DO_DEVICE(req, RDC_WRITE);
+			if (result < 0) Trap_Port(RE_WRITE_ERROR, port, req->error);
+		}
+		break;
+
+	case A_OPEN:
+		spec = OFV(port, STD_PORT_SPEC);
+		args = Find_Refines(ds, AM_OPEN_READ | AM_OPEN_WRITE);
+		req->modes = args; 
+		if (IS_OBJECT(spec)) {
+			val1 = Obj_Value(spec, STD_PORT_SPEC_MIDI_DEVICE_IN);
+			if (IS_INTEGER(val1)) {
+				req->midi.device_in = VAL_INT32(val1);
+				//printf(";;;;;;;; requested device-in: %i\n", req->midi.device_in);
+			}
+			val2 = Obj_Value(spec, STD_PORT_SPEC_MIDI_DEVICE_OUT);
+			if (IS_INTEGER(val2)) {
+				req->midi.device_out = VAL_INT32(val2);
+				//printf(";;;;;;;; requested device-out: %i\n", req->midi.device_out);
+			} else if ((args & AM_OPEN_WRITE) && !(args & AM_OPEN_READ)) {
+				// it was opened using: open/WRITE midi://device:NUM
+				req->midi.device_out = req->midi.device_in;
+				req->midi.device_in = 0;
+				SET_NONE(val1);
+				SET_INTEGER(val2, req->midi.device_out);
+			}
+		}
+		if (OS_DO_DEVICE(req, RDC_OPEN)) Trap_Port(RE_CANNOT_OPEN, port, req->error);
+
+		break;
+
+	case A_CLOSE:
+		if (!IS_OPEN(req)) Trap_Port(RE_NOT_OPEN, port, -12);
+		OS_DO_DEVICE(req, RDC_CLOSE);
+		break;
+
+	case A_QUERY:
+		spec = Get_System(SYS_STANDARD, STD_MIDI_INFO);
+		if (!IS_OBJECT(spec)) Trap_Arg(spec);
+		if (D_REF(2) && IS_NONE(D_ARG(3))) {
+			// query/mode midi:// none ;<-- lists possible fields to request
+			Set_Block(D_RET, Get_Object_Words(spec));
+			return R_RET;
+		}
+
+		REBSER *obj = CLONE_OBJECT(VAL_OBJ_FRAME(spec));
+		Set_Block(Get_Field(obj, STD_MIDI_INFO_DEVICES_IN), Make_Block(7));
+		Set_Block(Get_Field(obj, STD_MIDI_INFO_DEVICES_OUT), Make_Block(7));
+		req->data = (REBYTE*)obj;
+		OS_DO_DEVICE(req, RDC_QUERY);
+
+		if (D_REF(2)) {
+			// query/mode used
+			REBVAL *field = D_ARG(3);
+			if (IS_WORD(field)) {
+				if (!Query_MIDI_Field(obj, VAL_WORD_SYM(field), D_RET))
+					Trap_Reflect(VAL_TYPE(D_ARG(1)), field); // better error?
+			}
+			else if (IS_BLOCK(field)) {
+				REBVAL *val;
+				REBSER *values = Make_Block(2 * BLK_LEN(VAL_SERIES(field)));
+				REBVAL *word = VAL_BLK_DATA(field);
+				for (; NOT_END(word); word++) {
+					if (ANY_WORD(word)) {
+						if (IS_SET_WORD(word)) {
+							// keep the set-word in result
+							val = Append_Value(values);
+							*val = *word;
+							VAL_SET_LINE(val);
+						}
+						val = Append_Value(values);
+						if (!Query_MIDI_Field(obj, VAL_WORD_SYM(word), val))
+							Trap1(RE_INVALID_ARG, word);
+					}
+					else  Trap1(RE_INVALID_ARG, word);
+				}
+				Set_Series(REB_BLOCK, D_RET, values);
+			}
+			return R_RET;
+		}
+		Set_Object(D_RET, obj);
+		return R_RET;
+
+	case A_OPENQ:
+		if (IS_OPEN(req)) return R_TRUE;
+		return R_FALSE;
+
+	case A_UPDATE:
+		// Update the port object after a READ or WRITE operation.
+		// This is normally called by the WAKE-UP function.
+		arg = OFV(port, STD_PORT_DATA);
+		//printf("MIDI Update action, req->command = %d\n", req->command);
+		if (req->command == RDC_READ) {
+			if (ANY_BINSTR(arg)) VAL_TAIL(arg) += req->actual;
+		}
+		else if (req->command == RDC_WRITE) {
+			SET_NONE(arg);  // Write is done.
+		}
+		return R_NONE;
+
+	default:
+		Trap_Action(REB_PORT, action);
+	}
+
+	return R_ARG1; // port
+}
+
+
+/***********************************************************************
+**
+*/	void Init_MIDI_Scheme(void)
+/*
+***********************************************************************/
+{
+	Register_Scheme(SYM_MIDI, 0, MIDI_Actor);
+}
diff --git a/src/core/t-event.c b/src/core/t-event.c
@@ -210,7 +210,7 @@
 			*val = *Get_System(SYS_VIEW, VIEW_EVENT_PORT);
 		}
 		// Event holds a port:
-		else if (IS_EVENT_MODEL(value, EVM_PORT)) {
+		else if (IS_EVENT_MODEL(value, EVM_PORT) || IS_EVENT_MODEL(value, EVM_MIDI)) {
 			SET_PORT(val, VAL_EVENT_SER(value));
 		}
 		// Event holds an object:
@@ -237,6 +237,9 @@
 				break;
 			}
 		}
+		else if (IS_EVENT_MODEL(value, EVM_MIDI))
+			goto is_none;
+
 		return FALSE;
 
 	case SYM_OFFSET:
diff --git a/src/include/reb-device.h b/src/include/reb-device.h
@@ -187,6 +187,10 @@ struct rebol_devreq {
 			u32  window_rows;
 			u32  window_cols;
 		} console;
+		struct {
+			u32 device_in;  // requested device ID (1-based; 0 = none)
+			u32 device_out;
+		} midi;
 	};
 };
 #pragma pack()
diff --git a/src/include/reb-event.h b/src/include/reb-event.h
@@ -34,6 +34,7 @@
 // Forward references:
 typedef struct rebol_device REBDEV;
 typedef struct rebol_devreq REBREQ;
+typedef struct Reb_Series   REBSER;
 
 #pragma pack(4)
 typedef struct rebol_event {
@@ -44,7 +45,8 @@ typedef struct rebol_event {
 	u32 data;		// an x/y position or keycode (raw/decoded)
 	union {
 		REBREQ *req;	// request (for device events)
-		void *ser;		// port or object
+		REBSER *port;   // port
+		void *ser;		// object
 	};
 } REBEVT;
 #pragma pack()
@@ -68,6 +70,7 @@ enum {
 	EVM_OBJECT,		// event holds object frame pointer
 	EVM_GUI,		// GUI event uses system/view/event/port
 	EVM_CALLBACK,	// Callback event uses system/ports/callback port
+	EVM_MIDI,		// event holds midi port pointer
 };
 
 // Special messages
diff --git a/src/mezz/sys-ports.r b/src/mezz/sys-ports.r
@@ -320,6 +320,30 @@ init-schemes: func [
 		name: 'clipboard
 	]
 
+	make-scheme [
+		title: "MIDI"
+		name: 'midi
+		spec: system/standard/port-spec-midi
+		init: func [port /local spec inp out] [
+			spec: port/spec
+			if url? spec/ref [
+				parse spec/ref [
+					thru #":" 0 2 slash
+					opt "device:"
+					copy inp *parse-url/digits
+					opt [#"/" copy out *parse-url/digits]
+					end
+				]
+				if inp [ spec/device-in:  to integer! inp]
+				if out [ spec/device-out: to integer! out]
+			]
+			; make port/spec to be only with midi related keys
+			set port/spec: copy system/standard/port-spec-midi spec
+			;protect/words port/spec ; protect spec object keys of modification
+			true
+		]
+	]
+
 	system/ports/system:   open [scheme: 'system]
 	system/ports/input:    open [scheme: 'console]
 	system/ports/callback: open [scheme: 'callback]
diff --git a/src/os/win32/dev-midi.c b/src/os/win32/dev-midi.c

Original file line number	Diff line number	Diff line change
`@@ -210,7 +210,7 @@`
`210`	`210`	`val = Get_System(SYS_VIEW, VIEW_EVENT_PORT);`
`211`	`211`	`}`
`212`	`212`	`// Event holds a port:`
`213`		`- else if (IS_EVENT_MODEL(value, EVM_PORT)) {`
	`213`	`+ else if (IS_EVENT_MODEL(value, EVM_PORT) \|\| IS_EVENT_MODEL(value, EVM_MIDI)) {`
`214`	`214`	`SET_PORT(val, VAL_EVENT_SER(value));`
`215`	`215`	`}`
`216`	`216`	`// Event holds an object:`
`@@ -237,6 +237,9 @@`
`237`	`237`	`break;`
`238`	`238`	`}`
`239`	`239`	`}`
	`240`	`+ else if (IS_EVENT_MODEL(value, EVM_MIDI))`
	`241`	`+ goto is_none;`
	`242`	`+`
`240`	`243`	`return FALSE;`
`241`	`244`
`242`	`245`	`case SYM_OFFSET:`