#ifdef HAVE_CONFIG_H
#include "config.h"
#endif

#include <caml/alloc.h>
#include <caml/callback.h>
#include <caml/fail.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
#include <locale.h>
#include <stdio.h>
#include <unistd.h>

/* For PDCurses we need to define the following so that global
 * variables are declared (in the header) with __dllspec(dllimport).
 */
#ifdef PDCURSES
#define PDC_DLL_BUILD
#undef CURSES_LIBRARY
#endif

#ifdef CURSES_HEADER
#include CURSES_HEADER
#else
#include <ncurses.h>
#endif

#ifdef CURSES_TERM_H
#include CURSES_TERM_H
#else
#include <term.h>
#endif

#ifdef HAVE_WINDOWS_H
#include <windows.h>
#endif

/* Du travail pour les esclaves de M$ */
#include <signal.h>
#ifdef HAVE_TERMIOS_H
#include <termios.h>
#endif
#ifdef HAVE_SYS_IOCTL_H
#include <sys/ioctl.h>
#endif

#define AWB(x) caml__dummy_##x = caml__dummy_##x; /* anti-warning bugware */

static value Val_window(WINDOW* w) {
  return caml_copy_nativeint((intnat)w);
}

static value Val_terminal(TERMINAL* t) {
  return caml_copy_nativeint((intnat)t);
}

static value Val_screen(SCREEN* s) {
  return caml_copy_nativeint((intnat)s);
}

#define Window_val(v) ((WINDOW*)Nativeint_val(v))

#define Terminal_val(v) ((TERMINAL*)Nativeint_val(v))

#define Screen_val(v) ((SCREEN*)Nativeint_val(v))

#define r_unit(f) \
  f;              \
  CAMLreturn(Val_unit);
#define r_window(f) CAMLreturn(Val_window(f))
#define r_terminal(f) CAMLreturn(Val_terminal(f))
#define r_err(f) CAMLreturn(Val_bool((f) != ERR))
#define r_int(f) CAMLreturn(Val_int(f))
#define r_char(f) CAMLreturn(Val_int((f) & 255))
#define r_chtype(f) CAMLreturn(Val_int(f))
#define r_attr_t(f) CAMLreturn(Val_int(f))
#define r_bool(f) CAMLreturn(Val_bool(f))
#define r_int_int(x, y)              \
  {                                  \
    CAMLlocal1(ret);                 \
    AWB(ret);                        \
    ret = caml_alloc_tuple(2);       \
    Store_field(ret, 0, Val_int(x)); \
    Store_field(ret, 1, Val_int(y)); \
    CAMLreturn(ret);                 \
  }
#define r_window_int(x, y)              \
  {                                     \
    CAMLlocal1(ret);                    \
    AWB(ret);                           \
    ret = caml_alloc_tuple(2);          \
    Store_field(ret, 0, Val_window(x)); \
    Store_field(ret, 1, Val_int(y));    \
    CAMLreturn(ret);                    \
  }
#define r_int_int_int(x, y, z)       \
  {                                  \
    CAMLlocal1(ret);                 \
    AWB(ret);                        \
    ret = caml_alloc_tuple(3);       \
    Store_field(ret, 0, Val_int(x)); \
    Store_field(ret, 1, Val_int(y)); \
    Store_field(ret, 2, Val_int(z)); \
    CAMLreturn(ret);                 \
  }
#define r_string(f)                    \
  {                                    \
    const char* ret = f;               \
    if (ret == NULL)                   \
      caml_failwith("Null pointer");   \
    CAMLreturn(caml_copy_string(ret)); \
  }

#define a_window(a) Window_val(a)
#define a_terminal(a) Terminal_val(a)
#define a_screen(a) Screen_val(Field(a, 2))
#define a_int(a) Int_val(a)
#define a_bool(a) Bool_val(a)
#define a_chtype(a) Int_val(a)
#define a_attr_t(a) Int_val(a)
#define a_string(a) Bytes_val(a)

#define RA0 CAMLparam0();
#define RA1       \
  CAMLparam1(aa); \
  AWB(aa);
#define RA2           \
  CAMLparam2(aa, ab); \
  AWB(aa);
#define RA3               \
  CAMLparam3(aa, ab, ac); \
  AWB(aa);
#define RA4                   \
  CAMLparam4(aa, ab, ac, ad); \
  AWB(aa);
#define RA5                       \
  CAMLparam5(aa, ab, ac, ad, ae); \
  AWB(aa);
#define RA6                       \
  CAMLparam5(aa, ab, ac, ad, ae); \
  CAMLxparam1(af);                \
  AWB(aa);                        \
  AWB(af);
#define RA7                       \
  CAMLparam5(aa, ab, ac, ad, ae); \
  CAMLxparam2(af, ag);            \
  AWB(aa);                        \
  AWB(af);
