wave.cc

#include <vtestbed/config/real_type.hh>
#include <vtestbed/core/cosine_wave.hh>
#include <vtestbed/core/linear_wave.hh>
#include <vtestbed/core/stokes_wave.hh>
#include <vtestbed/guile/macros.hh>
#include <vtestbed/guile/traits.hh>

using propagating_cosine = vtb::core::Propagating_cosine_wave<VTB_REAL_TYPE,3>;
using propagating_cosine_traits = vtb::guile::Traits<propagating_cosine>;
using standing_cosine = vtb::core::Standing_cosine_wave<VTB_REAL_TYPE,3>;
using standing_cosine_traits = vtb::guile::Traits<standing_cosine>;
using stokes = vtb::core::Propagating_stokes_wave<VTB_REAL_TYPE,3>;
using stokes_traits = vtb::guile::Traits<stokes>;
using linear_wave = vtb::core::Linear_wave<VTB_REAL_TYPE,3>;
using linear_wave_traits = vtb::guile::Traits<linear_wave>;

namespace {
    SCM propagating_cosine_type;
    SCM standing_cosine_type;
    SCM stokes_type;
    SCM linear_wave_type;
    SCM kw_amplitude, kw_length, kw_direction;
}

namespace vtb {

    namespace guile {

        template <> SCM propagating_cosine_traits::type() { return ::propagating_cosine_type; }
        template <> SCM standing_cosine_traits::type() { return ::standing_cosine_type; }
        template <> SCM stokes_traits::type() { return ::stokes_type; }
        template <> SCM linear_wave_traits::type() { return ::linear_wave_type; }

        template <> void
        propagating_cosine_traits::define() {
            ::propagating_cosine_type =
                define_type<propagating_cosine>("<propagating-cosine-wave>");
        }

        template <> void
        standing_cosine_traits::define() {
            ::standing_cosine_type = define_type<standing_cosine>("<standing-cosine-wave>");
        }

        template <> void
        stokes_traits::define() {
            ::stokes_type = define_type<stokes>("<propagating-stokes-wave>");
        }

        template <> void
        linear_wave_traits::define() {
            ::linear_wave_type = define_type<stokes>("<linear-wave>");
        }

        SCM make_wave(SCM type, SCM rest) {
            using namespace vtb::core;
            using T = VTB_REAL_TYPE;
            SCM amplitude = to_scm(T(1)), length = to_scm(T(40)), direction = to_scm(T(0));
            scm_c_bind_keyword_arguments("make-wave", rest,
                                         scm_t_keyword_arguments_flags{},
                                         kw_amplitude, &amplitude,
                                         kw_length, &length,
                                         kw_direction, &direction,
                                         SCM_UNDEFINED);
            if (type == propagating_cosine_type) {
                propagating_cosine wave(Amplitude<T>(from_scm<T>(amplitude)),
                                        Length<T>(from_scm<T>(length)),
                                        Direction<T>(from_scm<T>(direction)));
                return propagating_cosine_traits::make(wave);
            }
            if (type == propagating_cosine_type) {
                standing_cosine wave(Amplitude<T>(from_scm<T>(amplitude)),
                                     Length<T>(from_scm<T>(length)),
                                     Direction<T>(from_scm<T>(direction)));
                return standing_cosine_traits::make(wave);
            }
            if (type == stokes_type) {
                stokes wave(Amplitude<T>(from_scm<T>(amplitude)),
                            Length<T>(from_scm<T>(length)),
                            Direction<T>(from_scm<T>(direction)));
                return stokes_traits::make(wave);
            }
            if (type == linear_wave_type) {
                linear_wave wave(Amplitude<T>(from_scm<T>(amplitude)),
                                 Length<T>(from_scm<T>(length)),
                                 Direction<T>(from_scm<T>(direction)));
                return linear_wave_traits::make(wave);
            }
            return SCM_UNSPECIFIED;
        }

        void wave_define() {
            kw_amplitude = scm_from_utf8_keyword("amplitude");
            kw_length = scm_from_utf8_keyword("length");
            kw_direction = scm_from_utf8_keyword("direction");
            define_procedure("make-wave", 1, 0, 1, VTB_GUILE_2(make_wave));
        }

    }

}