summaryrefslogtreecommitdiff
path: root/source/luametatex/source/luaoptional/lmtcerflib.c
blob: b18e3fb4784faa9dba6148c6552e532300df1e9b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
/*

    See license.txt in the root of this project.

    In order to match the xmath library we also support complex error functions. For that we use
    the libcerf funcitonality. That library itself is a follow up on other code (you can find
    articles on the web).

    One complication is that the library (at the time we started using it) is not suitable for the
    MSVC compiler so we use adapted code, so yet another succession. We currently embed libcerf but
    when we have the optional library compilation up and running on the garden that might become a
    real optional module instead.

    Note: Alan has to test if all works okay.

*/

# include "lmtoptional.h"
# include "luametatex.h"

# include <complex.h>
# include <cerf.h>

/*tex We start with some similar code as in |xcomplex.c|. */

# define COMPLEX_METATABLE "complex number"

# if (_MSC_VER)

    # define Complex _Dcomplex

    static Complex lmt_tocomplex(lua_State *L, int i)
    {
        switch (lua_type(L, i)) {
            case LUA_TNUMBER:
            case LUA_TSTRING:
                return _Cbuild(luaL_checknumber(L, i), 0);
            default:
                return *((Complex*)luaL_checkudata(L, i, COMPLEX_METATABLE));
        }
    }

# else

    # define Complex double complex

    static Complex lmt_tocomplex(lua_State *L, int i)
    {
        switch (lua_type(L, i)) {
            case LUA_TNUMBER:
            case LUA_TSTRING:
                return luaL_checknumber(L, i);
            default:
                return *((Complex*)luaL_checkudata(L, i, COMPLEX_METATABLE));
        }
    }

# endif

static int lmt_pushcomplex(lua_State *L, Complex z)
{
    Complex *p = lua_newuserdatauv(L, sizeof(Complex), 0);
    luaL_setmetatable(L, COMPLEX_METATABLE);
    *p = z;
    return 1;
}

/*tex We use that here: */

static int xcomplexlib_cerf_erf (lua_State *L) {
    return lmt_pushcomplex(L, cerf(lmt_tocomplex(L, 1)));
}

static int xcomplexlib_cerf_erfc (lua_State *L) {
    return lmt_pushcomplex(L, lmt_tocomplex(L, 1));
}

static int xcomplexlib_cerf_erfcx (lua_State *L) {
    return lmt_pushcomplex(L, cerfcx(lmt_tocomplex(L, 1)));
}

static int xcomplexlib_cerf_erfi (lua_State *L) {
    return lmt_pushcomplex(L, cerfi(lmt_tocomplex(L, 1)));
}

static int xcomplexlib_cerf_dawson (lua_State *L) {
    return lmt_pushcomplex(L, cdawson(lmt_tocomplex(L, 1)));
}

static int xcomplexlib_cerf_voigt (lua_State *L) {
    lua_pushnumber(L, voigt(lua_tonumber(L, 1), lua_tonumber(L, 2), lua_tonumber(L, 3)));
    return 1;
}

static int xcomplexlib_cerf_voigt_hwhm (lua_State *L) {
    int error = 0;
    double result = voigt_hwhm(lua_tonumber(L, 1), lua_tonumber(L, 2), &error);
    lua_pushnumber(L, result);
    switch (error) {
        case 1 : 
            tex_formatted_warning("voigt_hwhm", "bad arguments");
            break;
        case 2 : 
            tex_formatted_warning("voigt_hwhm", "huge deviation");
            break;
        case 3 : 
            tex_formatted_warning("voigt_hwhm", "no convergence");
            break;
    }
    return 1;
}

static struct luaL_Reg xcomplexlib_cerf_function_list[] = {
    { "erf",        xcomplexlib_cerf_erf        },
    { "erfc",       xcomplexlib_cerf_erfc       },
    { "erfcx",      xcomplexlib_cerf_erfcx      },
    { "erfi",       xcomplexlib_cerf_erfi       },
    { "dawson",     xcomplexlib_cerf_dawson     },
    { "voigt",      xcomplexlib_cerf_voigt      },
    { "voigt_hwhm", xcomplexlib_cerf_voigt_hwhm },
    { NULL,         NULL                        },
};

int luaextend_xcomplex(lua_State *L)
{
    lua_getglobal(L, "string");
    for (const luaL_Reg *lib = xcomplexlib_cerf_function_list; lib->name; lib++) {
        lua_pushcfunction(L, lib->func);
        lua_setfield(L, -2, lib->name);
    }
    lua_pop(L, 1);
    return 1;
}