guile/ship.cc

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

using object_type = vtb::core::Ship<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 hull_type = vtb::core::Hull<VTB_REAL_TYPE>;
using compartment_array = vtb::core::Compartment_array<VTB_REAL_TYPE>;
using compartment_type = vtb::core::Compartment<VTB_REAL_TYPE>;
using compartment_traits = vtb::guile::Traits<compartment_type>;

namespace {
    SCM type;
    SCM kw_hull, kw_compartments, kw_mass, kw_displacement, kw_draught;
}

namespace vtb {

    namespace guile {

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

        SCM make_ship(SCM rest) {
            using T = VTB_REAL_TYPE;
            SCM hull = SCM_UNDEFINED, compartments = SCM_UNDEFINED, mass = SCM_UNDEFINED,
                displacement = SCM_UNDEFINED, draught = SCM_UNDEFINED;
            scm_c_bind_keyword_arguments("make-ship", rest,
                                         scm_t_keyword_arguments_flags{},
                                         kw_hull, &hull, kw_compartments, &compartments,
                                         kw_mass, &mass, kw_displacement, &displacement,
                                         kw_draught, &draught, SCM_UNDEFINED);
            auto* wrapper = make_wrapper<object_type>();
            if (is_bound(hull)) {
                SCM s_class = scm_class_of(hull);
                if (s_class == Traits<polyhedron_type>::type()) {
                    auto* hull_wrapper = get_wrapper<polyhedron_type>(hull);
                    wrapper->get()->hull(*hull_wrapper->get());
                } else if (s_class == Traits<hull_type>::type()) {
                    auto* hull_wrapper = get_wrapper<hull_type>(hull);
                    wrapper->get()->hull(*hull_wrapper->get());
                } else {
                    throw_error("hull should be of type polyhedron or hull");
                    return SCM_UNSPECIFIED;
                }
            }
            if (is_bound(compartments)) {
                compartment_array rooms;
                while (compartments != SCM_EOL) {
                    SCM comp = scm_car(compartments);
                    auto* comp_wrapper = get_wrapper<compartment_type>(comp);
                    rooms.emplace_back(*comp_wrapper->get());
                    compartments = scm_cdr(compartments);
                }
                wrapper->get()->compartments(rooms);
            }
            if (is_bound(mass) + is_bound(displacement) + is_bound(draught) >= 2) {
                throw_error("specify only one of the following: mass, displacement, draught");
                return SCM_UNSPECIFIED;
            }
            if (is_bound(mass)) {
                wrapper->get()->mass(from_scm<T>(mass));
            }
            if (is_bound(displacement)) {
                wrapper->get()->displacement(from_scm<T>(displacement));
            }
            if (is_bound(draught)) {
                wrapper->get()->draught(from_scm<T>(draught));
            }
            return make_object<object_type>(traits_type::type(), wrapper);
        }

        SCM ship_mass(SCM object) {
            auto* wrapper = get_wrapper<object_type>(object);
            return to_scm(wrapper->get()->mass());
        }

        template <> void
        traits_type::define() {
            ::type = define_type<object_type>("<compartment>");
            kw_hull = scm_from_utf8_keyword("hull");
            kw_compartments = scm_from_utf8_keyword("compartments");
            kw_mass = scm_from_utf8_keyword("mass");
            kw_displacement = scm_from_utf8_keyword("displacement");
            kw_draught = scm_from_utf8_keyword("draught");
            define_procedure("make-ship", 0, 0, 1, VTB_GUILE_1(make_ship));
            define_procedure("ship-mass", 1, 0, 0, VTB_GUILE_1(ship_mass));
        }

    }

}