From d4b254d0247b5f76d4dd80191029fc30fadcb177 Mon Sep 17 00:00:00 2001 From: Thomas White Date: Sat, 15 Apr 2023 20:22:17 +0200 Subject: Initial commit --- guile-osc.c | 143 +++++++++++++++++++++++++++++++++++++++++++++++++++ guile-osc/engine.scm | 27 ++++++++++ meson.build | 17 ++++++ 3 files changed, 187 insertions(+) create mode 100644 guile-osc.c create mode 100644 guile-osc/engine.scm create mode 100644 meson.build diff --git a/guile-osc.c b/guile-osc.c new file mode 100644 index 0000000..f6a5906 --- /dev/null +++ b/guile-osc.c @@ -0,0 +1,143 @@ +/* + * guile-osc.c + * + * Copyright © 2023 Thomas White + * + * This file is part of Guile-OSC. + * + * Guile-OSC is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + * + */ + +#include + +#include +#include + + +static SCM osc_server_type; +static SCM osc_method_type; + + +static void error_callback(int num, const char *msg, const char *path) +{ + fprintf(stderr, "liblo error %i (%s) for path %s\n", num, msg, path); +} + + +static SCM start_osc() +{ + lo_server_thread srv = lo_server_thread_new("7770", error_callback); + lo_server_thread_start(srv); + return scm_make_foreign_object_1(osc_server_type, srv); +} + + +static void finalize_osc_server(SCM obj) +{ + lo_server_thread srv; + scm_assert_foreign_object_type(osc_server_type, obj); + srv = scm_foreign_object_ref(obj, 0); + lo_server_thread_free(srv); +} + + +struct method_callback_data +{ + SCM proc; +}; + + +/* This struct exists just to help get the method callback arguments + * into Guile mode */ +struct method_callback_guile_data +{ + const char *path; + const char *types; + lo_arg **argv; + int argc; + lo_message *msg; + void *vp; +}; + + +static void *method_callback_with_guile(void *vp) +{ + struct method_callback_guile_data *data = vp; + struct method_callback_data *mdata = data->vp; + scm_call_0(mdata->proc); + return NULL; +} + + +static int method_callback(const char *path, const char *types, lo_arg **argv, + int argc, lo_message msg, void *vp) +{ + /* The OSC server thread is not under our control, and is not in + * Guile mode. Therefore, some "tedious mucking-about in hyperspace" + * is required before we can invoke the Scheme callback */ + struct method_callback_guile_data cb_data; + cb_data.path = path; + cb_data.types = types; + cb_data.argv = argv; + cb_data.argc = argc; + cb_data.msg = msg; + cb_data.vp = vp; + scm_with_guile(method_callback_with_guile, &cb_data); + return 1; +} + + +static SCM define_osc_method(SCM server_obj, SCM path_obj, SCM proc) +{ + lo_server_thread srv; + lo_method method; + char *path; + struct method_callback_data *data; + + scm_assert_foreign_object_type(osc_server_type, server_obj); + srv = scm_foreign_object_ref(server_obj, 0); + + data = malloc(sizeof(struct method_callback_data)); + data->proc = proc; + scm_gc_protect_object(proc); + + path = scm_to_utf8_stringn(path_obj, NULL); + method = lo_server_thread_add_method(srv, path, "", + method_callback, data); + free(path); + + return scm_make_foreign_object_1(osc_method_type, method); +} + + +void init_guile_osc() +{ + SCM name, slots; + + name = scm_from_utf8_symbol("OSCServer"); + slots = scm_list_1(scm_from_utf8_symbol("data")); + osc_server_type = scm_make_foreign_object_type(name, + slots, + finalize_osc_server); + + name = scm_from_utf8_symbol("OSCMethod"); + slots = scm_list_1(scm_from_utf8_symbol("data")); + osc_method_type = scm_make_foreign_object_type(name, slots, NULL); + + scm_c_define_gsubr("start-osc", 0, 0, 0, start_osc); + scm_c_define_gsubr("define-osc-method", 3, 0, 0, define_osc_method); + + scm_add_feature("guile-osc"); +} diff --git a/guile-osc/engine.scm b/guile-osc/engine.scm new file mode 100644 index 0000000..7c8310b --- /dev/null +++ b/guile-osc/engine.scm @@ -0,0 +1,27 @@ +;; +;; guile-osc/engine.scm +;; +;; Copyright © 2023 Thomas White +;; +;; This file is part of Guile-OSC. +;; +;; Guile-OSC is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +(define-module (guile-osc engine) + #:export (start-osc + define-osc-method)) + +(if (not (provided? 'guile-osc)) + (load-extension "libguile-osc" + "init_guile_osc")) diff --git a/meson.build b/meson.build new file mode 100644 index 0000000..3c8f724 --- /dev/null +++ b/meson.build @@ -0,0 +1,17 @@ +project('guile-osc', ['c'], + version: '0.1.0', + license: 'GPL3+', + default_options: ['buildtype=debugoptimized']) + +# Dependencies +guile_dep = dependency('guile-3.0', required: true) +lo_dep = dependency('liblo', required: true) + +# The installation location for Scheme files +guile_sitedir = guile_dep.get_pkgconfig_variable('sitedir') + +library('guile-osc', ['guile-osc.c'], + dependencies: [guile_dep, lo_dep], + install: true) + +install_subdir('guile-osc', install_dir: guile_sitedir) -- cgit v1.2.3