/*
 * © Copyright 1996-2012 ECMWF.
 *
 * This software is licensed under the terms of the Apache Licence Version 2.0
 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
 * In applying this licence, ECMWF does not waive the privileges and immunities
 * granted to it by virtue of its status as an intergovernmental organisation nor
 * does it submit to any jurisdiction.
 */

#include "mars.h"

/*=====================================

 Mars to external routines communication

=====================================*/

#ifdef FORTRAN_UPPERCASE
#define marscnt_ MARSCNT
#define marsarg_ MARSARG
#define marsret_ MARSRET
#define marsend_ MARSEND
#define marsout_ MARSOUT
#define gribnew_ GRIBNEW
#define gribcnt_ GRIBCNT
#define gribcopy_ GRIBCOPY
#define gribdata_ GRIBDATA
#define gribfile_ GRIBFILE
#define gribfree_ GRIBFREE
#define gribnext_ GRIBNEXT
#define gribsave_ GRIBSAVE
#define mfail_ MFAIL
#define mgetb_ MGETB
#define mgetb_ MGETB
#define mgetg_ MGETG
#define mgeti_ MGETI
#define mgetm_ MGETM
#define mgetn2_ MGETN2
#define mgetn_ MGETN
#define mgets_ MGETS
#define msetb_ MSETB
#define msetg_ MSETG
#define mseti_ MSETI
#define msetm_ MSETM
#define msetn2_ MSETN2
#define msetn_ MSETN
#define msets_ MSETS
#define mloadb_ MLOADB
#define mloadg_ MLOADG
#define mnewb_ MNEWB
#define mnewg_ MNEWG
#endif


typedef struct gribarg {
    FILE* f;
    fieldset* v;
    int cnt;
    char* file;
} gribarg;

typedef struct bufrarg {
    FILE* f;
    char* file;
} bufrarg;

typedef struct arg {
    char kind;
    union {
        double dval;
        char* sval;
        request* rval;
    } u;
} arg;


static int argc      = 0;
static int argn      = 0;
static arg* args     = NULL;
static boolean first = true;
static char* name    = NULL;
static char* file    = NULL;

static void mout(int lvl, char* msg) {
}

static void the_end(int code, void* data) {
    printf("end is %d\n", code);
}

static void minit(void) {
    int ac;
    char* av;
    request *r, *s;
    int i;

    if (!first)
        return;

    first = false;

    file = getenv("MREQUEST");
    name = getenv("MNAME");

    ac = 1;
    av = strcache(name ? name : "external");

    marsinit(&ac, &av, 0, 0, 0);

    if (!file)
        marslog(LOG_EXIT, "Mars/Metview external environment not set");

    /* mars.outproc = mout; */
    mars.logrequest = true; /* log the request */

    s = r = read_request_file(file);
    while (s) {
        s = s->next;
        argc++;
    }

    mars.logrequest = false;

    /* empty file */
    fclose(fopen(file, "w"));

    if (argc == 0)
        return;

    args = NEW_ARRAY(arg, argc);
    i    = 0;

    while (r) {
        const char* t = r->name;
        const char* v = get_value(r, "VALUE", 0);

        if (t == NULL)
            marslog(LOG_EXIT, "No data type");
        else if (EQ(t, "NUMBER")) {
            args[i].kind   = 'N';
            args[i].u.dval = v ? atof(v) : 0.0;
        }
        else if (EQ(t, "STRING")) {
            args[i].kind   = 'S';
            args[i].u.sval = strcache(v ? v : "");
        }
        else if (EQ(t, "GRIB")) {
            args[i].kind   = 'G';
            args[i].u.rval = r;
        }
        else if (EQ(t, "BUFR")) {
            args[i].kind   = 'B';
            args[i].u.rval = r;
        }
        else if (EQ(t, "IMAGE")) {
            args[i].kind   = 'I';
            args[i].u.rval = r;
        }
        else
            marslog(LOG_EXIT, "Unsupported type %s", t);

        r = r->next;
        i++;
    }

    /* install_exit_proc(the_end,NULL); */
}

