/*---------------------------------------------------------------------------
                  T C L E N V I R O N M E N T
                  
    This is the implementation file for the Tcl driver to a environment
    device. For more documentation see tclev.tex or the apropriate section
    in the reference manual. 
    
    copyright: see copyright.h
    
    Mark Koennecke, February 1998
    
-----------------------------------------------------------------------------*/
#include <tcl.h>
#include "sics.h"
#include "splitter.h"
#include "fortify.h"
#include "obpar.h"
#include "evcontroller.h"
#include "evcontroller.i"
#include "evdriver.i"
#include "tclev.h"
#include "tclev.i"
#define STUPIDTCL -1023
/*----------------------------------------------------------------------------
 The first section starts with the definition of the wrappers for all the driver
 functions.
-----------------------------------------------------------------------------*/
static int TclSetValue(pEVDriver self, float fNew)
{
  pTclEv pPriv = NULL;
  char pBueffel[1024];
  int iRet, iErrCode;

  pPriv = (pTclEv) self->pPrivate;
  assert(pPriv);

  /* build command line */
  snprintf(pBueffel,sizeof(pBueffel)-1, "%s %s %f", pPriv->pSetValue, pPriv->pArray, fNew);
  iRet = Tcl_Eval(pPriv->pTcl, pBueffel);
  if (iRet != TCL_OK) {
    strlcpy(pBueffel, pPriv->pTcl->result, 1023);
    iRet = Tcl_GetInt(pPriv->pTcl, pBueffel, &iErrCode);
    if (iRet != TCL_OK) {
      pPriv->iLastError = STUPIDTCL;
      return 0;
    }
    pPriv->iLastError = iErrCode;
    return 0;
  }
  return 1;
}

/*-------------------------------------------------------------------------*/
static int TclGetValue(pEVDriver self, float *fVal)
{
  pTclEv pPriv = NULL;
  char pBueffel[1024];
  int iRet, iErrCode;
  double d;

  pPriv = (pTclEv) self->pPrivate;
  assert(pPriv);

  /* build command line */
  snprintf(pBueffel,sizeof(pBueffel)-1, "%s %s", pPriv->pGetValue, pPriv->pArray);
  iRet = Tcl_Eval(pPriv->pTcl, pBueffel);
  if (iRet != TCL_OK) {
    strlcpy(pBueffel, pPriv->pTcl->result, 1023);
    iRet = Tcl_GetInt(pPriv->pTcl, pBueffel, &iErrCode);
    if (iRet != TCL_OK) {
      pPriv->iLastError = STUPIDTCL;
      return 0;
    }
    pPriv->iLastError = iErrCode;
    return 0;
  } else {
    if (strstr(pPriv->pTcl->result, "pending") != NULL) {
      *fVal = 90.;
      return -1;
    }
    iRet = Tcl_GetDouble(pPriv->pTcl, pPriv->pTcl->result, &d);
    if (iRet != TCL_OK) {
      pPriv->iLastError = STUPIDTCL;
      return 0;
    } else {
      *fVal = (float) d;
      return 1;
    }
  }
  return 1;
}

/*-------------------------------------------------------------------------*/
static int TclSend(pEVDriver self, char *pCommand,
                   char *pReply, int iReplyLen)
{
  pTclEv pPriv = NULL;
  char pBueffel[1024];
  int iRet, iErrCode;
  double d;

  pPriv = (pTclEv) self->pPrivate;
  assert(pPriv);

  /* build command line */
  snprintf(pBueffel,sizeof(pBueffel)-1, "%s %s %s", pPriv->pSend, pPriv->pArray, pCommand);
  iRet = Tcl_Eval(pPriv->pTcl, pBueffel);
  if (iRet != TCL_OK) {
    strlcpy(pBueffel, pPriv->pTcl->result, 1023);
    iRet = Tcl_GetInt(pPriv->pTcl, pBueffel, &iErrCode);
    if (iRet != TCL_OK) {
      pPriv->iLastError = STUPIDTCL;
      return 0;
    }
    pPriv->iLastError = iErrCode;
    return 0;
  } else {
    strlcpy(pReply, pPriv->pTcl->result, iReplyLen);
  }
  return 1;
}

