/**************************************************************************
 *{@C
 *      Copyright:      1988-2023 Paul Obermeier (obermeier@poSoft.de)
 *
 *      Module:         Utilities
 *      Filename:       UTT_TclIf.c
 *
 *      Author:         Paul Obermeier
 *
 *      Description:    The interface between the basic utility
 *                      library functions and the Tcl interpreter.
 *
 *      Exported functions:
 *
 **************************************************************************/

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>

#include "UT_Compat.h"

#include "UT_Const.h"
#include "UT_Macros.h"
#include "UT_Error.h"
#include "UT_Memory.h"
#include "UT_Crypt.h"

#include <tcl.h>

#include "UTT_TclIf.h"

#define MAX_LIST_SIZE 10000 /* TODO: Use Tcl's dynamic strings instead */

/* CAUTION: These functions return TCL_OKs. */

UT_Bool UTT_MemCheck (TCLPARAMLIST)
{
    if (!UT_MemCheck ()) {
        printf ("UT_MemCheck failed\n"); fflush (stdout);
        UT_ErrFatal ("UTT_MemCheck", "UT_MemCheck failed");
    } else {
        /* printf ("UT_MemCheck OK\n"); fflush (stdout); */
    }
    return TCL_OK;
}

UT_Bool UTT_EvalFile (Tcl_Interp *interp, const char *fname)
{
    if (Tcl_EvalFile (interp, (char *)fname) == TCL_OK)
        return UT_True;
    return UT_False;
}

const char *UTT_GetResult (Tcl_Interp *interp)
{
    return Tcl_GetStringResult (interp);
}

int UTT_GetInt32List (Tcl_Interp *interp, char *varName, Int32 **var, Int32 *nel, Int32 minlen)
{
    int i, listArgc;
    Int32 *ptr;
    const char **listArgv;

    if (Tcl_SplitList (interp, varName, &listArgc, &listArgv) != TCL_OK)
        return TCL_ERROR;

    #if defined (DEBUG_LOCAL)
        if (listArgc < minlen) {
            printf ("List too small. Only %d elements\n", listArgc);
            fflush (stdout);
        }
    #endif

    *nel = listArgc;

    if (!(ptr = UT_MemTempArray (UT_MAX(listArgc, minlen), Int32)))
        return TCL_ERROR;

    for (i=0; i<UT_MAX(listArgc, minlen); i++) {
        if (i < listArgc) {
            ptr[i] = atoi (listArgv[i]);
            #if defined (DEBUG_LOCAL)
                printf ("List element %d: %s\n", i, listArgv[i]); 
                fflush (stdout);
            #endif
        }
        else
            ptr[i] = 0;
    }

    *var = ptr;
    /* Free memory allocated by Tcl_SplitList */
    Tcl_Free ((char *) listArgv);
    return TCL_OK;
}

int UTT_SetInt32List (Tcl_Interp *interp, char *varName, Int32 *val, Int32 len)
{
    Int32 i;
    char valStr[50], list[MAX_LIST_SIZE]; /* >>> Use Tcl's dynamic strings */

    list[0] = '\0';
    for (i=0; i<len; i++)
    {
        sprintf (valStr, "{%d} ", val[i]);
        if (strlen (list) + strlen (valStr) >= MAX_LIST_SIZE) {
            printf ("List would get to big !!! \n");
            break;
        }
        strcat (list, valStr);
    }
    if (!Tcl_SetVar (interp, varName, list, TCL_LEAVE_ERR_MSG))
        return TCL_ERROR;
    return TCL_OK;
}

int UTT_SetFloat32List (Tcl_Interp *interp, char *varName, Float32 *val, Int32 len)
{
    Int32 i;
    char valStr[50], list[MAX_LIST_SIZE]; /* >>> Use Tcl's dynamic strings */

    list[0] = '\0';
    for (i=0; i<len; i++) {
        sprintf (valStr, "{%.9g} ", val[i]);
        if (strlen (list) + strlen (valStr) >= MAX_LIST_SIZE) {
            printf ("List would get to big !!! \n");
            break;
        }
        strcat (list, valStr);
    }
    if (!Tcl_SetVar (interp, varName, list, TCL_LEAVE_ERR_MSG))
        return TCL_ERROR;
    return TCL_OK;
}

