/*---------------------------------------------------------------------------
                  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 */
     sprintf(pBueffel,"%s %s %f",pPriv->pSetValue, pPriv->pArray, fNew);
     iRet = Tcl_Eval(pPriv->pTcl,pBueffel);
     if(iRet != TCL_OK)
     {
        strncpy(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 */
     sprintf(pBueffel,"%s %s",pPriv->pGetValue, pPriv->pArray);
     iRet = Tcl_Eval(pPriv->pTcl,pBueffel);
     if(iRet != TCL_OK)
     {
        strncpy(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 */
     sprintf(pBueffel,"%s %s %s",pPriv->pSend, pPriv->pArray,pCommand);
     iRet = Tcl_Eval(pPriv->pTcl,pBueffel);
     if(iRet != TCL_OK)
     {
        strncpy(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
     {
        strncpy(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)
     {
       sprintf(pBueffel,"Your Tcl-script returned a stupid answer:\n --> %s <--",
                        pPriv->pTcl->result);
       strncpy(pReply,pBueffel,iReplyLen);
       return 1;       
     } 
     
     /* build command line */
     sprintf(pBueffel,"%s %s %d",pPriv->pGetError, pPriv->pArray,pPriv->iLastError);
     iRet = Tcl_Eval(pPriv->pTcl,pBueffel);
     if(iRet != TCL_OK)
     {
        strncpy(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
     {
        strncpy(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 */
     sprintf(pBueffel,"%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 */
     sprintf(pBueffel,"%s %s",pPriv->pInit, pPriv->pArray);
     iRet = Tcl_Eval(pPriv->pTcl,pBueffel);
     if(iRet != TCL_OK)
     {
        strncpy(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 */
     sprintf(pBueffel,"%s %s",pPriv->pClose, pPriv->pArray);
     iRet = Tcl_Eval(pPriv->pTcl,pBueffel);
     if(iRet != TCL_OK)
     {
        strncpy(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);
     
     sprintf(pBueffel,"%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 */
    sprintf(pBueffel,"%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);
    }
  }