/* ========================================================================== */
/*                                                                            */
/*   xTcl_util.c -   Auxiliary general-purpose Tcl functions                  */
/*                                                                            */
/* ========================================================================== */

/* See https://en.cppreference.com/w/c/experimental/dynamic/strdup */
#define __STDC_WANT_LIB_EXT2__ 1

#include <string.h>   // strdup
#include <tcl.h>
#include "xTcl_util.h"


void xTcl_PrependObjResult( Tcl_Interp* interp, Tcl_Obj* headObj) {
	Tcl_Obj* savedResult = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(savedResult);
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, Tcl_GetString(headObj), Tcl_GetString(savedResult), NULL);
	Tcl_DecrRefCount(savedResult);
}


	// return a NEW string (must be deallocated (free()) by the caller)
	//
	// NOTE: use Tcl_FSGetNormalizedPath for converting filename in a full-filename.
	// Tcl_FS.. works for all platforms.
char* const xTcl_FSGetNormalizedPath( const char* filename ) {

	Tcl_Obj *srcPathPtr = Tcl_NewStringObj(filename,-1);
	Tcl_IncrRefCount(srcPathPtr);
	
	Tcl_Obj *normPathObj = Tcl_FSGetNormalizedPath(NULL, srcPathPtr);
	  // NOte that this works even if relative dirs/files don't exist !
	Tcl_IncrRefCount(normPathObj);
	
	char * const normalizedPath = strdup(Tcl_GetString(normPathObj));
	
	Tcl_DecrRefCount(normPathObj);
	Tcl_DecrRefCount(srcPathPtr);	
	return normalizedPath;
}


 // require Tcl8.6
Tcl_WideInt xTcl_GetModificationTime( Tcl_Interp* interp, const char* filename ) {
	
	Tcl_StatBuf* sbuf = Tcl_AllocStatBuf();
	if ( !sbuf ) return -1; // WTF !!!
	
	Tcl_Obj* pathObj = Tcl_NewStringObj(filename,-1);
	Tcl_IncrRefCount(pathObj);
	
	Tcl_WideInt modTime;
	if ( Tcl_FSStat( pathObj, sbuf ) == 0 ) {
		modTime = Tcl_GetModificationTimeFromStat(sbuf);
	} else {
		modTime = -1;
	}
	Tcl_DecrRefCount(pathObj);
	ckfree(sbuf);
	return modTime;
}



 // Fill array "v" with (at most) n elems from listObj.
 // Array "v" must be large enough to receive n elems
 // Return the number of elements ( or -1 on error)
 // On error, an error message is left in the interpreter's result.
int xTcl_FillArrayOfDoubleFromObj(Tcl_Interp* interp, Tcl_Obj* listObj, double v[], int n) {
	int i;
	Tcl_Size nElems;
	Tcl_Obj** elem = NULL;
	
	if (Tcl_ListObjGetElements(interp,listObj,&nElems,&elem) != TCL_OK) {
		return -1;
	}
	if (nElems>n) nElems=n;   //  extra elems won't be loaded ...
	for( i=0 ; i<nElems ; ++i ) {
		if (Tcl_GetDoubleFromObj(interp,elem[i],&(v[i])) != TCL_OK) {
			return -1;
		}
	}
	return (int)nElems;
}

int xTcl_FillArrayOfFloatFromObj(Tcl_Interp* interp, Tcl_Obj* listObj, float v[], int n) {
	int i;
	Tcl_Size nElems;
	Tcl_Obj** elem = NULL;
	
	if (Tcl_ListObjGetElements(interp,listObj,&nElems,&elem) != TCL_OK) {
		return -1;
	}
	if (nElems>n) nElems=n;    //  extra elems won't be loaded ...
	for( i=0 ; i<nElems ; ++i ) {
		double x;
		if (Tcl_GetDoubleFromObj(interp,elem[i],&x) != TCL_OK) {
			return -1;
		}
		v[i] = (float)x;
	}
	return (int)nElems;
}



  // just check if listObj contains expectedNelems values.
  // On error leave a message in interpreter's result.
  // return TCL_OK or TCL_ERROR
static
TclResCode checkListObjSize(Tcl_Interp* interp, Tcl_Obj* listObj, const char* type, int expectedNelems) {
	Tcl_Size nElems;
	
	if ( listObj == NULL || Tcl_ListObjLength(interp,listObj,&nElems) != TCL_OK) {
		xTcl_PrependObjResult(interp,Tcl_ObjPrintf("malformed %s: ",type));
		return TCL_ERROR;
	}
	if ((int)nElems != expectedNelems) {
		Tcl_SetObjResult(interp,Tcl_ObjPrintf("malformed %s: expected %d elements, got %d", type,expectedNelems,(int)nElems));
		return TCL_ERROR;    
	}
	return TCL_OK;
}


TclResCode xTcl_Get_N_Floats_FromObj( Tcl_Interp* interp, Tcl_Obj* listObj, int expectedNelems, float v[])  {
	const char* type = "sequence of floating point numbers";
	
	if (TCL_OK != checkListObjSize(interp, listObj, type, expectedNelems)) {
		// error message alread in the interpreter's result
		return TCL_ERROR;
	}
	
	if( xTcl_FillArrayOfFloatFromObj(interp,listObj,v,expectedNelems) < 0 ) {
		xTcl_PrependObjResult(interp,Tcl_ObjPrintf("malformed %s: ", type));
		return TCL_ERROR;
	}
	return TCL_OK;
}