int UTT_SetFloat64List (Tcl_Interp *interp, char *varName, Float64 *val, Int32 len)
{
    Int32 i;
    char valStr[50], list[MAX_LIST_SIZE]; /* >>> Use Tcl's dynamic strings */

    list[0] = '\0';
    for (i=0; i<len; i++) {
        sprintf (valStr, "{%.20g} ", val[i]);
        if (strlen (list) + strlen (valStr) >= MAX_LIST_SIZE) {
            printf ("List would get to big !!! \n");
            break;
        }
        strcat (list, valStr);
    }
    if (!Tcl_SetVar (interp, varName, list, TCL_LEAVE_ERR_MSG))
        return TCL_ERROR;
    return TCL_OK;
}

int UTT_GetFloat32List (Tcl_Interp *interp, char *varName,
                        Float32 **var, Int32 *nel, Int32 minlen)
{
    int i, listArgc;
    const char **listArgv;
    Float32 *ptr;

    if (Tcl_SplitList (interp, varName, &listArgc, &listArgv) != TCL_OK) {
        return TCL_ERROR;
    }

    #if defined (DEBUG_LOCAL)
        if (listArgc < minlen) {
            printf ("List too small. Only %d elements.", listArgc);
            fflush (stdout);
        }
    #endif

    *nel = listArgc;

    if (!(ptr = UT_MemTempArray (UT_MAX(listArgc, minlen), Float32))) {
        return TCL_ERROR;
    }

    for (i=0; i<UT_MAX (listArgc, minlen); i++) {
        if (i < listArgc) {
            ptr[i] = (Float32)atof (listArgv[i]);
            #if defined (DEBUG_LOCAL)
                printf ("List element %d: %s (%f)\n", i, listArgv[i], ptr[i]);
                fflush (stdout);
            #endif
        } else {
            ptr[i] = 0.0f;
        }
    }
    *var = ptr;
    /* Free memory allocated by Tcl_SplitList */
    Tcl_Free ((char *) listArgv); 
    return TCL_OK;
}

int UTT_GetFloat64List (Tcl_Interp *interp, char *varName,
                        Float64 **var, Int32 *nel, Int32 minlen)
{
    int i, listArgc;
    const char **listArgv;
    Float64 *ptr;

    if (Tcl_SplitList (interp, varName, &listArgc, &listArgv) != TCL_OK) {
        return TCL_ERROR;
    }

    #if defined (DEBUG_LOCAL)
        if (listArgc < minlen) {
            printf ("List too small. Only %d elements.", listArgc);
            fflush (stdout);
        }
    #endif

    *nel = listArgc;

    if (!(ptr = UT_MemTempArray (UT_MAX(listArgc, minlen), Float64))) {
        return TCL_ERROR;
    }

    for (i=0; i<UT_MAX (listArgc, minlen); i++) {
        if (i < listArgc) {
            ptr[i] = atof (listArgv[i]);
            #if defined (DEBUG_LOCAL)
                printf ("List element %d: %s (%f)\n", i, listArgv[i], ptr[i]);
                fflush (stdout);
            #endif
        } else {
            ptr[i] = 0.0;
        }
    }
    *var = ptr;
    /* Free memory allocated by Tcl_SplitList */
    Tcl_Free ((char *) listArgv);
    return TCL_OK;
}

int UTT_SetInt32 (Tcl_Interp *interp, char *varName, int value)
{
    char valStr[50];
    sprintf (valStr, "%d", value);
    if (!Tcl_SetVar (interp, varName, valStr, TCL_LEAVE_ERR_MSG))
        return TCL_ERROR;
    return TCL_OK;
}

int UTT_GetBool (Tcl_Interp *interp, CONST86 char *varName, UT_Bool *value)
{
    int retVal;
    int tmpVal;

    retVal = Tcl_GetBoolean (interp, varName, &tmpVal);
    *value = (UT_Bool) tmpVal;
    return retVal;
}

