guile/gerstner.cc

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

using object_type = std::unique_ptr<vtb::core::Gerstner_solver<VTB_REAL_TYPE,3>>;
using traits_type = vtb::guile::Traits<object_type>;
using linear_wave = vtb::core::Linear_wave<VTB_REAL_TYPE,3>;

namespace {
    SCM type;
    SCM kw_policy, kw_diffraction, kw_radiation, kw_waterline_only, kw_waves;
    SCM sym_opencl, sym_openmp;
}


namespace vtb {

    namespace guile {

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

        inline SCM make_gerstner_solver(SCM rest) {
            using namespace vtb::core;
            using vtb::core::make_gerstner_solver;
            using T = VTB_REAL_TYPE;
            SCM s_policy = sym_opencl, diffraction = SCM_UNDEFINED, radiation = SCM_UNDEFINED,
                waterline_only = SCM_UNDEFINED, waves = SCM_UNDEFINED;
            scm_c_bind_keyword_arguments("make-gerstner-solver", rest,
                                         scm_t_keyword_arguments_flags{},
                                         kw_policy, &s_policy,
                                         kw_diffraction, &diffraction,
                                         kw_radiation, &radiation,
                                         kw_waterline_only, &waterline_only,
                                         kw_waves, &waves,
                                         SCM_UNDEFINED);
            Policy policy = Policy::OpenCL;
            if (symbol_equal(s_policy, sym_opencl)) { policy = Policy::OpenCL; }
            else if (symbol_equal(s_policy, sym_openmp)) { policy = Policy::OpenMP; }
            else { throw_error("bad policy"); return SCM_UNSPECIFIED; }
            auto&& solver = make_gerstner_solver<T,3>(policy);
            if (is_bound(diffraction)) { solver->diffraction(from_scm<bool>(diffraction)); }
            if (is_bound(radiation)) { solver->radiation(from_scm<bool>(radiation)); }
            if (is_bound(waterline_only)) {
                solver->waterline_only(from_scm<bool>(waterline_only));
            }
            if (is_bound(waves)) {
                if (!is_list(waves)) {
                    throw_error("bad waves type");
                    return SCM_UNSPECIFIED;
                }
                using wave_array = typename Gerstner_solver<T,3>::wave_array;
                using wave_type = typename wave_array::value_type;
                wave_array new_waves;
                while (waves != SCM_EOL) {
                    auto* wrapper = get_wrapper<wave_type>(scm_car(waves));
                    new_waves.emplace_back(*wrapper->get());
                    waves = scm_cdr(waves);
                }
                solver->waves(std::move(new_waves));
            }
            return traits_type::make(std::move(solver));
        }

        template <> void
        traits_type::define() {
            ::type = define_type<object_type>("<gerstner-solver>");
            kw_policy = scm_from_utf8_keyword("policy");
            kw_diffraction = scm_from_utf8_keyword("diffraction");
            kw_radiation = scm_from_utf8_keyword("radiation");
            kw_waterline_only = scm_from_utf8_keyword("waterline-only");
            kw_waves = scm_from_utf8_keyword("waves");
            sym_opencl = scm_from_utf8_symbol("opencl");
            sym_openmp = scm_from_utf8_symbol("openmp");
            define_procedure("make-gerstner-solver", 0, 0, 1,
                             VTB_GUILE_1(make_gerstner_solver));
        }

    }

}