Source Browser ?

1/*
2
3    See license.txt in the root of this project.
4
5    In order to match the xmath library we also support complex error functions. For that we use
6    the libcerf funcitonality. That library itself is a follow up on other code (you can find
7    articles on the web).
8
9    One complication is that the library (at the time we started using it) is not suitable for the
10    MSVC compiler so we use adapted code, so yet another succession. We currently embed libcerf but
11    when we have the optional library compilation up and running on the garden that might become a
12    real optional module instead.
13
14    Note: Alan has to test if all works okay.
15
16*/
17
18# include "lmtoptional.h"
19# include "luametatex.h"
20
21# include <complex.h>
22# include <cerf.h>
23
24/*tex We start with some similar code as in |xcomplex.c|. */
25
26# define COMPLEX_METATABLE "complex number"
27
28# if (_MSC_VER)
29
30    # define Complex _Dcomplex
31
32    static Complex lmt_tocomplex(lua_State *L, int i)
33    {
34        switch (lua_type(L, i)) {
35            case LUA_TNUMBER:
36            case LUA_TSTRING:
37                return _Cbuild(luaL_checknumber(L, i), 0);
38            default:
39                return *((Complex*)luaL_checkudata(L, i, COMPLEX_METATABLE));
40        }
41    }
42
43# else
44
45    # define Complex double complex
46
47    static Complex lmt_tocomplex(lua_State *L, int i)
48    {
49        switch (lua_type(L, i)) {
50            case LUA_TNUMBER:
51            case LUA_TSTRING:
52                return luaL_checknumber(L, i);
53            default:
54                return *((Complex*)luaL_checkudata(L, i, COMPLEX_METATABLE));
55        }
56    }
57
58# endif
59
60static int lmt_pushcomplex(lua_State *L, Complex z)
61{
62    Complex *p = lua_newuserdatauv(L, sizeof(Complex), 0);
63    luaL_setmetatable(L, COMPLEX_METATABLE);
64    *p = z;
65    return 1;
66}
67
68/*tex We use that here: */
69
70static int xcomplexlib_cerf_erf (lua_State *L) {
71    return lmt_pushcomplex(L, cerf(lmt_tocomplex(L, 1)));
72}
73
74static int xcomplexlib_cerf_erfc (lua_State *L) {
75    return lmt_pushcomplex(L, lmt_tocomplex(L, 1));
76}
77
78static int xcomplexlib_cerf_erfcx (lua_State *L) {
79    return lmt_pushcomplex(L, cerfcx(lmt_tocomplex(L, 1)));
80}
81
82static int xcomplexlib_cerf_erfi (lua_State *L) {
83    return lmt_pushcomplex(L, cerfi(lmt_tocomplex(L, 1)));
84}
85
86static int xcomplexlib_cerf_dawson (lua_State *L) {
87    return lmt_pushcomplex(L, cdawson(lmt_tocomplex(L, 1)));
88}
89
90static int xcomplexlib_cerf_voigt (lua_State *L) {
91    lua_pushnumber(L, voigt(lua_tonumber(L, 1), lua_tonumber(L, 2), lua_tonumber(L, 3)));
92    return 1;
93}
94
95static int xcomplexlib_cerf_voigt_hwhm (lua_State *L) {
96    int error = 0;
97    double result = voigt_hwhm(lua_tonumber(L, 1), lua_tonumber(L, 2), &error);
98    lua_pushnumber(L, result);
99    switch (error) {
100        case 1 : 
101            tex_formatted_warning("voigt_hwhm", "bad arguments");
102            break;
103        case 2 : 
104            tex_formatted_warning("voigt_hwhm", "huge deviation");
105            break;
106        case 3 : 
107            tex_formatted_warning("voigt_hwhm", "no convergence");
108            break;
109    }
110    return 1;
111}
112
113static struct luaL_Reg xcomplexlib_cerf_function_list[] = {
114    { "erf",        xcomplexlib_cerf_erf        },
115    { "erfc",       xcomplexlib_cerf_erfc       },
116    { "erfcx",      xcomplexlib_cerf_erfcx      },
117    { "erfi",       xcomplexlib_cerf_erfi       },
118    { "dawson",     xcomplexlib_cerf_dawson     },
119    { "voigt",      xcomplexlib_cerf_voigt      },
120    { "voigt_hwhm", xcomplexlib_cerf_voigt_hwhm },
121    { NULL,         NULL                        },
122};
123
124int luaextend_xcomplex(lua_State *L)
125{
126    lua_getglobal(L, "string");
127    for (const luaL_Reg *lib = xcomplexlib_cerf_function_list; lib->name; lib++) {
128        lua_pushcfunction(L, lib->func);
129        lua_setfield(L, -2, lib->name);
130    }
131    lua_pop(L, 1);
132    return 1;
133}
134