#define RA8                       \
  CAMLparam5(aa, ab, ac, ad, ae); \
  CAMLxparam3(af, ag, ah);        \
  AWB(aa);                        \
  AWB(af);
#define RA9                       \
  CAMLparam5(aa, ab, ac, ad, ae); \
  CAMLxparam4(af, ag, ah, ai);    \
  AWB(aa);                        \
  AWB(af);

#define ML0(f, tr)           \
  value mlcurses_##f(void) { \
    RA0 r_##tr(f());         \
  }
#define ML1(f, tr, ta)           \
  value mlcurses_##f(value aa) { \
    RA1 r_##tr(f(a_##ta(aa)));   \
  }
#define ML2(f, tr, ta, tb)                 \
  value mlcurses_##f(value aa, value ab) { \
    RA2 r_##tr(f(a_##ta(aa), a_##tb(ab))); \
  }
#define ML3(f, tr, ta, tb, tc)                         \
  value mlcurses_##f(value aa, value ab, value ac) {   \
    RA3 r_##tr(f(a_##ta(aa), a_##tb(ab), a_##tc(ac))); \
  }
#define ML4(f, tr, ta, tb, tc, td)                                 \
  value mlcurses_##f(value aa, value ab, value ac, value ad) {     \
    RA4 r_##tr(f(a_##ta(aa), a_##tb(ab), a_##tc(ac), a_##td(ad))); \
  }
#define ML5(f, tr, ta, tb, tc, td, te)                                         \
  value mlcurses_##f(value aa, value ab, value ac, value ad, value ae) {       \
    RA5 r_##tr(f(a_##ta(aa), a_##tb(ab), a_##tc(ac), a_##td(ad), a_##te(ae))); \
  }

#define ML7(f, tr, ta, tb, tc, td, te, tf, tg)                               \
  value mlcurses_##f##_bytecode(value* a, int n) {                           \
    RA0 r_##tr(f(a_##ta(a[0]), a_##tb(a[1]), a_##tc(a[2]), a_##td(a[3]),     \
                 a_##te(a[4]), a_##tf(a[5]), a_##tg(a[6])));                 \
  }                                                                          \
  value mlcurses_##f##_native(value aa, value ab, value ac, value ad,        \
                              value ae, value af, value ag) {                \
    RA7 r_##tr(f(a_##ta(aa), a_##tb(ab), a_##tc(ac), a_##td(ad), a_##te(ae), \
                 a_##tf(af), a_##tg(ag)));                                   \
  }

#define ML8(f, tr, ta, tb, tc, td, te, tf, tg, th)                           \
  value mlcurses_##f##_bytecode(value* a, int n) {                           \
    RA0 r_##tr(f(a_##ta(a[0]), a_##tb(a[1]), a_##tc(a[2]), a_##td(a[3]),     \
                 a_##te(a[4]), a_##tf(a[5]), a_##tg(a[6]), a_##th(a[7])));   \
  }                                                                          \
  value mlcurses_##f##_native(value aa, value ab, value ac, value ad,        \
                              value ae, value af, value ag, value ah) {      \
    RA8 r_##tr(f(a_##ta(aa), a_##tb(ab), a_##tc(ac), a_##td(ad), a_##te(ae), \
                 a_##tf(af), a_##tg(ag), a_##th(ah)));                       \
  }

#define ML9(f, tr, ta, tb, tc, td, te, tf, tg, th, ti)                       \
  value mlcurses_##f##_bytecode(value* a, int n) {                           \
    RA0 r_##tr(f(a_##ta(a[0]), a_##tb(a[1]), a_##tc(a[2]), a_##td(a[3]),     \
                 a_##te(a[4]), a_##tf(a[5]), a_##tg(a[6]), a_##th(a[7]),     \
                 a_##ti(a[8])));                                             \
  }                                                                          \
  value mlcurses_##f##_native(value aa, value ab, value ac, value ad,        \
                              value ae, value af, value ag, value ah,        \
                              value ai) {                                    \
    RA9 r_##tr(f(a_##ta(aa), a_##tb(ab), a_##tc(ac), a_##td(ad), a_##te(ae), \
                 a_##tf(af), a_##tg(ag), a_##th(ah), a_##ti(ai)));           \
  }

#define ML0d(f, tr) value mlcurses_##f(void)
#define ML1d(f, tr, ta) value mlcurses_##f(value aa)
#define ML2d(f, tr, ta, tb) value mlcurses_##f(value aa, value ab)
#define ML3d(f, tr, ta, tb, tc) value mlcurses_##f(value aa, value ab, value ac)
#define ML4d(f, tr, ta, tb, tc, td) \
  value mlcurses_##f(value aa, value ab, value ac, value ad)
#define ML5d(f, tr, ta, tb, tc, td, te) \
  value mlcurses_##f(value aa, value ab, value ac, value ad, value ae)
