guile/polyhedron.cc

#include <vtestbed/config/real_type.hh>
#include <vtestbed/geometry/polyhedron.hh>
#include <vtestbed/guile/grid.hh>
#include <vtestbed/guile/macros.hh>
#include <vtestbed/guile/traits.hh>

using object_type = vtb::geometry::Polyhedron<VTB_REAL_TYPE,3>;
using traits_type = vtb::guile::Traits<object_type>;

namespace {
    SCM type;
}

#define VTB_POLYHEDRON_WRAP_VOID_FUNC(name) \
    SCM polyhedron_##name(SCM object) { \
        auto* wrapper = get_wrapper<object_type>(object); \
        auto* copy = wrapper->copy(); \
        copy->name(); \
        return make_object<object_type>(::type, copy); \
    } \
 \
    SCM polyhedron_##name##_self(SCM object) { \
        auto* wrapper = get_wrapper<object_type>(object); \
        wrapper->get()->name(); \
        return SCM_UNSPECIFIED; \
    }

#define VTB_POLYHEDRON_WRAP_VOID_FUNC_1_ARG(name, ...) \
    SCM polyhedron_##name(SCM object, SCM arg) { \
        auto* wrapper = get_wrapper<object_type>(object); \
        auto* copy = wrapper->copy(); \
        copy->name(__VA_ARGS__(arg)); \
        return make_object<object_type>(::type, copy); \
    } \
 \
    SCM polyhedron_##name##_self(SCM object, SCM arg) { \
        auto* wrapper = get_wrapper<object_type>(object); \
        wrapper->get()->name(__VA_ARGS__(arg)); \
        return SCM_UNSPECIFIED; \
    }

#define VTB_POLYHEDRON_WRAP_VOID_FUNC_2_ARG(name, to_arg1, to_arg2) \
    SCM polyhedron_##name(SCM object, SCM arg1, SCM arg2) { \
        auto* wrapper = get_wrapper<object_type>(object); \
        auto* copy = wrapper->copy(); \
        copy->name(to_arg1(arg1), to_arg2(arg2)); \
        return make_object<object_type>(::type, copy); \
    } \
 \
    SCM polyhedron_##name##_self(SCM object, SCM arg1, SCM arg2) { \
        auto* wrapper = get_wrapper<object_type>(object); \
        wrapper->get()->name(to_arg1(arg1), to_arg2(arg2)); \
        return SCM_UNSPECIFIED; \
    }

namespace vtb {

    namespace guile {

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

        VTB_POLYHEDRON_WRAP_VOID_FUNC(reorder)

        
        VTB_POLYHEDRON_WRAP_VOID_FUNC(normalise)

        VTB_POLYHEDRON_WRAP_VOID_FUNC(unique)

        VTB_POLYHEDRON_WRAP_VOID_FUNC_1_ARG(move, to_vector<VTB_REAL_TYPE,3>)

        VTB_POLYHEDRON_WRAP_VOID_FUNC_1_ARG(scale, to_vector<VTB_REAL_TYPE,3>)

        VTB_POLYHEDRON_WRAP_VOID_FUNC_1_ARG(flip, scm_to_int)

        VTB_POLYHEDRON_WRAP_VOID_FUNC_1_ARG(mirror, scm_to_int)

        VTB_POLYHEDRON_WRAP_VOID_FUNC_2_ARG(rotate, scm_to_int, scm_to_int)

        SCM polyhedron_empty(SCM object) {
            auto* wrapper = get_wrapper<object_type>(object);
            return scm_from_bool(wrapper->get()->empty());
        }

        SCM polyhedron_signed_volume(SCM object) {
            auto* wrapper = get_wrapper<object_type>(object);
            return scm_from_double(signed_volume(*wrapper->get()));
        }

        SCM polyhedron_signed_volume_below(SCM object, SCM dimension, SCM level) {
            auto* wrapper = get_wrapper<object_type>(object);
            auto dim = scm_to_int(dimension);
            auto lvl = scm_to_double(level);
            return scm_from_double(wrapper->get()->signed_volume_below(dim, lvl));
        }

