1 files changed, 79 insertions, 0 deletions
diff --git a/src/scheme.c b/src/scheme.c
new file mode 100644
index 0000000..b2a0771
--- /dev/null
+++ b/src/scheme.c
@@ -0,0 +1,79 @@
+/*
+ * scheme.c
+ *
+ * Copyright © 2019-2020 Thomas White <taw@bitwiz.me.uk>
+ *
+ * This file is part of NanoLight.
+ *
+ * NanoLight 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 <http://www.gnu.org/licenses/>.
+ *
+ */
+
+
+#include <libguile.h>
+
+#include "lightctx.h"
+
+
+static SCM fixture_type;
+
+
+static SCM set_intensity(SCM fixture_scm, SCM intensity_scm)
+{
+	const int intensity = scm_to_int(intensity_scm);
+
+	scm_assert_foreign_object_type(fixture_type, fixture_scm);
+	struct fixture *fixture = scm_foreign_object_ref(fixture_scm, 0);
+
+	fixture->v.intensity = (float)intensity/100.0;
+
+	return SCM_UNSPECIFIED;
+}
+
+
+static void finalize_fixture(SCM fixture)
+{
+	printf("finalise fixture!\n");
+}
+
+
+void *register_scheme_funcs(void *data)
+{
+	struct lightctx *nl = data;
+	SCM name, slots;
+	int i;
+	scm_t_struct_finalize finalizer;
+
+	name = scm_from_utf8_symbol("fixture");
+	slots = scm_list_1(scm_from_utf8_symbol("data"));
+	finalizer = finalize_fixture;
+	fixture_type = scm_make_foreign_object_type(name, slots, finalizer);
+
+	for ( i=0; i<nl->n_fixtures; i++ ) {
+		SCM obj = scm_make_foreign_object_1(fixture_type, &nl->fixtures[i]);
+		scm_define(scm_from_utf8_symbol(nl->fixtures[i].label), obj);
+	}
+
+	scm_c_define_gsubr("set-intensity", 2, 0, 0, &set_intensity);
+
+	return NULL;
+}
+
+
+void *run_repl(void *pargsv)
+{
+	scm_with_guile(&register_scheme_funcs, pargsv);
+	scm_shell(0, NULL);
+	return NULL;
+}