#define ML6d(f, tr, ta, tb, tc, td, te, tf)                              \
  value mlcurses_##f##_native(value, value, value, value, value, value); \
  value mlcurses_##f##_bytecode(value* a, int n) {                       \
    return (mlcurses_##f##_native(a[0], a[1], a[2], a[3], a[4], a[5]));  \
  }                                                                      \
  value mlcurses_##f##_native(value aa, value ab, value ac, value ad,    \
                              value ae, value af)

#define BEG0 \
  {          \
    RA0 {
#define BEG1 \
  {          \
    RA1 {
#define BEG2 \
  {          \
    RA2 {
#define BEG3 \
  {          \
    RA3 {
#define BEG4 \
  {          \
    RA4 {
#define BEG5 \
  {          \
    RA5 {
#define BEG6 \
  {          \
    RA6 {
#define BEG7 \
  {          \
    RA7 {
#define BEG8 \
  {          \
    RA8 {
#define BEG9 \
  {          \
    RA9 {
#define END \
  }         \
  }

/* RWMJ: Not implemented functions raise Invalid_argument
 * ("function_name").  This can happen for example when we are not
 * linked to real ncurses, particularly on Windows.
 */
#define ML0_notimpl(f, tr)                                 \
  value mlcurses_##f(void) BEG0 caml_invalid_argument(#f); \
  CAMLnoreturn;                                            \
  END
#define ML1_notimpl(f, tr, ta)                                 \
  value mlcurses_##f(value aa) BEG1 caml_invalid_argument(#f); \
  CAMLnoreturn;                                                \
  END
#define ML2_notimpl(f, tr, ta, tb)                                       \
  value mlcurses_##f(value aa, value ab) BEG2 caml_invalid_argument(#f); \
  CAMLnoreturn;                                                          \
  END

static WINDOW* ripoff_w[5];
static int ripoff_l[5];
static int ripoff_niv = 0;
static int ripoff_callback(WINDOW* w, int l) {
  if (ripoff_niv == 5)
    return (0);
  ripoff_w[ripoff_niv] = w;
  ripoff_l[ripoff_niv] = l;
  ripoff_niv++;
  return (0);
}

value putc_function;
static int putc_callback(int c) {
  CAMLparam0();
  CAMLlocal1(ret);

  AWB(ret);
  ret = caml_callback_exn(putc_function, Val_int(c & 255));
  CAMLreturn(Is_exception_result(ret) ? -1 : 0);
}

#ifndef WIN32
/* Du travail pour les esclaves de M$ */
static void winch_handler(int n) {
  signal(n, winch_handler);
  ungetch(KEY_RESIZE);
}
#endif

#include "caml/signals.h"
#include "functions.c"

/* The following routines are special-cased to allow other threads to run
 * while getch() is blocking */
value mlcurses_getch(void) {
  CAMLparam0();
  int ch;

  caml_enter_blocking_section();
  ch = getch();
  caml_leave_blocking_section();

  CAMLreturn(Val_int(ch));
}

value mlcurses_wgetch(value win) {
  CAMLparam1(win);
  int ch;
  WINDOW* w;

  caml__dummy_win = caml__dummy_win;
  w = Window_val(win);

  caml_enter_blocking_section();
  ch = wgetch(w);
  caml_leave_blocking_section();

  CAMLreturn(Val_int(ch));
}

value mlcurses_getnstr_inner(value n) {
  CAMLparam1(n);
  int max_length = Int_val(n);
  char* v = (char*)malloc(sizeof(char) * (max_length + 1));

  caml_enter_blocking_section();
  value err = getnstr(v, max_length);
  caml_leave_blocking_section();

  value str = caml_copy_string(!err ? v : "\0");
  free(v);

  CAMLlocal1(ret);
  ret = caml_alloc_tuple(2);
  Store_field(ret, 0, str);
  Store_field(ret, 1, Val_bool(err != ERR));
  CAMLreturn(ret);
}

static int locale_categories[] = {LC_CTYPE,    LC_NUMERIC,  LC_TIME, LC_COLLATE,
                                  LC_MONETARY, LC_MESSAGES, LC_ALL};
#define NUM_LOCALE_CATEGORIES \
  (sizeof(locale_categories) / sizeof(locale_categories[0]))

value mlcurses_setlocale(value cat, value loc) {
  CAMLparam2(cat, loc);
  int idx;
  const char* result;

  idx = Int_val(cat);
  if (idx < 0 || idx >= (int)NUM_LOCALE_CATEGORIES)
    caml_invalid_argument("setlocale: invalid category");

  result = setlocale(locale_categories[idx], String_val(loc));
  if (result == NULL)
    CAMLreturn(Val_none);
  else
    CAMLreturn(caml_alloc_some(caml_copy_string(result)));
}
