int_listv.c

LastWave

/*..........................................................................*/
/*                                                                          */
/*      L a s t W a v e   K e r n e l   2 . 0 . 1                           */
/*                                                                          */
/*      Copyright (C) 1998-2003 Emmanuel Bacry.                             */
/*      email : [e-mail]                              */
/*                                                                          */
/*..........................................................................*/
/*                                                                          */
/*      This program is a free software, you can redistribute it and/or     */
/*      modify it under the terms of the GNU General Public License as      */
/*      published by the Free Software Foundation; either version 2 of the  */
/*      License, or (at your option) any later version                      */
/*                                                                          */
/*      This program is distributed in the hope that it will be useful,     */
/*      but WITHOUT ANY WARRANTY; without even the implied warranty of      */
/*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       */
/*      GNU General Public License for more details.                        */
/*                                                                          */
/*      You should have received a copy of the GNU General Public License   */
/*      along with this program (in a file named COPYRIGHT);                */
/*      if not, write to the Free Software Foundation, Inc.,                */
/*      59 Temple Place, Suite 330, Boston, MA  02111-1307  USA             */
/*                                                                          */
/*..........................................................................*/




/*********************************************************
 *
 * LISTV contents
 *
 *********************************************************/


#include "lastwave.h"
#include <stdarg.h>
#include "signals.h"
#include "images.h"
#include "int_fsilist.h"



/* Type of a listv */
char *listvType = "&listv";


/*
 * Answers to the different print messages
 */

#define LVPrintLength 30

void PrintListv(LISTV lv)
{
  int n;
  
  Printf("%s {\n",listvType);
  for (n=0;n<lv->length;n++) {
    Printf("% 4d :  ",n);
    if (lv->values[n] == NULL) {
      Printf(LWDoubleFormat,lv->f[n]);
      Printf("\n");
    }
    else {
      Printf("%s\n",ToStrValue(lv->values[n],NO));
    }
  }
  Printf("}\n");
}

char *ToStrListv(LISTV lv,char flagShort)
{
  static char strShort[30];
  char *str,*str1,*str2;
  int n;
  int nAlloc;
  
  if (flagShort) {
    sprintf(strShort,"{length=%d}",lv->length);
    return(strShort);
  }
  
  nAlloc = 300;
  str = CharAlloc(nAlloc);
  TempPtr(str);
  if (LVPrintLength < lv->length) sprintf(str,"{length=%d; ",lv->length);
  else sprintf(str,"{");
  
  for (n=0;n<MIN(lv->length,LVPrintLength);n++) {
    if (lv->values[n] == NULL) {
      sprintf(strShort,LWDoubleFormat,lv->f[n]);
      str1 = strShort;
    }
    else str1 = ToStrValue(lv->values[n],YES);
    if (strlen(str)+strlen(str1) > nAlloc-20) {
      nAlloc += MAX(300,strlen(str1)+20);
      str2 = CharAlloc(nAlloc);
      TempPtr(str2);
      strcpy(str2,str);
      str = str2;
    }
    strcat(str,str1);    
    if (n != MIN(lv->length,LVPrintLength)-1) strcat(str," ");
  }
  if (LVPrintLength < lv->length) strcat(str,"...");
  strcat(str,"}");
  
  return(str);
}

void PrintInfoListv(LISTV lv)
{
  Printf("   length =  %d   [nAlloc=%d]\n",lv->length,lv->nAlloc);
}

/* 
 * Subroutine of SetListvField (just below)
 */
