guile/compartment.cc

#include <vtestbed/config/real_type.hh>
#include <vtestbed/core/compartment.hh>
#include <vtestbed/guile/macros.hh>
#include <vtestbed/guile/traits.hh>

using object_type = vtb::core::Compartment<VTB_REAL_TYPE>;
using traits_type = vtb::guile::Traits<object_type>;
using polyhedron_type = vtb::geometry::Polyhedron<VTB_REAL_TYPE,3>;
using polyhedron_traits = vtb::guile::Traits<polyhedron_type>;
using compartment_array = vtb::core::Compartment_array<VTB_REAL_TYPE>;
using compartment_type = vtb::core::Compartment<VTB_REAL_TYPE>;

namespace {
    SCM type;
    SCM kw_name;
}


namespace vtb {

    namespace guile {

        template <> SCM traits_type::type() { return ::type; }

        SCM make_compartment(SCM polyhedron, SCM rest) {
            auto* polyhedron_wrapper = get_wrapper<polyhedron_type>(polyhedron);
            SCM name = SCM_UNDEFINED;
            scm_c_bind_keyword_arguments("make-compartment", rest,
                                         scm_t_keyword_arguments_flags{},
                                         kw_name, &name, SCM_UNDEFINED);
            auto* wrapper = make_wrapper<object_type>();
            if (is_bound(name)) { wrapper->get()->name(to_string(name)); }
            wrapper->get()->polyhedron(*polyhedron_wrapper->get());
            return make_object<object_type>(traits_type::type(), wrapper);
        }

        SCM generate_compartments(SCM hull, SCM nrooms) {
            using traits_type = vtb::guile::Traits<compartment_type>;
            auto* polyhedron_wrapper = get_wrapper<polyhedron_type>(hull);
            auto size = to_vector<int,3>(nrooms);
            auto&& rooms = compartment_array::generate(*polyhedron_wrapper->get(), size);
            SCM s_rooms = SCM_EOL;
            for (auto& room : rooms) {
                s_rooms = scm_cons(traits_type::make(std::move(room)), s_rooms);
            }
            s_rooms = scm_reverse(s_rooms);
            return s_rooms;
        }

        template <> void
        traits_type::define() {
            ::type = define_type<object_type>("<compartment>");
            kw_name = scm_from_utf8_keyword("name");
            define_procedure("make-compartment", 1, 0, 1, VTB_GUILE_2(make_compartment));
            define_procedure("generate-compartments", 2, 0, 0,
                             VTB_GUILE_2(generate_compartments));
        }

    }

}