        SCM polyhedron_volume(SCM object) {
            auto* wrapper = get_wrapper<object_type>(object);
            return scm_from_double(volume(*wrapper->get()));
        }

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

        SCM polyhedron_bounding_box(SCM object) {
            auto* wrapper = get_wrapper<object_type>(object);
            const auto& bbox = wrapper->get()->bounding_box();
            return scm_cons(to_scm(bbox.min()), to_scm(bbox.max()));
        }

        SCM polyhedron_bounds(SCM object, SCM dimension) {
            auto* wrapper = get_wrapper<object_type>(object);
            const auto& bbox = wrapper->get()->bounds(scm_to_int(dimension));
            return scm_cons(to_scm(bbox.min()), to_scm(bbox.max()));
        }

        inline SCM make_polyhedron() { return traits_type::make(); }

        template <> void
        traits_type::define() {
            ::type = define_type<object_type>("<polyhedron>");
            define_procedure("make-polyhedron", 0, 0, 0, VTB_GUILE_0(make_polyhedron));
            define_procedure("polyhedron-reorder", 1, 0, 0, VTB_GUILE_1(polyhedron_reorder));
            define_procedure("polyhedron-reorder!", 1, 0, 0,
                             VTB_GUILE_1(polyhedron_reorder_self));
            define_procedure("polyhedron-normalise", 1, 0, 0,
                             VTB_GUILE_1(polyhedron_normalise));
            define_procedure("polyhedron-normalise!", 1, 0, 0,
                             VTB_GUILE_1(polyhedron_normalise_self));
            define_procedure("polyhedron-unique", 1, 0, 0, VTB_GUILE_1(polyhedron_unique));
            define_procedure("polyhedron-unique!", 1, 0, 0,
                             VTB_GUILE_1(polyhedron_unique_self));
            define_procedure("polyhedron-empty?", 1, 0, 0, VTB_GUILE_1(polyhedron_empty));
            define_procedure("polyhedron-signed-volume", 1, 0, 0,
                             VTB_GUILE_1(polyhedron_signed_volume));
            define_procedure("polyhedron-signed-volume-below", 3, 0, 0,
                             VTB_GUILE_3(polyhedron_signed_volume_below));
            define_procedure("polyhedron-volume", 1, 0, 0, VTB_GUILE_1(polyhedron_volume));
            define_procedure("polyhedron-centroid", 1, 0, 0, VTB_GUILE_1(polyhedron_centroid));
            define_procedure("polyhedron-bounding-box", 1, 0, 0,
                             VTB_GUILE_1(polyhedron_bounding_box));
            define_procedure("polyhedron-bounds", 2, 0, 0, VTB_GUILE_2(polyhedron_bounds));
            define_procedure("polyhedron-move", 2, 0, 0, VTB_GUILE_2(polyhedron_move));
            define_procedure("polyhedron-move!", 2, 0, 0, VTB_GUILE_2(polyhedron_move_self));
            define_procedure("polyhedron-scale", 2, 0, 0, VTB_GUILE_2(polyhedron_scale));
            define_procedure("polyhedron-scale!", 2, 0, 0, VTB_GUILE_2(polyhedron_scale_self));
            define_procedure("polyhedron-flip", 2, 0, 0, VTB_GUILE_2(polyhedron_flip));
            define_procedure("polyhedron-flip!", 2, 0, 0, VTB_GUILE_2(polyhedron_flip_self));
            define_procedure("polyhedron-mirror", 2, 0, 0, VTB_GUILE_2(polyhedron_mirror));
            define_procedure("polyhedron-mirror!", 2, 0, 0,
                             VTB_GUILE_2(polyhedron_mirror_self));
            define_procedure("polyhedron-rotate", 3, 0, 0, VTB_GUILE_3(polyhedron_rotate));
            define_procedure("polyhedron-rotate!", 3, 0, 0,
                             VTB_GUILE_3(polyhedron_rotate_self));
        }

    }

}