/**************************************************************************
 *{@C
 *      Copyright:      1988-2023 Paul Obermeier (obermeier@poSoft.de)
 *
 *      Module:         ImageProcessing
 *      Filename:       IPT_TclIfWarp.c
 *
 *      Author:         Paul Obermeier
 *
 *      Description:    The interface between the image
 *                      library and the Tcl interpreter.
 *                      This file contains warp and blend related functions.
 *
 *      Additional documentation:
 *                      None.
 *
 *      Exported functions:
 *
 **************************************************************************/

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

#include "UT_Compat.h"

#include "UT_Error.h"
#include "UT_Memory.h"
#include "FF_Image.h"
#include "IP_Image.h"

#include <tcl.h>
#include "UTT_TclIf.h"
#include "IPT_TclIf.h"
#include "IPT_ImagePrivate.h"


static UT_Bool recursive = UT_False;      /* Flag to detect recursion */

static char d1funct[Tmpsize],       /* First displacement function */
            d1deriv[Tmpsize],       /* Derivatives of "d1funct" */
            d2funct[Tmpsize],       /* Second displacement function */
            d2deriv[Tmpsize],       /* Derivatives of "d2funct" */
            bfunct[Tmpsize];        /* Pixel color mixing function */

static Tcl_Interp *myInterp;        /* Current Tcl interpreter */


/* Invoke Tcl function "funct", passing two Float32 parameters, "x" and "y"
   to "funct"; expect "funct" to return two Float32 numbers, "u" and "v". */

static UT_Bool call_funct_2_returns 
        (const char *funct, Float32 x, Float32 y,
         Float32 *u, Float32 *v)
{
    int listArgc, result;
    const char **listArgv;
    Tcl_DString command;
    char paramStr[100];

    Tcl_DStringInit (&command);
    Tcl_DStringAppend (&command, funct, -1);

    sprintf (paramStr, "%f", x);
    Tcl_DStringAppendElement (&command, paramStr);
    sprintf (paramStr, "%f", y);
    Tcl_DStringAppendElement (&command, paramStr);

    result = Tcl_Eval (myInterp, Tcl_DStringValue (&command));

    if (result != TCL_OK) {
        printf ("Could not eval \"%s\"\n", Tcl_DStringValue (&command));
        Tcl_DStringFree (&command);
        return UT_False;
    }

    Tcl_DStringFree (&command);
    if (Tcl_SplitList (myInterp, Tcl_GetStringResult (myInterp),
                       &listArgc, &listArgv) != TCL_OK) {
        return UT_False;
    }

    if (listArgc < 2) {
        printf ("List too small (%d)\n", listArgc);
        Tcl_Free ((char *) listArgv); /* Memory allocated by Tcl_SplitList */
        return UT_False;
    }
    *u = atof (listArgv[0]);
    *v = atof (listArgv[1]);
    
    Tcl_Free ((char *) listArgv); /* Memory allocated by Tcl_SplitList */
    return UT_True;
}

/* Invoke Tcl function "funct", passing two Float32 parameters, "x" and "y"
   to "funct"; expect "funct" to return four Float32 numbers, "ux, "uy", "vx"
   and "vy". */

static UT_Bool call_funct_4_returns
        (char *funct, Float32 x, Float32 y,
         Float32 *ux, Float32 *uy, Float32 *vx, Float32 *vy)
{
    int listArgc, result;
    const char **listArgv;
    Tcl_DString command;
    char paramStr[100];

    Tcl_DStringInit (&command);
    Tcl_DStringAppend (&command, funct, -1);

    sprintf (paramStr, "%f", x);
    Tcl_DStringAppendElement (&command, paramStr);
    sprintf (paramStr, "%f", y);
    Tcl_DStringAppendElement (&command, paramStr);

    result = Tcl_Eval (myInterp, Tcl_DStringValue (&command));

    if (result != TCL_OK) {
        printf ("Could not eval \"%s\"\n", Tcl_DStringValue (&command));
        Tcl_DStringFree (&command);
        return UT_False;
    }

    Tcl_DStringFree (&command);
    if (Tcl_SplitList (myInterp, Tcl_GetStringResult (myInterp),
                       &listArgc, &listArgv) != TCL_OK) {
        return UT_False;
    }
    if (listArgc < 4) {
        printf ("List too small (%d)\n", listArgc);
        Tcl_Free ((char *) listArgv); /* Memory allocated by Tcl_SplitList */
        return UT_False;
    }
    *ux = atof (listArgv[0]);
    *uy = atof (listArgv[1]);
    *vx = atof (listArgv[2]);
    *vy = atof (listArgv[3]);

    Tcl_Free ((char *) listArgv); /* Memory allocated by Tcl_SplitList */
    return UT_True;
}