/*--------------------------------------------------------------------------*/
static int TclGetError(pEVDriver self, int *iCode,
                       char *pReply, int iReplyLen)
{
  pTclEv pPriv = NULL;
  char pBueffel[1024];
  int iRet, iErrCode;
  double d;

  pPriv = (pTclEv) self->pPrivate;
  assert(pPriv);

  /* do the iCode first */
  *iCode = pPriv->iLastError;

  /* catch the stupid Tcl thing */
  if (pPriv->iLastError == STUPIDTCL) {
    snprintf(pBueffel,sizeof(pBueffel)-1,
            "Your Tcl-script returned a stupid answer:\n --> %s <--",
            pPriv->pTcl->result);
    strlcpy(pReply, pBueffel, iReplyLen);
    return 1;
  }

  /* build command line */
  snprintf(pBueffel,sizeof(pBueffel)-1, "%s %s %d", pPriv->pGetError, pPriv->pArray,
          pPriv->iLastError);
  iRet = Tcl_Eval(pPriv->pTcl, pBueffel);
  if (iRet != TCL_OK) {
    strlcpy(pBueffel, pPriv->pTcl->result, 1023);
    iRet = Tcl_GetInt(pPriv->pTcl, pPriv->pTcl->result, &iErrCode);
    if (iRet != TCL_OK) {
      pPriv->iLastError = STUPIDTCL;
      return 0;
    }
    pPriv->iLastError = iErrCode;
    return 0;
  } else {
    strlcpy(pReply, pPriv->pTcl->result, iReplyLen);
  }
  return 1;
}

/*--------------------------------------------------------------------------*/
static int TclTryFixIt(pEVDriver self, int iCode)
{
  pTclEv pPriv = NULL;
  char pBueffel[1024];
  int iRet, iErrCode;
  double d;

  pPriv = (pTclEv) self->pPrivate;
  assert(pPriv);


  /* catch the stupid Tcl thing */
  if (iCode == STUPIDTCL) {
    return DEVREDO;
  }

  /* build command line */
  snprintf(pBueffel,sizeof(pBueffel)-1, "%s %s %d", pPriv->pTryFixIt, pPriv->pArray, iCode);
  iRet = Tcl_Eval(pPriv->pTcl, pBueffel);
  if (iRet != TCL_OK) {
    return DEVFAULT;
  } else {
    if (strcmp(pPriv->pTcl->result, "DEVFAULT") == 0) {
      return DEVFAULT;
    } else if (strcmp(pPriv->pTcl->result, "DEVREDO") == 0) {
      return DEVREDO;
    } else if (strcmp(pPriv->pTcl->result, "DEVOK") == 0) {
      return DEVOK;
    } else {
      pPriv->iLastError = STUPIDTCL;
      return 0;
    }
  }
  return 1;
}

/*-------------------------------------------------------------------------*/
static int TclInit(pEVDriver self)
{
  pTclEv pPriv = NULL;
  char pBueffel[1024];
  int iRet, iErrCode;

  pPriv = (pTclEv) self->pPrivate;
  assert(pPriv);

  /* build command line */
  snprintf(pBueffel,sizeof(pBueffel)-1, "%s %s", pPriv->pInit, pPriv->pArray);
  iRet = Tcl_Eval(pPriv->pTcl, pBueffel);
  if (iRet != TCL_OK) {
    strlcpy(pBueffel, pPriv->pTcl->result, 1023);
    iRet = Tcl_GetInt(pPriv->pTcl, pBueffel, &iErrCode);
    if (iRet != TCL_OK) {
      pPriv->iLastError = STUPIDTCL;
      return 0;
    }
    pPriv->iLastError = iErrCode;
    return 0;
  }
  return 1;
}

