/* * scheme.c * * Copyright © 2019-2020 Thomas White * * 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 . * */ #include #include "lightctx.h" #include "fixture_library.h" static SCM fixture_type; static SCM fixture_class_type; SCM fixture_list = SCM_EOL; struct lightctx *nl = NULL; 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 SCM fixture_name(SCM fixture_scm) { scm_assert_foreign_object_type(fixture_type, fixture_scm); struct fixture *fixture = scm_foreign_object_ref(fixture_scm, 0); return scm_from_utf8_symbol(fixture->label); } static SCM fixture_class_name(SCM fixture_class_scm) { scm_assert_foreign_object_type(fixture_class_type, fixture_class_scm); struct fixture_class *fixture_class = scm_foreign_object_ref(fixture_class_scm, 0); return scm_from_utf8_string(fixture_class->name); } static SCM patch_fixture(SCM fixture_name_scm, SCM fixture_class_scm, SCM universe_scm, SCM addr_scm) { const int universe = scm_to_int(universe_scm); const int addr = scm_to_int(addr_scm); struct fixture_class *fixture_class; char *fixture_name; SCM fixture_string; struct fixture *fixture; scm_assert_foreign_object_type(fixture_class_type, fixture_class_scm); fixture_class = scm_foreign_object_ref(fixture_class_scm, 0); if ( !scm_is_symbol(fixture_name_scm) ) return SCM_BOOL_F; fixture_string = scm_symbol_to_string(fixture_name_scm); fixture_name = scm_to_locale_string(fixture_string); fixture = create_fixture(nl, fixture_class, fixture_name, universe, addr, REVERSE_PAN); free(fixture_name); SCM obj = scm_make_foreign_object_1(fixture_type, fixture); SCM obj_list = scm_list_1(obj); fixture_list = scm_append(scm_list_2(fixture_list, obj_list)); scm_define(scm_from_utf8_symbol("fixtures"), fixture_list); return obj; } static void finalize_fixture(SCM fixture) { printf("finalise fixture!\n"); } static void finalize_fixture_class(SCM fixture) { printf("finalise fixture class!\n"); } void *register_scheme_funcs(void *data) { SCM name, slots; SCM obj; SCM fixture_class_list; nl = data; /* Define fixture type */ name = scm_from_utf8_symbol("fixture"); slots = scm_list_1(scm_from_utf8_symbol("data")); fixture_type = scm_make_foreign_object_type(name, slots, finalize_fixture); /* Define fixture class type */ name = scm_from_utf8_symbol("fixture-class"); slots = scm_list_1(scm_from_utf8_symbol("data")); fixture_class_type = scm_make_foreign_object_type(name, slots, finalize_fixture_class); /* Expose the list of fixture classes */ fixture_class_list = SCM_EOL; obj = scm_make_foreign_object_1(fixture_class_type, &dl7s_class); fixture_class_list = scm_append(scm_list_2(fixture_class_list, scm_list_1(obj))); obj = scm_make_foreign_object_1(fixture_class_type, &generic_dimmer_class); fixture_class_list = scm_append(scm_list_2(fixture_class_list, scm_list_1(obj))); scm_define(scm_from_utf8_symbol("fixture-class-library"), fixture_class_list); /* Expose the list of fixtures (starts empty) */ scm_define(scm_from_utf8_symbol("fixtures"), fixture_list); scm_c_define_gsubr("fixture-name", 1, 0, 0, &fixture_name); scm_c_define_gsubr("fixture-class-name", 1, 0, 0, &fixture_class_name); scm_c_define_gsubr("set-intensity", 2, 0, 0, &set_intensity); scm_c_define_gsubr("patch-fixture", 4, 0, 0, &patch_fixture); return NULL; } static void run_init() { GBytes *bytes; GError *error = NULL; gsize size; gconstpointer initscm; bytes = g_resources_lookup_data("/uk/me/bitwiz/NanoLight/src/init.scm", G_RESOURCE_LOOKUP_FLAGS_NONE, &error); initscm = g_bytes_get_data(bytes, &size); scm_c_eval_string(initscm); g_bytes_unref(bytes); } void *run_repl(void *pargsv) { scm_with_guile(®ister_scheme_funcs, pargsv); run_init(); scm_shell(0, NULL); return NULL; }