char *SetListv_(LISTV *plv,void **arg)
{
  extern void *SetFieldArg(VALUE value, void **arg);
  char *field = ARG_S_GetField(arg);
  FSIList *fsiList = ARG_S_GetFsiList(arg);
  char *type = ARG_S_GetRightType(arg);      
  LWFLOAT flt = ARG_S_GetRightFloat(arg);   
  VALUE val = ARG_S_GetRightValue(arg);
  char *equal = ARG_S_GetEqual(arg);
  VALUE *pValueRes = ARG_S_GetResPValue(arg);
  FSI_DECL;
  LISTV lv = *plv;
  LISTV lv1;
  int j,k,_iold;
  
  /*************************
   *
   * Case lv = lv1
   *
   *************************/
  if (fsiList == NULL && *equal == '=') {
    if (type != listvType) {
      SetErrorf("Right handside should be a listv");
      return(NULL);
    }
    lv1 = (LISTV) val;
    CopyListv(lv1,*plv);
    return(listvType);
  }
  
  /*************************
   *
   * Case lv[range] *= val
   *
   *************************/
  
  if (*equal != '=' && *equal != ':' && fsiList != NULL) {
    ARG_S_SetField(arg,NULL);
    ARG_S_SetFsiList(arg,NULL);
    FSI_FOR_START(fsiList);
    if (lv->values[_i] == NULL) {
      if (SetFloatField(&(lv->f[_i]),arg,0)==NULL) return(NULL);
    }
    else {
      if (SetFieldArg(lv->values[_i],arg) == NULL) return(NULL);      
    }
    FSI_FOR_END;
    return(listvType);
  }
  
  /*************************
   *
   * Case lv += val
   *
   *************************/
  if (*equal != '=' && *equal != ':') {
    
    switch(*equal) {
        
      case '+':
        if (val == NULL) AppendFloat2Listv(lv,flt);
        else if (GetTypeValue(val) != listvType) AppendValue2Listv(lv,val);
        else AppendListv2Listv(lv,CastValue(val,LISTV));
        return(listvType);
        
        case '*':
        if (val != NULL) {
          if (GetTypeValue(val) != numType) {
            SetErrorf("The right handside must be an integer");
            return(NULL);
          }
          flt = CastValue(val,NUMVALUE)->f;
        }
        if ((int) flt != flt) { 
          SetErrorf("The right handside must be an integer and not a LWFLOAT");
          return(NULL);
        }
        if (flt<0) { 
          SetErrorf("The right handside must be a positive integer");
          return(NULL);
        }
        lv1 = NewListv();
        CopyListv(lv,lv1);
        SetLengthListv(lv,0);
        MultListv(lv1,(int) flt, lv);
        DeleteListv(lv1);
        return(listvType);
        
        default : 
        SetErrorf("Inadequate syntax '%s'",equal);
        return(NULL);  
    }
    
  }
  
  /*************************
   *
   * Case lv[range]= val
   *
   *************************/
  if (*equal == '=') {
    
    /* case val is not a listv */
    if (type != listvType) {
      if (fsiList->nx != 1) {
        SetErrorf("Size of both handsides should match (left size = %d, right size =1)",fsiList->nx);
        return(NULL);
      }
      if (val == NULL) SetListvNthFloat(lv,(int) FSIArray((&(fsiList->fsi[0])),0),flt);
      else SetListvNthValue(lv,(int) FSIArray((&(fsiList->fsi[0])),0),val);
      return(listvType);
    }
    
    /* case val it is a listv */
    lv1 = CastValue(val,LISTV);
    if (fsiList->nx != lv1->length) {
      SetErrorf("Size of both handsides should match (left size = %d, right size = %d)",fsiList->nx,lv1->length);
      return(NULL);
    }
    FSI_FOR_START(fsiList);
    if (lv1->values[_k] != NULL) SetListvNthValue(lv,_i,lv1->values[_k]);
    else SetListvNthFloat(lv,_i,lv1->f[_k]);
    FSI_FOR_END;
    return(listvType);
  }  
  
  /*************************
   *
   * Case lv[range] := {val}
   *
   *************************/
  
  if (val == NULL || GetTypeValue(val)!=listvType) {
    SetErrorf("The syntax 'listv :=' should be followed by another 'listv'");
    return(NULL);
  }
  lv1 = CastValue(val,LISTV);
  if (lv1->length > 1) {
    SetErrorf("The syntax is 'listv := ' should be followed by another 'listv' of length 1 or 0");
    return(NULL);
  }   
  if (fsiList == NULL) {
    SetErrorf("Inadequate ':=' syntax");
    return(NULL);
  }
  
  if (lv1->length == 1) {
    if (lv1->values[0] == NULL) {
      FSI_FOR_START(fsiList);
      SetListvNthFloat(lv,_i,lv1->f[0]);
      FSI_FOR_END;
    }
    else {
      FSI_FOR_START(fsiList);
      SetListvNthValue(lv,_i,lv1->values[0]);
      FSI_FOR_END;
    }
    return(listvType);
  }
  
  /* We start by creating a new listv which is a copy of lv */
  lv1 = NewListv();
  CopyListv(lv,lv1);
  SetLengthListv(lv,lv1->length-fsiList->nx); 
  
  /* Then we peform the set */
  j = 0; /* Index in lv1 */
  k = 0; /* Index in lv */
  _iold = -1;
  FSI_FOR_START(fsiList);
  /* We check the fsiList is sorted */
  if (_i <= _iold) {
    SetErrorf("Sorry, this operation with non sorted indexes is not implemented");
    DeleteListv(lv1);
    return(NULL);
  }
  _iold = _i;
  memcpy(lv->values+k,lv1->values+j,(_i-j)*sizeof(VALUE));        
  memcpy(lv->f+k,lv1->f+j,(_i-j)*sizeof(LWFLOAT));        
  k+=_i-j;
  j=_i+1;
  FSI_FOR_END;
  memcpy(lv->values+k,lv1->values+j,(lv1->length-j)*sizeof(VALUE));
  memcpy(lv->f+k,lv1->f+j,(lv1->length-j)*sizeof(LWFLOAT));
  DeleteListv(lv1);
  return(listvType);
}