/*--------------------------------------------------------------------------*/
static int TclClose(pEVDriver self)
{
  pTclEv pPriv = NULL;
  char pBueffel[1024];
  int iRet, iErrCode;

  pPriv = (pTclEv) self->pPrivate;
  assert(pPriv);

  /* build command line */
  snprintf(pBueffel,sizeof(pBueffel)-1, "%s %s", pPriv->pClose, pPriv->pArray);
  iRet = Tcl_Eval(pPriv->pTcl, pBueffel);
  if (iRet != TCL_OK) {
    strlcpy(pBueffel, pPriv->pTcl->result, 1023);
    iRet = Tcl_GetInt(pPriv->pTcl, pBueffel, &iErrCode);
    if (iRet != TCL_OK) {
      pPriv->iLastError = STUPIDTCL;
      return 0;
    }
    pPriv->iLastError = iErrCode;
    return 0;
  }
  return 1;
}

/*---------------------------------------------------------------------------*/
static void KillPrivate(void *pData)
{
  pTclEv pPriv = NULL;

  pPriv = (pTclEv) pData;
  assert(pPriv);

  if (pPriv->pArray) {
    free(pPriv->pArray);
  }
  if (pPriv->pInit) {
    free(pPriv->pInit);
  }
  if (pPriv->pClose) {
    free(pPriv->pClose);
  }
  if (pPriv->pSetValue) {
    free(pPriv->pSetValue);
  }
  if (pPriv->pGetValue) {
    free(pPriv->pGetValue);
  }
  if (pPriv->pSend) {
    free(pPriv->pSend);
  }
  if (pPriv->pGetError) {
    free(pPriv->pGetError);
  }
  if (pPriv->pTryFixIt) {
    free(pPriv->pTryFixIt);
  }
  if (pPriv->pWrapper) {
    free(pPriv->pWrapper);
  }
  if (pPriv->pName) {
    free(pPriv->pName);
  }
  free(pPriv);
}

/*-----------------------------------------------------------------------*/
pEVDriver CreateTclDriver(int argc, char *argv[], char *pName,
                          SConnection * pCon)
{
  pEVDriver pNew = NULL;
  pTclEv pPriv = NULL;
  int iRet;
  /* the "const" saves us from a couple of warnings M.Z. */
  const char *pPtr = NULL;

  if (argc < 1) {               /* we expect a Tcl array with all data */
    return NULL;
  }

  pPriv = (pTclEv) malloc(sizeof(TclEv));
  if (!pPriv) {
    return NULL;
  }
  memset(pPriv, 0, sizeof(TclEv));

  /* find the names of all the functions we need in the Tcl Array */
  pPriv->pTcl = InterpGetTcl(pServ->pSics);
  assert(pPriv->pTcl);
  pPriv->pArray = strdup(argv[0]);
  pPtr = Tcl_GetVar2(pPriv->pTcl, argv[0], "Init", TCL_GLOBAL_ONLY);
  if (!pPtr) {
    SCWrite(pCon, "ERROR: Init script not found", eError);
    KillPrivate(pPriv);
    return NULL;
  } else {
    pPriv->pInit = strdup(pPtr);
  }
  pPtr = NULL;
  pPtr = Tcl_GetVar2(pPriv->pTcl, argv[0], "Close", TCL_GLOBAL_ONLY);
  if (!pPtr) {
    SCWrite(pCon, "ERROR: Close script not found", eError);
    KillPrivate(pPriv);
    return NULL;
  } else {
    pPriv->pClose = strdup(pPtr);
  }
  pPtr = NULL;
  pPtr = Tcl_GetVar2(pPriv->pTcl, argv[0], "SetValue", TCL_GLOBAL_ONLY);
  if (!pPtr) {
    SCWrite(pCon, "ERROR: SetValue script not found", eError);
    KillPrivate(pPriv);
    return NULL;
  } else {
    pPriv->pSetValue = strdup(pPtr);
  }
  pPtr = NULL;
  pPtr = Tcl_GetVar2(pPriv->pTcl, argv[0], "GetValue", TCL_GLOBAL_ONLY);
  if (!pPtr) {
    SCWrite(pCon, "ERROR:  GetValue script not found", eError);
    KillPrivate(pPriv);
    return NULL;
  } else {
    pPriv->pGetValue = strdup(pPtr);
  }
  pPtr = Tcl_GetVar2(pPriv->pTcl, argv[0], "Send", TCL_GLOBAL_ONLY);
  if (!pPtr) {
    SCWrite(pCon, "ERROR: Send script not found", eError);
    KillPrivate(pPriv);
    return NULL;
  } else {
    pPriv->pSend = strdup(pPtr);
  }
  pPtr = NULL;
  pPtr = Tcl_GetVar2(pPriv->pTcl, argv[0], "GetError", TCL_GLOBAL_ONLY);
  if (!pPtr) {
    SCWrite(pCon, "ERROR: GetError script not found", eError);
    KillPrivate(pPriv);
    return NULL;
  } else {
    pPriv->pGetError = strdup(pPtr);
  }
  pPtr = NULL;
  pPtr = Tcl_GetVar2(pPriv->pTcl, argv[0], "TryFixIt", TCL_GLOBAL_ONLY);
  if (!pPtr) {
    SCWrite(pCon, "ERROR: TryFixIt script not found", eError);
    KillPrivate(pPriv);
    return NULL;
  } else {
    pPriv->pTryFixIt = strdup(pPtr);
  }
  pPtr = NULL;
  pPtr = Tcl_GetVar2(pPriv->pTcl, argv[0], "Wrapper", TCL_GLOBAL_ONLY);
  if (!pPtr) {
    SCWrite(pCon, "ERROR: Wrapper script not found", eError);
    KillPrivate(pPriv);
    return NULL;
  } else {
    pPriv->pWrapper = strdup(pPtr);
  }

  /* well all there, do the driver */
  pNew = CreateEVDriver(argc, argv);
  if (!pNew) {
    KillPrivate(pPriv);
    return NULL;
  }

  /* handle the name */
  pPriv->pName = strdup(pName);
  pPtr =
      Tcl_SetVar2(pPriv->pTcl, argv[0], "MyName", pName, TCL_GLOBAL_ONLY);

  /* initialise driver and functions */
  pNew->pPrivate = pPriv;
  pNew->SetValue = TclSetValue;
  pNew->GetValue = TclGetValue;
  pNew->Send = TclSend;
  pNew->GetError = TclGetError;
  pNew->TryFixIt = TclTryFixIt;
  pNew->Init = TclInit;
  pNew->Close = TclClose;
  pNew->KillPrivate = KillPrivate;

  /* driver loaded, ready steady fire! */
  return pNew;
}