int UTT_GetInt8 (Tcl_Interp *interp, CONST86 char *varName, Int8 *value)
{
    int retVal;
    int tmpVal;

    retVal = Tcl_GetInt (interp, varName, &tmpVal);
    *value = (Int8) tmpVal;
    return retVal;
}

int UTT_GetUInt8 (Tcl_Interp *interp, CONST86 char *varName, UInt8 *value)
{
    int retVal;
    int tmpVal;

    retVal = Tcl_GetInt (interp, varName, &tmpVal);
    *value = (UInt8) tmpVal;
    return retVal;
}

int UTT_GetInt16 (Tcl_Interp *interp, CONST86 char *varName, Int16 *value)
{
    int retVal;
    int tmpVal;

    retVal = Tcl_GetInt (interp, varName, &tmpVal);
    *value = (Int16) tmpVal;
    return retVal;
}

int UTT_GetUInt16 (Tcl_Interp *interp, CONST86 char *varName, UInt16 *value)
{
    int retVal;
    int tmpVal;

    retVal = Tcl_GetInt (interp, varName, &tmpVal);
    *value = (UInt16) tmpVal;
    return retVal;
}

int UTT_GetUInt32 (Tcl_Interp *interp, CONST86 char *varName, UInt32 *value)
{
    int retVal;
    int tmpVal;

    retVal = Tcl_GetInt (interp, varName, &tmpVal);
    *value = (UInt32) tmpVal;
    return retVal;
}

int UTT_GetFloat32 (Tcl_Interp *interp, CONST86 char *varName, Float32 *value)
{
    int retVal;
    Float64 tmpVal;

    retVal = Tcl_GetDouble (interp, varName, &tmpVal);
    *value = (Float32) tmpVal;
    return retVal;
}

int UTT_GetFloat64 (Tcl_Interp *interp, CONST86 char *varName, Float64 *value)
{
    return Tcl_GetDouble (interp, varName, value);
}

int UTT_SetBool (Tcl_Interp *interp, char *varName, UT_Bool value)
{
    char valStr[50];
    sprintf (valStr, "%d", value);
    if (!Tcl_SetVar (interp, varName, valStr, TCL_LEAVE_ERR_MSG)) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

int UTT_SetFloat32 (Tcl_Interp *interp, char *varName, Float32 value)
{
    char valStr[100];
    sprintf (valStr, "%.9g", value);
    if (!Tcl_SetVar (interp, varName, valStr, TCL_LEAVE_ERR_MSG)) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

int UTT_SetFloat64 (Tcl_Interp *interp, char *varName, Float64 value)
{
    char valStr[100];
    sprintf (valStr, "%.20g", value);
    if (!Tcl_SetVar (interp, varName, valStr, TCL_LEAVE_ERR_MSG)) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

int UTT_SetString (Tcl_Interp *interp, char *varName, char *value)
{
    if (!Tcl_SetVar (interp, varName, value, TCL_LEAVE_ERR_MSG))
        return TCL_ERROR;
    return TCL_OK;
}

int UTT_SetInt32Result (Tcl_Interp *interp, int value)
{
    char valStr[50];
    sprintf (valStr, "%d", value);
    Tcl_SetResult (interp, valStr, TCL_VOLATILE);
    return TCL_OK;
}

int UTT_SetFloat32Result (Tcl_Interp *interp, Float32 value)
{
    char valStr[50];
    sprintf (valStr, "%.9g", value);
    Tcl_SetResult (interp, valStr, TCL_VOLATILE);
    return TCL_OK;
}

int UTT_SetFloat64Result (Tcl_Interp *interp, Float64 value)
{
    char valStr[50];
    sprintf (valStr, "%.20g", value);
    Tcl_SetResult (interp, valStr, TCL_VOLATILE);
    return TCL_OK;
}

int UTT_SetStringResult (Tcl_Interp *interp, char *value)
{
    Tcl_SetResult (interp, value, TCL_VOLATILE);
    return TCL_OK;
}