/* Invoke Tcl function "funct", passing two Float32 parameters, "x" and "y"
   to "funct"; expect "funct" to return one Float32 number, "f". */

static UT_Bool call_funct_1_return
        (const char *funct, Float32 x, Float32 y, Float32 *f)
{
    int listArgc, result;
    const char **listArgv;
    Tcl_DString command;
    char paramStr[100];

    Tcl_DStringInit (&command);
    Tcl_DStringAppend (&command, funct, -1);

    sprintf (paramStr, "%f", x);
    Tcl_DStringAppendElement (&command, paramStr);
    sprintf (paramStr, "%f", y);
    Tcl_DStringAppendElement (&command, paramStr);

    result = Tcl_Eval (myInterp, Tcl_DStringValue (&command));

    if (result != TCL_OK) {
        printf ("Could not eval \"%s\"\n", Tcl_DStringValue (&command));
        Tcl_DStringFree (&command);
        return UT_False;
    }

    Tcl_DStringFree (&command);
    if (Tcl_SplitList (myInterp, Tcl_GetStringResult (myInterp),
                       &listArgc, &listArgv) != TCL_OK) {
        return UT_False;
    }

    if (listArgc < 1) {
        printf ("List too small (%d)\n", listArgc);
        Tcl_Free ((char *) listArgv); /* Memory allocated by Tcl_SplitList */
        return UT_False;
    }
    *f = atof (listArgv[0]);
    
    Tcl_Free ((char *) listArgv); /* Memory allocated by Tcl_SplitList */
    return UT_True;
}

/* Invoke the Tcl versions of "d1funct", "d1deriv", etc. */

static UT_Bool call_d1funct (Float32 x, Float32 y, Float32 *u, Float32 *v)
{
    return call_funct_2_returns (d1funct, x, y, u, v);
}

static UT_Bool call_d1deriv
        (Float32 x, Float32 y, Float32 *ux, Float32 *uy, Float32 *vx, Float32 *vy)
{
    return call_funct_4_returns (d1deriv, x, y, ux, uy, vx, vy);
}

static UT_Bool call_d2funct (Float32 x, Float32 y, Float32 *u, Float32 *v)
{
    return call_funct_2_returns (d2funct, x, y, u, v);
}

static UT_Bool call_d2deriv
        (Float32 x, Float32 y, Float32 *ux, Float32 *uy, Float32 *vx, Float32 *vy)
{
    return call_funct_4_returns (d2deriv, x, y, ux, uy, vx, vy);
}

static UT_Bool call_bfunct (Float32 x, Float32 y, Float32 *f)
{
    return call_funct_1_return (bfunct, x, y, f);
}


UT_Bool IPT_WarpFunct (ELEMPARAMLIST)
{
    IP_ImageId  img = (IP_ImageId) clientData;
    IP_ImageId  srcimg;
    Int32       istep, oor;
    UT_Bool     success;

    /* Check for recursive invocation of IPT_WarpFunct or CIP_blend. */

    if (recursive) {
        UT_ErrSetNum (UT_ErrNotSupported, str_warp_recursion);
        return UT_False;
    }

    /* Get hold of the parameters passed by the Tcl interpreter. */

    IPT_Get_Fix_Image (1, srcimg);
    UTT_GetFixFunct   (2, d1funct, Tmpsize);
    UTT_GetFixFunct   (3, d1deriv, Tmpsize);
    UTT_GetFixInt32   (4, istep);
    UTT_GetOptInt32   (5, oor, IP_FillModeFill);

    /* Run the image warping algorithm. */

    recursive = UT_True;
    myInterp = interp;
    success = IP_WarpFunct (srcimg, img, call_d1funct, call_d1deriv, istep, oor);
    recursive = UT_False;
    return success;
}