/*-------------------------------------------------------------------------*/
int UpdateTclVariable(pEVDriver self, char *name, float fVal)
{
  pTclEv pPriv = NULL;
  char pBueffel[132];
  const char *pPtr = NULL;

  assert(self);
  pPriv = (pTclEv) self->pPrivate;
  assert(pPriv);

  snprintf(pBueffel,sizeof(pBueffel)-1, "%f", fVal);
  pPtr = Tcl_SetVar2(pPriv->pTcl, pPriv->pArray, name,
                     pBueffel, TCL_GLOBAL_ONLY);
  if (pPtr == NULL) {
    return 0;
  }
  return 1;
}

#define MAXLEN 2048
/*--------------------------------------------------------------------------*/
int TclEnvironmentWrapper(SConnection * pCon, SicsInterp * pSics,
                          void *pData, int argc, char *argv[])
{
  int iRet, i;
  char pBueffel[MAXLEN + 1];
  pTclEv pPriv = NULL;
  pEVControl pEv = NULL;

  pEv = (pEVControl) pData;
  assert(pEv);
  pPriv = pEv->pDriv->pPrivate;
  assert(pPriv);

  /* build command line */
  snprintf(pBueffel,sizeof(pBueffel)-1, "%s %s", pPriv->pWrapper, pPriv->pArray);
  for (i = 1; i < argc; i++) {
    if ((strlen(pBueffel) + strlen(argv[i])) < MAXLEN) {
      strcat(pBueffel, " ");
      strcat(pBueffel, argv[i]);
    }
  }
  /* execute Tcl */
  iRet = Tcl_Eval(pPriv->pTcl, pBueffel);
  if (iRet == TCL_OK) {
    return 1;
  } else {
    return EVControlWrapper(pCon, pSics, pData, argc, argv);
  }
}