/*
 * Basic routine to deal with setting Listv fields
 */
void *SetListvField(LISTV *plv,void **arg)
{
  VALUE *pValueRes = ARG_S_GetResPValue(arg);
  char *field = ARG_S_GetField(arg);
  void *res;
  
  ARG_S_SetField(arg,NULL);
  res = SetListv_(plv,arg);
  ARG_S_SetField(arg,field);
  
  if (res == NULL) return(NULL);
  
  if (*pValueRes == NULL) *pValueRes = (VALUE) *plv;
  return(listvType);
}  



/* 
 * Routine to deal with setting of listv
 */

static char *doc = "{[*opt,...] [:]= (<value> | <listv>)} {Get/Set the listv elements}"; 

static void *SetExtractListvV(LISTV lv,void **arg)
{
  VALUE *pValueRes;
  
  /* doc */
  if (lv == NULL) return(doc);
  
  pValueRes = ARG_S_GetResPValue(arg);
  
  if (SetListv_(&lv,arg) == NULL) return(NULL);
  if (*pValueRes == NULL) *pValueRes = (VALUE) lv;
  return(listvType);
}


/*
 * The different extract options 
 */

static char *extractOptionsListv[] = {"*nolimit","*bperiodic","*bmirror","*bmirror1",NULL};
enum {
  FSIOptListvNoLimit = FSIOption1,
  FSIOptListvBPer = FSIOption2,
  FSIOptListvBMir = FSIOption3,
  FSIOptListvBMir1 = FSIOption4,
};

static char *doc1 = "{[*opt,...] [:]= (<value> | <listv>)} {Get/Set the element of a listv}"; 

/* 
 * The function that manages extraction of a listv
 */