UT_Bool IPT_BlendFunct (ELEMPARAMLIST)
{
    IP_ImageId  img = (IP_ImageId) clientData;
    IP_ImageId  srcimg1, srcimg2;
    Int32       istep, oor;
    UT_Bool     success;

    /* Check for recursive invocation of IPT_WarpFunct or IPT_BlendFunct. */

    if (recursive) {
        UT_ErrSetNum (UT_ErrNotSupported, str_warp_recursion);
        return UT_False;
    }

    /* Get hold of the parameters passed by the Tcl interpreter. */

    IPT_Get_Fix_Image (1, srcimg1);
    IPT_Get_Fix_Image (2, srcimg2);
    UTT_GetFixFunct   (3, d1funct, Tmpsize);
    UTT_GetFixFunct   (4, d1deriv, Tmpsize);
    UTT_GetFixFunct   (5, d2funct, Tmpsize);
    UTT_GetFixFunct   (6, d2deriv, Tmpsize);
    UTT_GetFixFunct   (7, bfunct,  Tmpsize);
    UTT_GetFixInt32   (8, istep);
    UTT_GetOptInt32   (9, oor, IP_FillModeFill);

    /* Run the image warping algorithm. */

    recursive = UT_True;
    myInterp = interp;
    success = IP_BlendFunct (srcimg1, srcimg2, img, call_d1funct, call_d1deriv,
                             call_d2funct, call_d2deriv, call_bfunct, istep, oor);
    recursive = UT_False;
    return success;
}

UT_Bool IPT_WarpKeypoint (ELEMPARAMLIST)
{
    IP_ImageId  img = (IP_ImageId) clientData;
    IP_ImageId  srcimg;
    UT_Bool     retVal;
    Int32       nkey, istep, 
                nxsrc, nysrc, nxdest, nydest,
                oor;
    double      r;
    Float32     *xsrc, *ysrc, *xdest, *ydest;

    IPT_Get_Fix_Image     (1, srcimg);
    UTT_GetFixInt32       (2, nkey);
    UTT_GetFixFloat32List (3, xsrc,  nxsrc,  nkey);
    UTT_GetFixFloat32List (4, ysrc,  nysrc,  nkey);
    UTT_GetFixFloat32List (5, xdest, nxdest, nkey);
    UTT_GetFixFloat32List (6, ydest, nydest, nkey);
    UTT_GetFixInt32       (7, istep);
    UTT_GetOptFloat64     (8, r, 0.0);
    UTT_GetOptInt32       (9, oor, IP_FillModeFill);
    retVal = IP_WarpKeypoint
        (srcimg, img, nkey, xsrc, ysrc, xdest, ydest, istep, r, oor);
    UT_MemFree (xsrc);
    UT_MemFree (ysrc);
    UT_MemFree (xdest);
    UT_MemFree (ydest);
    return retVal;
}

UT_Bool IPT_BlendKeypoint (ELEMPARAMLIST)
{
    IP_ImageId  img = (IP_ImageId) clientData;
    IP_ImageId  srcimg1, srcimg2;
    UT_Bool     retVal;
    Int32               nkey, istep, 
                nxsrc1, nysrc1, nxsrc2, nysrc2, nz, oor;
    double      r; 
    Float32     *xsrc1, *ysrc1, *xsrc2, *ysrc2, *z;

    IPT_Get_Fix_Image     (1, srcimg1);
    IPT_Get_Fix_Image     (2, srcimg2);
    UTT_GetFixInt32       (3, nkey);
    UTT_GetFixFloat32List (4, xsrc1, nxsrc1, nkey);
    UTT_GetFixFloat32List (5, ysrc1, nysrc1, nkey);
    UTT_GetFixFloat32List (6, xsrc2, nxsrc2, nkey);
    UTT_GetFixFloat32List (7, ysrc2, nysrc2, nkey);
    UTT_GetFixFloat32List (8, z,     nz,     nkey);
    UTT_GetFixInt32       (9, istep);
    UTT_GetOptFloat64    (10, r,   0.0);
    UTT_GetOptInt32      (11, oor, IP_FillModeFill);
    retVal = IP_BlendKeypoint
             (srcimg1, srcimg2, img, nkey,
              xsrc1, ysrc1, xsrc2, ysrc2, z, istep, r, oor);
    UT_MemFree (xsrc1);
    UT_MemFree (ysrc1);
    UT_MemFree (xsrc2);
    UT_MemFree (ysrc2);
    UT_MemFree (z);
    return retVal;
}