static void mcheck(long* n, char kind, char* name) {
    minit();

    if (*n == 0)
        *n = argn + 1;

    if (*n < 1 || *n > argc)
        marslog(LOG_EXIT,
                "Parameter %d is is out of range."
                " Only %d parameters where passed",
                *n, argc);
    if (args[*n - 1].kind != kind)
        marslog(LOG_EXIT, "Parameter %d is not of type %s", *n, name);

    argn = *n;
}

static void getn(long n, double* d) {
    mcheck(&n, 'N', "number");
    *d = args[n - 1].u.dval;
}

void mgetn_(fortfloat* f) {
    double d;
    getn(0, &d);
    *f = d;
}

void mgetn2_(double* d) {
    getn(0, d);
}

void mgets_(char* s, long l_s) {
    long n = 0;
    char* p;
    mcheck(&n, 'S', "string");
    p = args[n - 1].u.sval;
    n = strlen(p);
    memset(s, 0, l_s);

    if (n > l_s) {
        marslog(LOG_WARN, "MGETS, string to small %d>%d",
                n, l_s);
        n = l_s;
    }

    strncpy(s, p, n);
}


static fieldset* getg(long n) {
    mcheck(&n, 'G', "fieldset");
    return request_to_fieldset(args[n - 1].u.rval);
}


void mgetg_(long* g, long* c) {
    fieldset* v = getg(0);
    gribarg* a  = NEW_CLEAR(gribarg);
    if (!v)
        marslog(LOG_EXIT, "MGETG, Cannot load grib file");
    *c   = v->count;
    a->v = v;
    *g   = (long)a;
}

static fieldset* geti(long n) {
    mcheck(&n, 'I', "image");
    return request_to_fieldset(args[n - 1].u.rval);
}


void mfail_(char* msg, long l_msg);

void mnewb_() {
    mfail_("MNEWB is not yet implemeted", 0);
}
void mgetb_() {
    mfail_("MGETB is not yet implemeted", 0);
}
void msetb_() {
    mfail_("MSETB is not yet implemeted", 0);
}
void mloadb_() {
    mfail_("MLOADB is not yet implemeted", 0);
}
void msaveb_() {
    mfail_("MSAVEB is not yet implemeted", 0);
}
void mgetm_() {
    mfail_("MGETM is not yet implemeted", 0);
}
void msetm_() {
    mfail_("MSETM is not yet implemeted", 0);
}

void mgeti_(long* g, long* c) {
    fieldset* v = geti(0);
    gribarg* a  = NEW_CLEAR(gribarg);
    if (!v)
        marslog(LOG_EXIT, "MGETI, Cannot load image file");
    *c   = v->count;
    a->v = v;
    *g   = (long)a;
}

void mloadg_(long* g, char* p, long* c) {
    gribarg* a  = (gribarg*)(*g);
    fieldset* v = a->v;

    int i = a->cnt++;

    minit();

    if (i < 0 || i >= v->count)
        marslog(LOG_EXIT, "MGRIB, No more fields");


    if ((*c) * sizeof(fortint) < v->fields[i]->length)
        marslog(LOG_EXIT, "MGRIB, Buffer to small %d words (should be %d words)",
                *c, (v->fields[i]->length + (sizeof(fortint) - 1)) / sizeof(fortint));

    if (a->f == NULL || a->file != v->fields[i]->file->fname) {
        if (a->f)
            fclose(a->f);
        strfree(a->file);
        a->file = strcache(v->fields[i]->file->fname);
        a->f    = fopen(a->file, "r");
        if (a->f == NULL)
            marslog(LOG_EXIT | LOG_PERR, "MGRIB, cannot open %s", a->file);
    }

    if (fseek(a->f, v->fields[i]->offset, 0) < 0)
        marslog(LOG_EXIT | LOG_PERR, "MGRIB, cannot position to grib");

    if (_readany(a->f, p, &v->fields[i]->length))
        marslog(LOG_EXIT | LOG_PERR, "MGRIB, cannot read grib");
}

void mnewg_(long* g) {
    gribarg* a;
    minit();
    a  = NEW_CLEAR(gribarg);
    *g = (long)a;
}