static void *GetExtractListvV(VALUE val, void **arg)
{
  LISTV lv;
  FSIList *fsiList;
  LWFLOAT *pFlt;
  char **pStr;
  VALUE *pValue;
  
  int max;
  FSI_DECL;
  BorderType bt;
  char *type;
  LISTV lvResult;
  
  /* Doc */
  if (val == NULL) return(doc1);
  
  lv = (LISTV) val;
  fsiList = ARG_G_GetFsiList(arg);
  pFlt = ARG_G_GetResPFloat(arg);
  pStr = ARG_G_GetResPStr(arg);
  pValue = ARG_G_GetResPValue(arg);
  
  /* case of an empty extraction */
  if (fsiList != NULL && fsiList->nx == 0) {
    *pValue = (VALUE) TNewListv();
    return(listvType);
  }
  
  if (fsiList->options & FSIOptListvBPer) bt = BorderPer;
  else if (fsiList->options & FSIOptListvBMir) bt = BorderMir;
  else if (fsiList->options & FSIOptListvBMir1) bt = BorderMir1;
  else bt = BorderNone;
  
  /* Get the max size */
  max = lv->length;
  
  /*
   * Case the result will be a simple val or a LWFLOAT
   */
  if (fsiList->options & (FSIOptListvBPer | FSIOptListvBMir | FSIOptListvBMir1) && fsiList->nx == 1 ||
      !(fsiList->options & (FSIOptListvBPer | FSIOptListvBMir | FSIOptListvBMir1)) && fsiList->nx1 == 1) {
    
    _i = (int) FSIArray((&(fsiList->fsi[0])),0);
    
    /* The loop in the case of *nolimit */
    if (fsiList->options & FSIOptListvNoLimit) {
      FSI_FOR_START(fsiList); 
      if (_i<0 || _i > max-1) continue;
      type=GetListvNth(lv,_i,pValue,pFlt);
      break;       
      FSI_FOR_END;
    }
    
    /* Other cases */
    else {
      switch (bt) {
        case BorderPer : type=GetListvNth(lv,BPER(_i,max),pValue,pFlt); break;
        case BorderMir : type=GetListvNth(lv,BMIR(_i,max),pValue,pFlt); break;
        case BorderMir1 : type=GetListvNth(lv,BMIR1(_i,max),pValue,pFlt); break;
        default : type=GetListvNth(lv,_i,pValue,pFlt);
      }
    }
    
    if (*pValue) {
      AddRefValue(*pValue);
      TempValue(*pValue);
      return(type);
    }
    else return(numType);
  }
  
  /*
   * Case the result will be a listv
   */
  
  /* Allocation of the result */
  lvResult = TNewListv();
  if (fsiList->options & (FSIOptListvBPer | FSIOptListvBMir | FSIOptListvBMir1)) SetLengthListv(lvResult,fsiList->nx);
  else SetLengthListv(lvResult,fsiList->nx1);
  lvResult->length = 0;
  
  /* The loop in the case of *nolimit */
  if (fsiList->options & FSIOptListvNoLimit) {
    FSI_FOR_START(fsiList); 
    if (_i<0 || _i > max-1) continue;
    GetListvNth(lv,_i,pValue,pFlt);
    FSI_FOR_END;
  }
  /* The loop in the generic case */
  else {
    FSI_FOR_START(fsiList); 
    switch (bt) {
      case BorderPer : GetListvNth(lv,BPER(_i,max),pValue,pFlt); break;
      case BorderMir : GetListvNth(lv,BMIR(_i,max),pValue,pFlt); break;
      case BorderMir1 : GetListvNth(lv,BMIR1(_i,max),pValue,pFlt); break;
      default : GetListvNth(lv,_i,pValue,pFlt);
        if (*pValue) AppendValue2Listv(lvResult,*pValue);
        else AppendFloat2Listv(lvResult,*pFlt);          
    }
    FSI_FOR_END;
  }
  
  *pValue = (VALUE) lvResult;
  
  return(listvType);
}

/*
 * Get the options for extraction (called for field NULL only)
 */

static char *optionDoc = "{{*nolimit,*bmirror,*bmirror1,*bperiodic} \
{*nolimit : indexes can be out of range} \
{*bperiodic : periodic border effect)} \
{*bmirror : mirror+periodic border effect (first and last elements are repeated)} \
{*bmirror1 : mirror+periodic border effect (first and last elements are NOT repeated)}\
}";

static void *GetExtractOptionsListvV(VALUE val, void **arg)
{
  /* doc */
  if (val == NULL) return(optionDoc);
  
  return(extractOptionsListv);
}


/*
 * Function to get the ExtractInfo for fields NULL
 */

static void *GetExtractInfoListvV(VALUE val, void **arg)
{
  static ExtractInfo extractInfo;
  static char flagInit = YES;
  
  
  LISTV lv = (LISTV) val;
  char *field = ARG_EI_GetField(arg);
  unsigned long *options = ARG_EI_GetPOptions(arg);
  
  /* If *bperiodic,... then *nolimit must be off */
  if (*options & (FSIOptListvBPer | FSIOptListvBMir | FSIOptListvBMir1)) *options &= ~FSIOptListvNoLimit;
  
  /* Init of the extraction info */
  if (flagInit) {
    extractInfo.xmin = 0;
    extractInfo.dx = 1;
    extractInfo.nSignals = 1;
    flagInit = NO;
  }
  
  /* Get the maximum index */
  if (lv->length == 0) {
    SetErrorf("No extraction on empty listv");
    return(NULL);
  }
  else extractInfo.xmax = lv->length-1;
  
  /* '*nolimit' option : set some flags */
  if (*options & (FSIOptListvBPer | FSIOptListvBMir | FSIOptListvBMir1 | FSIOptListvNoLimit)) extractInfo.flags = EIIntIndex;
  else extractInfo.flags = EIErrorBound | EIIntIndex;