void msaveg_(long* g, char* p, long* c) {
    gribarg* a = (gribarg*)(*g);
    int j, length, pad;
    char x;
    minit();

    if (a->f == NULL) {
        a->file = strcache(marstmp());
        a->f    = fopen(a->file, "w");
        if (a->f == NULL)
            marslog(LOG_EXIT | LOG_PERR, "MGRIB, cannot open %s", a->file);
    }

    length = (*c) * sizeof(fortint);
    pad    = ((length + 119) / 120) * 120 - length;

    if (fwrite(p, 1, length, a->f) != length)
        marslog(LOG_EXIT | LOG_PERR, "Error while writing to disk");

    x = 0;
    for (j = 0; j < pad; j++)
        if (fwrite(&x, 1, 1, a->f) != 1)
            marslog(LOG_EXIT | LOG_PERR, "Error while writing to disk");
}

void msetg_(long* g) {
    gribarg* a = (gribarg*)(*g);
    FILE* f;

    minit();

    if (a->f)
        fclose(a->f);
    a->f = NULL;

    f = fopen(file, "a+");
    fprintf(f, "GRIB,TEMPORARY=1,PATH='%s'\n",
            a->file);
    fclose(f);
}

void mseti_(long* g) {
    gribarg* a = (gribarg*)(*g);
    FILE* f;

    minit();

    if (a->f)
        fclose(a->f);
    a->f = NULL;

    f = fopen(file, "a+");
    fprintf(f, "IMAGE,TEMPORARY=1,PATH='%s'\n",
            a->file);
    fclose(f);
}

void msets_(char* s, long l_s) {
    FILE* f;
    int space = 0;
    minit();
    f = fopen(file, "a+");
    fprintf(f, "STRING,VALUE=\"");

    space = 0;

    while (*s && l_s--) {
        if (*s == '"' || *s == '\\')
            fputc('\\', f);
        if (*s == ' ')
            space++;
        else {
            while (space-- > 0)
                fputc(' ', f);
            fputc(*s, f);
        }
        s++;
    }
    fprintf(f, "\"\n");
    fclose(f);
}

void msetn2_(double* d) {
    FILE* f;
    minit();
    f = fopen(file, "a+");
    fprintf(f, "NUMBER,VALUE=%g\n", *d);
    fclose(f);
}

void msetn_(fortfloat* f) {
    double d = *f;
    msetn2_(&d);
}

void mfail_(char* msg, long l_msg) {
    minit();
    marslog(LOG_EXIT, "%s", msg);
}

void margs_(long* cnt, char* types, long l_types) {
    int i, n;

    minit();
    *cnt = argc;

    memset(types, 0, l_types);
    n = argc;

    if (n > l_types) {
        marslog(LOG_WARN, "MARGS, string to small %d>%d",
                n, l_types);
        n = l_types;
    }

    for (i = 0; i < n; i++)
        types[i] = args[i].kind;
}


/* Versions with no underscore */
void mgetn(fortfloat* f) {
    mgetn_(f);
}
void mgetn2(double* d) {
    mgetn2_(d);
}
void mgets(char* s, long l_s) {
    mgets_(s, l_s);
}
void mgetg(long* g, long* c) {
    mgetg_(g, c);
}
void mnewb(void) {
    mnewb_();
}
void mgetb(void) {
    mgetb_();
}
void msetb(void) {
    msetb_();
}
void mloadb(void) {
    mloadb_();
}
void msaveb(void) {
    msaveb_();
}
void mgetm(void) {
    mgetm_();
}
void msetm(void) {
    msetm_();
}
void mgeti(long* g, long* c) {
    mgeti_(g, c);
}
void mloadg(long* g, char* p, long* c) {
    mloadg_(g, p, c);
}
void mnewg(long* g) {
    mnewg_(g);
}
void msaveg(long* g, char* p, long* c) {
    msaveg_(g, p, c);
}
void msetg(long* g) {
    msetg_(g);
}
void mseti(long* g) {
    mseti_(g);
}
void msets(char* s, long l_s) {
    msets_(s, l_s);
}
void msetn2(double* d) {
    msetn2_(d);
}
void msetn(fortfloat* f) {
    msetn_(f);
}
void mfail(char* msg, long l_msg) {
    mfail_(msg, l_msg);
}
void margs(long* cnt, char* types, long l_types) {
    margs_(cnt, types, l_types);
}
