/* -*- mode: c; c-basic-offset: 4; indent-tabs-mode: nil -*- */
/*
 * bltVecCmd.c --
 *
 * This module implements vector data objects.
 *
 * Copyright 2015 George A. Howlett. All rights reserved.  
 *
 *   Redistribution and use in source and binary forms, with or without
 *   modification, are permitted provided that the following conditions are
 *   met:
 *
 *   1) Redistributions of source code must retain the above copyright
 *      notice, this list of conditions and the following disclaimer.
 *   2) Redistributions in binary form must reproduce the above copyright
 *      notice, this list of conditions and the following disclaimer in the
 *      documentation and/or other materials provided with the
 *      distribution.
 *   3) Neither the name of the authors nor the names of its contributors
 *      may be used to endorse or promote products derived from this
 *      software without specific prior written permission.
 *   4) Products derived from this software may not be called "BLT" nor may
 *      "BLT" appear in their names without specific prior written
 *      permission from the author.
 *
 *   THIS SOFTWARE IS PROVIDED ''AS IS'' AND ANY EXPRESS OR IMPLIED
 *   WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 *   MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 *   DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
 *   LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 *   CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 *   SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 *   BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 *   WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 *   OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 *   IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * Code for binary data read operation was donated by Harold Kirsch.
 *
 */

/*
 * TODO:
 *      o Add H. Kirsch's vector binary read operation
 *              x binread file0
 *              x binread -file file0
 *
 *      o Add ASCII/binary file reader
 *              x read fileName
 *
 *      o Allow Tcl-based client notifications.
 *              vector x
 *              x notify call Display
 *              x notify delete Display
 *              x notify reorder #1 #2
 */

#include "bltVecInt.h"
#if (_TCL_VERSION > _VERSION(8,5,0)) 
#undef SIGN
#include "tclTomMath.h"
#endif

#ifdef HAVE_STDLIB_H
  #include <stdlib.h>
#endif /* HAVE_STDLIB_H */

#ifdef HAVE_STRING_H
  #include <string.h>
#endif /* HAVE_STRING_H */

#ifdef HAVE_CTYPE_H
  #include <ctype.h>
#endif /* HAVE_CTYPE_H */

#include "bltAlloc.h"
#include "bltMath.h"
#include "bltOp.h"
#include "bltNsUtil.h"
#include "bltSwitch.h"

static Blt_SwitchParseProc ObjToFFTVector;
static Blt_SwitchCustom fftVectorSwitch = {
    ObjToFFTVector, NULL, NULL, (ClientData)0
};

static Blt_SwitchParseProc ObjToIndex;
static Blt_SwitchCustom indexSwitch = {
    ObjToIndex, NULL, NULL, (ClientData)0
};

typedef struct {
    Tcl_Obj *formatObjPtr;
    int from, to;
    int empty;
} ValuesSwitches;

static Blt_SwitchSpec valuesSwitches[] = 
{
    {BLT_SWITCH_OBJ,    "-format", "string", (char *)NULL,
        Blt_Offset(ValuesSwitches, formatObjPtr), 0},
    {BLT_SWITCH_CUSTOM, "-from",   "index", (char *)NULL,
        Blt_Offset(ValuesSwitches, from),         0, 0, &indexSwitch},
    {BLT_SWITCH_CUSTOM, "-to",     "index", (char *)NULL,
        Blt_Offset(ValuesSwitches, to),           0, 0, &indexSwitch},
    {BLT_SWITCH_BOOLEAN, "-empty", "bool", (char *)NULL,
        Blt_Offset(ValuesSwitches, empty),           0, 0},
    {BLT_SWITCH_END}
};

typedef struct {
    int from, to;
    int empty;
    Tcl_Obj *dataObjPtr;
    Tcl_Obj *fileObjPtr;
} ExportSwitches;

static Blt_SwitchSpec exportSwitches[] = 
{
    {BLT_SWITCH_OBJ,    "-data",   "data", (char *)NULL,
        Blt_Offset(ExportSwitches, dataObjPtr), 0},
    {BLT_SWITCH_OBJ,    "-file",   "fileName", (char *)NULL,
        Blt_Offset(ExportSwitches, fileObjPtr), 0},
    {BLT_SWITCH_CUSTOM, "-from",   "index", (char *)NULL,
        Blt_Offset(ExportSwitches, from),         0, 0, &indexSwitch},
    {BLT_SWITCH_CUSTOM, "-to",     "index", (char *)NULL,
        Blt_Offset(ExportSwitches, to),           0, 0, &indexSwitch},
    {BLT_SWITCH_DOUBLE, "-empty", "value", (char *)NULL,
        Blt_Offset(ExportSwitches, empty),       0, 0},
    {BLT_SWITCH_END}
};

typedef struct {
    int from, to;
} PrintSwitches;

static Blt_SwitchSpec printSwitches[] = 
{
    {BLT_SWITCH_CUSTOM, "-from",   "index", (char *)NULL,
        Blt_Offset(PrintSwitches, from),         0, 0, &indexSwitch},
    {BLT_SWITCH_CUSTOM, "-to",     "index", (char *)NULL,
        Blt_Offset(PrintSwitches, to),           0, 0, &indexSwitch},
    {BLT_SWITCH_END}
};

typedef struct {
    int flags;
} SortSwitches;

#define SORT_DECREASING (1<<0)
#define SORT_UNIQUE     (1<<1)
#define SORT_INDICES    (1<<2)
#define SORT_VALUES     (1<<3)

static Blt_SwitchSpec sortSwitches[] = 
{
    {BLT_SWITCH_BITS_NOARG, "-decreasing", "", (char *)NULL,
        Blt_Offset(SortSwitches, flags), 0, SORT_DECREASING},
    {BLT_SWITCH_BITS_NOARG, "-indices", "", (char *)NULL,
        Blt_Offset(SortSwitches, flags), 0, SORT_INDICES},
    {BLT_SWITCH_BITS_NOARG, "-reverse", "", (char *)NULL,
        Blt_Offset(SortSwitches, flags), 0, SORT_DECREASING},
    {BLT_SWITCH_BITS_NOARG, "-unique", "", (char *)NULL,
        Blt_Offset(SortSwitches, flags), 0, SORT_UNIQUE},
    {BLT_SWITCH_BITS_NOARG, "-values", "", (char *)NULL,
        Blt_Offset(SortSwitches, flags), 0, SORT_VALUES},
    {BLT_SWITCH_END}
};

typedef struct {
    double delta;
    VectorObject *imagPtr;                    /* Vector containing imaginary
                                         * part. */
    VectorObject *freqPtr;                    /* Vector containing frequencies. */
    VectorCmdInterpData *dataPtr;
    int mask;                           /* Flags controlling FFT. */
} FFTData;


static Blt_SwitchSpec fftSwitches[] = {
    {BLT_SWITCH_CUSTOM, "-imagpart",    "vector", (char *)NULL,
        Blt_Offset(FFTData, imagPtr), 0, 0, &fftVectorSwitch},
    {BLT_SWITCH_BITS_NOARG, "-noconstant", "", (char *)NULL,
        Blt_Offset(FFTData, mask), 0, FFT_NO_CONSTANT},
    {BLT_SWITCH_BITS_NOARG, "-spectrum", "", (char *)NULL,
          Blt_Offset(FFTData, mask), 0, FFT_SPECTRUM},
    {BLT_SWITCH_BITS_NOARG, "-bartlett",  "", (char *)NULL,
         Blt_Offset(FFTData, mask), 0, FFT_BARTLETT},
    {BLT_SWITCH_DOUBLE, "-delta",   "float", (char *)NULL,
        Blt_Offset(FFTData, mask), 0, 0, },
    {BLT_SWITCH_CUSTOM, "-frequencies", "vector", (char *)NULL,
        Blt_Offset(FFTData, freqPtr), 0, 0, &fftVectorSwitch},
    {BLT_SWITCH_END}
};

typedef struct {
    double tol;
    unsigned int flags;
} SimplifySwitches;

#define SIMPLIFY_INDICES (1)

static Blt_SwitchSpec simplifySwitches[] = 
{
    {BLT_SWITCH_DOUBLE,    "-tol", "value", (char *)NULL,
        Blt_Offset(SimplifySwitches, tol), 0},
    {BLT_SWITCH_BITS_NOARG, "-indices", "", (char *)NULL,
        Blt_Offset(SimplifySwitches, flags), 0, SIMPLIFY_INDICES},
    {BLT_SWITCH_END}
};
/*
 *---------------------------------------------------------------------------
 *
 * GetVectorObject --
 *
 *      Convert a string representing a vector object into its vector
 *      structure.
 *
 * Results:
 *      The return value is a standard TCL result.
 *
 *---------------------------------------------------------------------------
 */
static int
GetVectorObject(Tcl_Interp *interp, VectorCmdInterpData *dataPtr, 
                Tcl_Obj *objPtr, VectorObject **vecObjPtrPtr)
{
    const char *string;
    VectorObject *vecObjPtr;
    
    string = Tcl_GetString(objPtr);
    if (Blt_VecObj_Find(interp, dataPtr, string, &vecObjPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    *vecObjPtrPtr = vecObjPtr;
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * NewVectorObject --
 *
 *      Convert a string representing a vector into its vector structure.
 *
 * Results:
 *      The return value is a standard TCL result.
 *
 *---------------------------------------------------------------------------
 */
static VectorObject *
NewVectorObject(VectorCmdInterpData *dataPtr, const char *string, int *isNewPtr)
{
    return Blt_VecObj_Create(dataPtr, string, string, string, isNewPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * ObjToFFTVector --
 *
 *      Convert a string representing a vector into its vector structure.
 *
 * Results:
 *      The return value is a standard TCL result.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
ObjToFFTVector(
    ClientData clientData,              /* Not used. */
    Tcl_Interp *interp,                 /* Interpreter to report results */
    const char *switchName,             /* Not used. */
    Tcl_Obj *objPtr,                    /* Name of vector. */
    char *record,                       /* Structure record */
    int offset,                         /* Offset to field in structure */
    int flags)                          /* Not used. */
{
    FFTData *fftPtr = (FFTData *)record;
    VectorObject **vecObjPtrPtr = (VectorObject **)(record + offset);

    return GetVectorObject(interp, fftPtr->dataPtr, objPtr, vecObjPtrPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * ObjToIndex --
 *
 *      Convert a string representing a vector into its vector structure.
 *
 * Results:
 *      The return value is a standard TCL result.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
ObjToIndex(
    ClientData clientData,              /* Contains the vector in question
                                         * to verify its length. */
    Tcl_Interp *interp,                 /* Interpreter to report results */
    const char *switchName,             /* Not used. */
    Tcl_Obj *objPtr,                    /* Name of vector. */
    char *record,                       /* Structure record */
    int offset,                         /* Offset to field in structure */
    int flags)                          /* Not used. */
{
    VectorObject *vecObjPtr = clientData;
    int *indexPtr = (int *)(record + offset);
    int index;

    if (Blt_VecObj_GetIndex(interp, vecObjPtr, Tcl_GetString(objPtr), &index)
        !=TCL_OK) {
        return TCL_ERROR;
    }
    *indexPtr = index;
    return TCL_OK;

}

static Tcl_Obj *
GetValues(VectorObject *srcObjPtr, int first, int last)
{ 
    Tcl_Obj *listObjPtr;
    int i;

    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
    for (i = first; i < last; i++) {
        Tcl_Obj *objPtr;
        
        objPtr = Tcl_NewDoubleObj(srcObjPtr->valueArr[i]);
        Tcl_ListObjAppendElement(srcObjPtr->interp, listObjPtr, objPtr);
    } 
    return listObjPtr;
}

static void
ReplicateValue(VectorObject *destPtr, int first, int last, double value)
{ 
    int i;
 
    for (i = first; i < last; i++) {
        destPtr->valueArr[i] = value; 
    } 
    destPtr->notifyFlags |= UPDATE_RANGE; 
}

static int
CopyList(VectorObject *vecObjPtr, Tcl_Interp *interp, int objc, 
         Tcl_Obj *const *objv)
{
    int i;

    if (Blt_VecObj_SetLength(interp, vecObjPtr, objc) != TCL_OK) {
        return TCL_ERROR;
    }
    for (i = 0; i < objc; i++) {
        double value;

        if (Blt_ExprDoubleFromObj(interp, objv[i], &value) != TCL_OK) {
            Blt_VecObj_SetLength(interp, vecObjPtr, i);
            return TCL_ERROR;
        }
        vecObjPtr->valueArr[i] = value;
    }
    return TCL_OK;
}

static int
AppendVector(VectorObject *destPtr, VectorObject *srcObjPtr)
{
    int numBytes;
    int oldSize, newSize;

    oldSize = destPtr->length;
    newSize = oldSize + srcObjPtr->length;
    if (Blt_VecObj_ChangeLength(destPtr->interp, destPtr, newSize) != TCL_OK) {
        return TCL_ERROR;
    }
    numBytes = (newSize - oldSize) * sizeof(double);
    memcpy((char *)(destPtr->valueArr + oldSize), srcObjPtr->valueArr, numBytes);
    destPtr->notifyFlags |= UPDATE_RANGE;
    return TCL_OK;
}

static int
AppendObjv(VectorObject *vecObjPtr, int objc, Tcl_Obj *const *objv)
{
    Tcl_Interp *interp = vecObjPtr->interp;
    int count;
    int i;
    double value;
    int oldSize;

    oldSize = vecObjPtr->length;
    if (Blt_VecObj_ChangeLength(interp, vecObjPtr, vecObjPtr->length + objc) 
        != TCL_OK) {
        return TCL_ERROR;
    }
    count = oldSize;
    for (i = 0; i < objc; i++) {
        if (Blt_ExprDoubleFromObj(interp, objv[i], &value) != TCL_OK) {
            Blt_VecObj_ChangeLength(interp, vecObjPtr, count);
            return TCL_ERROR;
        }
        vecObjPtr->valueArr[count++] = value;
    }
    vecObjPtr->notifyFlags |= UPDATE_RANGE;
    return TCL_OK;
}

/* Vector instance option commands */

/*
 *---------------------------------------------------------------------------
 *
 * AppendOp --
 *
 *      Appends one of more TCL lists of values, or vector objects onto the
 *      end of the current vector object.
 *
 * Results:
 *      A standard TCL result.  If a current vector can't be created, 
 *      resized, any of the named vectors can't be found, or one of lists of
 *      values is invalid, TCL_ERROR is returned.
 *
 * Side Effects:
 *      Clients of current vector will be notified of the change.
 *
 *      vecName append srcName...
 *---------------------------------------------------------------------------
 */
static int
AppendOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
   VectorObject *destPtr = clientData;
    int i;

    for (i = 2; i < objc; i++) {
        int result;
        VectorObject *srcObjPtr;

        /* It's either a vector name of a list of numbers.  */
        srcObjPtr = Blt_VecObj_ParseElement((Tcl_Interp *)NULL, destPtr->dataPtr, 
               Tcl_GetString(objv[i]), (const char **)NULL, NS_SEARCH_BOTH);
        if (srcObjPtr != NULL) {
            result = AppendVector(destPtr, srcObjPtr);
        } else {
            int ec;
            Tcl_Obj **ev;

            if (Tcl_ListObjGetElements(interp, objv[i], &ec, &ev) != TCL_OK) {
                return TCL_ERROR;
            }
            result = AppendObjv(destPtr, ec, ev);
        }
        if (result != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (objc > 2) {
        if (destPtr->flush) {
            Blt_VecObj_FlushCache(destPtr);
        }
        Blt_VecObj_UpdateClients(destPtr);
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ClearOp --
 *
 *      Deletes all the accumulated array indices for the TCL array associated
 *      will the vector.  This routine can be used to free excess memory from
 *      a large vector.
 *
 * Results:
 *      Always returns TCL_OK.
 *
 * Side Effects:
 *      Memory used for the entries of the TCL array variable is freed.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
ClearOp(ClientData clientData, Tcl_Interp *interp, int objc,
        Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;

    Blt_VecObj_FlushCache(vecObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * DeleteOp --
 *
 *      Deletes the given indices from the vector.  If no indices are
 *      provided the entire vector is deleted.
 *
 * Results:
 *      A standard TCL result.  If any of the given indices is invalid,
 *      interp->result will an error message and TCL_ERROR is returned.
 *
 * Side Effects:
 *      The clients of the vector will be notified of the vector
 *      deletions.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
DeleteOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    unsigned char *unsetArr;
    long i, j;
    long count;

    /* FIXME: Don't delete vector with no indices.  */
    if (objc == 2) {
        Blt_VecObj_Free(vecObjPtr);
        return TCL_OK;
    }

    /* Allocate an "unset" bitmap the size of the vector. */
    unsetArr = Blt_AssertCalloc(sizeof(unsigned char), 
                                (vecObjPtr->length + 7) / 8);
#define SetBit(i) \
    unsetArr[(i) >> 3] |= (1 << ((i) & 0x07))
#define GetBit(i) \
    (unsetArr[(i) >> 3] & (1 << ((i) & 0x07)))

    for (i = 2; i < objc; i++) {
        const char *string;

        string = Tcl_GetString(objv[i]);
        if (Blt_VecObj_GetRange(interp, vecObjPtr, string) != TCL_OK) {
            Blt_Free(unsetArr);
            return TCL_ERROR;
        }
        for (j = vecObjPtr->first; j < vecObjPtr->last; j++) {
            SetBit(j);                  /* Mark the element for deletion. */
        }
    }
    count = 0;
    for (i = 0; i < vecObjPtr->length; i++) {
        if (GetBit(i)) {
            continue;                   /* Skip marked elements. */
        }
        if (count < i) {
            vecObjPtr->valueArr[count] = vecObjPtr->valueArr[i];
        }
        count++;
    }
    Blt_Free(unsetArr);
    vecObjPtr->length = count;
    if (vecObjPtr->flush) {
        Blt_VecObj_FlushCache(vecObjPtr);
    }
    Blt_VecObj_UpdateClients(vecObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * DupOp --
 *
 *      Creates one or more duplicates of the vector object.
 *
 * Results:
 *      A standard TCL result.  If a new vector can't be created, or and
 *      existing vector resized, TCL_ERROR is returned.
 *
 * Side Effects:
 *      Clients of existing vectors will be notified of the change.
 *
 *      vecName dup ?newName?
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
DupOp(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
    VectorObject *srcObjPtr = clientData;
    VectorObject *destPtr;
    int isNew;
    const char *dupName;
    
    if (objc == 3) {
        dupName = Tcl_GetString(objv[2]);
    } else {
        dupName ="#auto";
    }
    destPtr = NewVectorObject(srcObjPtr->dataPtr, dupName, &isNew);
    if (destPtr == NULL) {
        return TCL_ERROR;
    }
    if (destPtr == srcObjPtr) {
        /* Source and destination are the same */
        return TCL_OK;
    }
    if (Blt_VecObj_Duplicate(destPtr, srcObjPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (destPtr->flush) {
        Blt_VecObj_FlushCache(destPtr);
    }
    Blt_VecObj_UpdateClients(destPtr);
    Tcl_SetStringObj(Tcl_GetObjResult(interp), destPtr->name, -1);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * FrequencyOp --
 *
 *      Fills the destination vector with the frequency counts from the 
 *      source vector.
 *
 * Results:
 *      A standard TCL result.  If a new vector can't be created,
 *      or and existing vector resized, TCL_ERROR is returned.
 *
 *      vecName frequency srcName 10 
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
FrequencyOp(ClientData clientData, Tcl_Interp *interp, int objc,
            Tcl_Obj *const *objv)
{
    VectorObject *destObjPtr = clientData;
    Blt_HashEntry *hPtr;
    Blt_HashSearch iter;
    Blt_HashTable freqTable;
    VectorObject *srcObjPtr;
    double range;
    long i, numBins;

    if (GetVectorObject(interp, destObjPtr->dataPtr, objv[2], &srcObjPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_GetLongFromObj(interp, objv[3], &numBins) != TCL_OK) {
        return TCL_ERROR;
    }
    if (numBins < 1) {
        Tcl_AppendResult(interp, "bad number of bins \"", 
                         Tcl_GetString(objv[3]), "\"", (char *)NULL);
        return TCL_ERROR;
    }
    if (Blt_VecObj_ChangeLength(destObjPtr->interp, destObjPtr, numBins) != TCL_OK) {
        return TCL_ERROR;
    }
    for (i = 0; i < numBins; i++) {
        destObjPtr->valueArr[i] = 0.0;
    }
    Blt_InitHashTable(&freqTable, BLT_ONE_WORD_KEYS);
    range = srcObjPtr->max - srcObjPtr->min;
    for (i = 0; i < srcObjPtr->length; i++) {
        Blt_HashEntry *hPtr;
        double value, norm;
        int isNew;
        size_t bin;
        size_t count;

        value = srcObjPtr->valueArr[i];
        norm = (value - srcObjPtr->min) / range;
        bin = (uintptr_t)round(norm * (numBins - 1));
        hPtr = Blt_CreateHashEntry(&freqTable, (char *)bin, &isNew);
        if (isNew) {
            count = 1;
        } else {
            count = (size_t)Blt_GetHashValue(hPtr);
            count++;
        }
        Blt_SetHashValue(hPtr, count);
    }                                
    for (i = 0, hPtr = Blt_FirstHashEntry(&freqTable, &iter); hPtr != NULL;
         hPtr = Blt_NextHashEntry(&iter), i++) {
        size_t count, index;
        
        count = (size_t)Blt_GetHashValue(hPtr);
        index = (size_t)Blt_GetHashKey(&freqTable, hPtr);
        destObjPtr->valueArr[index] = (double)count;
    }
    Blt_DeleteHashTable(&freqTable);
    Blt_VecObj_FlushCache(destObjPtr);
    Blt_VecObj_UpdateClients(destObjPtr);
    return TCL_OK;
}

/* spinellia@acm.org START */

/* fft implementation */
/*ARGSUSED*/
static int
FFTOp(ClientData clientData, Tcl_Interp *interp, int objc,
      Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    VectorObject *realVecPtr = NULL;
    FFTData data;
    
    memset(&data, 0, sizeof(data));
    data.delta = 1.0;

    if (GetVectorObject(interp, vecObjPtr->dataPtr, objv[2], &realVecPtr) 
        != TCL_OK) {
        return TCL_ERROR;
    }
    if (realVecPtr == vecObjPtr) {
        Tcl_AppendResult(interp, "real vector \"", Tcl_GetString(objv[2]), "\"",
                " can't be the same as the source", (char *)NULL);
        return TCL_ERROR;
    }
    if (Blt_ParseSwitches(interp, fftSwitches, objc - 3, objv + 3, &data, 
        BLT_SWITCH_DEFAULTS) < 0) {
        return TCL_ERROR;
    }
    if (Blt_VecObj_FFT(interp, realVecPtr, data.imagPtr, data.freqPtr, 
                       data.delta, data.mask, vecObjPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    /* Update bookkeeping. */
    if (realVecPtr->flush) {
        Blt_VecObj_FlushCache(realVecPtr);
    }
    Blt_VecObj_UpdateClients(realVecPtr);
    if (data.imagPtr != NULL) {
        if (data.imagPtr->flush) {
            Blt_VecObj_FlushCache(data.imagPtr);
        }
        Blt_VecObj_UpdateClients(data.imagPtr);
    }
    if (data.freqPtr != NULL) {
        if (data.freqPtr->flush) {
            Blt_VecObj_FlushCache(data.freqPtr);
        }
        Blt_VecObj_UpdateClients(data.freqPtr);
    }
    return TCL_OK;
}       

/*ARGSUSED*/
/* 
 *      vecName inversefft srcImag destReal destImag 
 */
static int
InverseFFTOp(ClientData clientData, Tcl_Interp *interp, int objc,
             Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    VectorObject *srcImagPtr;
    VectorObject *destRealPtr;
    VectorObject *destImagPtr;

    if (GetVectorObject(interp, vecObjPtr->dataPtr, objv[2], &srcImagPtr) 
        != TCL_OK) {
        return TCL_ERROR;
    }
    if ((GetVectorObject(interp, vecObjPtr->dataPtr, objv[3], &destRealPtr) 
         != TCL_OK) ||
        (GetVectorObject(interp, vecObjPtr->dataPtr, objv[4], &destImagPtr) 
         != TCL_OK)) {
        return TCL_ERROR;
    }
    if (Blt_VecObj_InverseFFT(interp, srcImagPtr, destRealPtr, destImagPtr, 
                              vecObjPtr) != TCL_OK ){
        return TCL_ERROR;
    }
    if (destRealPtr->flush) {
        Blt_VecObj_FlushCache(destRealPtr);
    }
    Blt_VecObj_UpdateClients(destRealPtr);
    if (destImagPtr->flush) {
        Blt_VecObj_FlushCache(destImagPtr);
    }
    Blt_VecObj_UpdateClients(destImagPtr);
    return TCL_OK;
}


/*
 *---------------------------------------------------------------------------
 *
 * LengthOp --
 *
 *      Returns the length of the vector.  If a new size is given, the vector
 *      is resized to the new vector.
 *
 * Results:
 *      A standard TCL result.  If the new length is invalid, interp->result
 *      will an error message and TCL_ERROR is returned.  Otherwise
 *      interp->result will contain the length of the vector.
 *
 *---------------------------------------------------------------------------
 */
static int
LengthOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;

    if (objc == 3) {
        int numElem;

        if (Tcl_GetIntFromObj(interp, objv[2], &numElem) != TCL_OK) {
            return TCL_ERROR;
        }
        if (numElem < 0) {
            Tcl_AppendResult(interp, "invalid length \"",
                             Tcl_GetString(objv[2]), "\": can't be negative",
                             (char *)NULL);
            return TCL_ERROR;
        }
        if ((Blt_VecObj_SetSize(interp, vecObjPtr, numElem) != TCL_OK) ||
            (Blt_VecObj_SetLength(interp, vecObjPtr, numElem) != TCL_OK)) {
            return TCL_ERROR;
        } 
        if (vecObjPtr->flush) {
            Blt_VecObj_FlushCache(vecObjPtr);
        }
        Blt_VecObj_UpdateClients(vecObjPtr);
    }
    Tcl_SetIntObj(Tcl_GetObjResult(interp), vecObjPtr->length);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * LimitsOp --
 *
 *      Returns the minimum and maximum value of the vector.
 *
 * Results:
 *      A standard TCL result. 
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
LimitsOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    Tcl_Obj *listObjPtr, *objPtr;

    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
    objPtr = Tcl_NewDoubleObj(Blt_VecObj_Min(vecObjPtr));
    Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
    objPtr = Tcl_NewDoubleObj(Blt_VecObj_Max(vecObjPtr));
    Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * MapOp --
 *
 *      Queries or sets the offset of the array index from the base address
 *      of the data array of values.
 *
 * Results:
 *      A standard TCL result.  If the source vector doesn't exist or the
 *      source list is not a valid list of numbers, TCL_ERROR returned.
 *      Otherwise TCL_OK is returned.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
MapOp(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;

    if (objc > 2) {
        if (Blt_VecObj_MapVariable(interp, vecObjPtr, Tcl_GetString(objv[2])) 
            != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (vecObjPtr->arrayName != NULL) {
        Tcl_SetStringObj(Tcl_GetObjResult(interp), vecObjPtr->arrayName, -1);
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * MaxOp --
 *
 *      Returns the maximum value of the vector.
 *
 * Results:
 *      A standard TCL result. 
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
MaxOp(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;

    Tcl_SetDoubleObj(Tcl_GetObjResult(interp), Blt_VecObj_Max(vecObjPtr));
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * MergeOp --
 *
 *      Merges the values from the given vectors to the current vector.
 *
 * Results:
 *      A standard TCL result.  If any of the given vectors differ in size,
 *      TCL_ERROR is returned.  Otherwise TCL_OK is returned and the
 *      vector data will contain merged values of the given vectors.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
MergeOp(ClientData clientData, Tcl_Interp *interp, int objc,
        Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    VectorObject **vecArr;
    long refSize, numElem;
    long i;
    double *valuePtr, *valueArr;
    VectorObject **vecObjPtrPtr;
    
    /* Allocate an array of vector pointers of each vector to be merged in
     * the current vector.  */
    vecArr = Blt_AssertMalloc(sizeof(VectorObject *) * objc);
    vecObjPtrPtr = vecArr;

    refSize = -1;
    numElem = 0;
    for (i = 2; i < objc; i++) {
        VectorObject *srcObjPtr;

        if (GetVectorObject(interp, vecObjPtr->dataPtr, objv[i], &srcObjPtr) 
            != TCL_OK) {
            Blt_Free(vecArr);
            return TCL_ERROR;
        }
        /* Check that all the vectors are the same length */
        if (refSize < 0) {
            refSize = srcObjPtr->length;
        } else if (srcObjPtr->length != refSize) {
            Tcl_AppendResult(vecObjPtr->interp, "vectors \"", vecObjPtr->name,
                "\" and \"", srcObjPtr->name, "\" differ in length",
                (char *)NULL);
            Blt_Free(vecArr);
            return TCL_ERROR;
        }
        *vecObjPtrPtr++ = srcObjPtr;
        numElem += refSize;
    }
    *vecObjPtrPtr = NULL;

    valueArr = Blt_Malloc(sizeof(double) * numElem);
    if (valueArr == NULL) {
        Tcl_AppendResult(vecObjPtr->interp, "not enough memory to allocate ", 
                 Blt_Itoa(numElem), " vector elements", (char *)NULL);
        return TCL_ERROR;
    }

    /* Merge the values from each of the vectors into the current vector */
    valuePtr = valueArr;
    for (i = 0; i < refSize; i++) {
        VectorObject **vpp;

        for (vpp = vecArr; *vpp != NULL; vpp++) {
            *valuePtr++ = (*vpp)->valueArr[i];
        }
    }
    Blt_Free(vecArr);
    Blt_VecObj_Reset(vecObjPtr, valueArr, numElem, numElem, TCL_DYNAMIC);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * MinOp --
 *
 *      Returns the minimum value of the vector.
 *
 * Results:
 *      A standard TCL result. 
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
MinOp(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;

    Tcl_SetDoubleObj(Tcl_GetObjResult(interp), Blt_VecObj_Min(vecObjPtr));
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * NormalizeOp --
 *
 *      Normalizes the vector.
 *
 * Results:
 *      A standard TCL result.  If the density is invalid, TCL_ERROR is
 *      returned.  Otherwise TCL_OK is returned.
 *
 *      vecName normalize ?destName?
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
NormalizeOp(ClientData clientData, Tcl_Interp *interp, int objc,
            Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    long i;
    double range;
    
    Blt_VecObj_UpdateRange(vecObjPtr);
    range = vecObjPtr->max - vecObjPtr->min;
    if (objc > 2) {
        VectorObject *destObjPtr;

        if (GetVectorObject(interp, vecObjPtr->dataPtr, objv[2], &destObjPtr) 
            != TCL_OK) {
            return TCL_ERROR;
        }
        if (Blt_VecObj_SetLength(interp, destObjPtr, vecObjPtr->length) != TCL_OK) {
            return TCL_ERROR;
        }
        for (i = 0; i < vecObjPtr->length; i++) {
            destObjPtr->valueArr[i] = (vecObjPtr->valueArr[i] - vecObjPtr->min) / range;
        }
        Blt_VecObj_UpdateRange(destObjPtr);
        if (destObjPtr->flush) {
            Blt_VecObj_FlushCache(destObjPtr);
        }
        Blt_VecObj_UpdateClients(destObjPtr);
    } else {
        Tcl_Obj *listObjPtr;

        listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
        for (i = 0; i < vecObjPtr->length; i++) {
            double norm;

            norm = (vecObjPtr->valueArr[i] - vecObjPtr->min) / range;
            Tcl_ListObjAppendElement(interp, listObjPtr, 
                Tcl_NewDoubleObj(norm));
        }
        Tcl_SetObjResult(interp, listObjPtr);
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * NotifyOp --
 *
 *      Notify clients of vector.
 *
 * Results:
 *      A standard TCL result.  If any of the given vectors differ in size,
 *      TCL_ERROR is returned.  Otherwise TCL_OK is returned and the vector
 *      data will contain merged values of the given vectors.
 *
 *  vecName notify now
 *  vecName notify always
 *  vecName notify whenidle
 *  vecName notify update {}
 *  vecName notify delete {}
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
NotifyOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    int option;
    int bool;
    enum optionIndices {
        OPTION_ALWAYS, OPTION_NEVER, OPTION_WHENIDLE, 
        OPTION_NOW, OPTION_CANCEL, OPTION_PENDING
    };
    static const char *optionArr[] = {
        "always", "never", "whenidle", "now", "cancel", "pending", NULL
    };

    if (Tcl_GetIndexFromObj(interp, objv[2], optionArr, "qualifier", TCL_EXACT,
            &option) != TCL_OK) {
        return TCL_OK;
    }
    switch (option) {
    case OPTION_ALWAYS:
        vecObjPtr->notifyFlags &= ~NOTIFY_WHEN_MASK;
        vecObjPtr->notifyFlags |= NOTIFY_ALWAYS;
        break;
    case OPTION_NEVER:
        vecObjPtr->notifyFlags &= ~NOTIFY_WHEN_MASK;
        vecObjPtr->notifyFlags |= NOTIFY_NEVER;
        break;
    case OPTION_WHENIDLE:
        vecObjPtr->notifyFlags &= ~NOTIFY_WHEN_MASK;
        vecObjPtr->notifyFlags |= NOTIFY_WHENIDLE;
        break;
    case OPTION_NOW:
        /* FIXME: How does this play when an update is pending? */
        Blt_VecObj_NotifyClients(vecObjPtr);
        break;
    case OPTION_CANCEL:
        if (vecObjPtr->notifyFlags & NOTIFY_PENDING) {
            vecObjPtr->notifyFlags &= ~NOTIFY_PENDING;
            Tcl_CancelIdleCall(Blt_VecObj_NotifyClients, (ClientData)vecObjPtr);
        }
        break;
    case OPTION_PENDING:
        bool = (vecObjPtr->notifyFlags & NOTIFY_PENDING);
        Tcl_SetBooleanObj(Tcl_GetObjResult(interp), bool);
        break;
    }   
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * PackOp --
 *
 *      Packs the vector, throwing away empty points.
 *
 * Results:
 *      A standard TCL result. 
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
PackOp(ClientData clientData, Tcl_Interp *interp, int objc,
       Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    int i, j;

    for (i = 0, j = 0; i < vecObjPtr->length; i++) {
        if (FINITE(vecObjPtr->valueArr[i])) {
            if (j < i) {
                vecObjPtr->valueArr[j] = vecObjPtr->valueArr[i];
            }
            j++;
        }
    }
    if (j < i) {
        if (Blt_VecObj_SetLength(interp, vecObjPtr, j) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)(i - j));
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * PopulateOp --
 *
 *      Creates or resizes a new vector based upon the density specified.
 *
 * Results:
 *      A standard TCL result.  If the density is invalid, TCL_ERROR
 *      is returned.  Otherwise TCL_OK is returned.
 *
 *      vecName populate srcName density
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
PopulateOp(ClientData clientData, Tcl_Interp *interp, int objc,
           Tcl_Obj *const *objv)
{
    VectorObject *srcObjPtr;
    VectorObject *destObjPtr = clientData;
    double *valuePtr;
    long i, j, count;
    long size, density;

    if (GetVectorObject(interp, destObjPtr->dataPtr, objv[2], &srcObjPtr) 
        != TCL_OK) {
        return TCL_ERROR;
    }
    if (srcObjPtr->length == 0) {
        return TCL_OK;                  /* Source vector is empty. */
    }
    if (Tcl_GetLongFromObj(interp, objv[3], &density) != TCL_OK) {
        return TCL_ERROR;
    }
    if (density < 1) {
        Tcl_AppendResult(interp, "bad density \"", Tcl_GetString(objv[3]), 
                "\"", (char *)NULL);
        return TCL_ERROR;
    }
    size = (srcObjPtr->length - 1) * (density + 1) + 1;
    if (Blt_VecObj_SetLength(interp, destObjPtr, size) != TCL_OK) {
        return TCL_ERROR;
    }
    count = 0;
    valuePtr = destObjPtr->valueArr;
    for (i = 0; i < (srcObjPtr->length - 1); i++) {
        double slice, range;

        range = srcObjPtr->valueArr[i + 1] - srcObjPtr->valueArr[i];
        slice = range / (double)(density + 1);
        for (j = 0; j <= density; j++) {
            *valuePtr = srcObjPtr->valueArr[i] + (slice * (double)j);
            valuePtr++;
            count++;
        }
    }
    count++;
    *valuePtr = srcObjPtr->valueArr[i];    /* Save last value. */
    assert(count == destObjPtr->length);
    if (destObjPtr->flush) {
        Blt_VecObj_FlushCache(destObjPtr);
    }
    Blt_VecObj_UpdateClients(destObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ValueGetOp --
 *
 *      Get the value of the index.  This simulates what the vector's
 *      variable does.
 *
 * Results:
 *      A standard TCL result.  If the index is invalid, interp->result
 *      will an error message and TCL_ERROR is returned.  Otherwise
 *      interp->result will contain the values.
 *
 *      vecName value get index 
 *                        min, max, prod, end, ++end (bad), 
 *---------------------------------------------------------------------------
 */
static int
ValueGetOp(ClientData clientData, Tcl_Interp *interp, int objc,
           Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    int first, last;
    Blt_VectorIndexProc *indexProc;
    const char *string;
    Tcl_Obj *listObjPtr;

    string = Tcl_GetString(objv[3]);
    if (strcmp(string, "++end") == 0) {
        Tcl_AppendResult(interp, "can't get index \"", string, "\"",
                         (char *)NULL);
        return TCL_ERROR;               /* Can't read from index "++end" */
    } else if (Blt_VecObj_GetSpecialIndex(NULL, vecObjPtr, string, &indexProc)
               == TCL_OK) {
        double value;
        Tcl_Obj *objPtr;
        
        value = (*indexProc) ((Blt_Vector *)vecObjPtr);
        objPtr = Tcl_NewDoubleObj(value);
        Tcl_SetObjResult(interp, objPtr);
        return TCL_OK;
    } else if (Blt_VecObj_GetRange(interp, vecObjPtr, string) != TCL_OK) {
        return TCL_ERROR;
    }
    first = vecObjPtr->first, last = vecObjPtr->last;
    listObjPtr = GetValues(vecObjPtr, first, last);
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ValueSetOp --
 *
 *      Sets the value of the index.  This simulates what the vector's
 *      variable does.
 *
 * Results:
 *      A standard TCL result.  If the index is invalid, interp->result will
 *      an error message and TCL_ERROR is returned.  Otherwise interp->result
 *      will contain the values.
 *
 *---------------------------------------------------------------------------
 */
static int
ValueSetOp(ClientData clientData, Tcl_Interp *interp, int objc,
           Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    int first, last;
    const char *string;
    double value;

    string = Tcl_GetString(objv[3]);
    if (strcmp(string, "++end") == 0) {
        first = vecObjPtr->length;
        last = vecObjPtr->length + 1;
        if (Blt_VecObj_ChangeLength(interp, vecObjPtr, vecObjPtr->length + 1) 
            != TCL_OK) {
            return TCL_ERROR;
        }
    } else if (Blt_VecObj_GetRange(interp, vecObjPtr, string) == TCL_OK) {
        first = vecObjPtr->first, last = vecObjPtr->last;
    } else {
        return TCL_ERROR;
    }
    if (Blt_ExprDoubleFromObj(interp, objv[4], &value) != TCL_OK) {
        return TCL_ERROR;
    }
    ReplicateValue(vecObjPtr, first, last, value);
    Tcl_SetObjResult(interp, objv[4]);
    if (vecObjPtr->flush) {
        Blt_VecObj_FlushCache(vecObjPtr);
    }
    Blt_VecObj_UpdateClients(vecObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ValueUnsetOp --
 *
 *      Unsets the value of the index.  This simulates what the vector's
 *      variable does.
 *
 * Results:
 *      A standard TCL result.  If the index is invalid, interp->result will
 *      an error message and TCL_ERROR is returned.  Otherwise interp->result
 *      will contain the values.
 *
 *---------------------------------------------------------------------------
 */
static int
ValueUnsetOp(ClientData clientData, Tcl_Interp *interp, int objc,
             Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    int i;

    for (i = 3; i < objc; i++) {
        int first, last;
        const char *string;

        string = Tcl_GetString(objv[i]);
        if (Blt_VecObj_GetRange(interp, vecObjPtr, string) != TCL_OK) {
            return TCL_ERROR;
        }
        first = vecObjPtr->first, last = vecObjPtr->last;
        ReplicateValue(vecObjPtr, first, last, Blt_NaN());
    }
    if (vecObjPtr->flush) {
        Blt_VecObj_FlushCache(vecObjPtr);
    }
    Blt_VecObj_UpdateClients(vecObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ValueOp --
 *
 *      Parses and invokes the appropriate vector instance command option.
 *
 * Results:
 *      A standard TCL result.
 *
 *---------------------------------------------------------------------------
 */
static Blt_OpSpec valueOps[] =
{
    {"get",       1, ValueGetOp,   4, 4, "index",},
    {"set",       1, ValueSetOp,   4, 0, "index value",},
    {"unset",     1, ValueUnsetOp, 3, 0, "?index...?",},
};

static int numValueOps = sizeof(valueOps) / sizeof(Blt_OpSpec);

static int
ValueOp(ClientData clientData, Tcl_Interp *interp, int objc,
        Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    Tcl_ObjCmdProc *proc;

    vecObjPtr->first = 0;
    vecObjPtr->last = vecObjPtr->length;
    proc = Blt_GetOpFromObj(interp, numValueOps, valueOps, BLT_OP_ARG2, objc,
        objv, 0);
    if (proc == NULL) {
        return TCL_ERROR;
    }
    return (*proc) (vecObjPtr, interp, objc, objv);
}

/*
 *---------------------------------------------------------------------------
 *
 * ValuesOp --
 *
 *      Print the values vector.
 *
 * Results:
 *      A standard TCL result.  
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
ValuesOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    ValuesSwitches switches;
    Tcl_Obj *listObjPtr;

    switches.formatObjPtr = NULL;
    switches.from = 0;
    switches.to = vecObjPtr->length - 1;
    switches.empty = TRUE;
    indexSwitch.clientData = vecObjPtr;
    if (Blt_ParseSwitches(interp, valuesSwitches, objc - 2, objv + 2, &switches,
        BLT_SWITCH_DEFAULTS) < 0) {
        return TCL_ERROR;
    }
    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
    if (switches.formatObjPtr == NULL) {
        int i;

        listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
        if (switches.empty) {
            for (i = switches.from; i <= switches.to; i++) {
                Tcl_ListObjAppendElement(interp, listObjPtr, 
                        Tcl_NewDoubleObj(vecObjPtr->valueArr[i]));
            }
        } else {
            for (i = switches.from; i <= switches.to; i++) {
                if (FINITE(vecObjPtr->valueArr[i])) {
                    Tcl_ListObjAppendElement(interp, listObjPtr, 
                        Tcl_NewDoubleObj(vecObjPtr->valueArr[i]));
                }
            }
        }
    } else {
        char buffer[200];
        const char *fmt;
        int i;

        fmt = Tcl_GetString(switches.formatObjPtr);
        if (switches.empty) {
            for (i = switches.from; i <= switches.to; i++) {
                sprintf(buffer, fmt, vecObjPtr->valueArr[i]);
                Tcl_ListObjAppendElement(interp, listObjPtr, 
                        Tcl_NewStringObj(buffer, -1));
            }
        } else {
            for (i = switches.from; i <= switches.to; i++) {
                if (FINITE(vecObjPtr->valueArr[i])) {
                    sprintf(buffer, fmt, vecObjPtr->valueArr[i]);
                    Tcl_ListObjAppendElement(interp, listObjPtr, 
                        Tcl_NewStringObj(buffer, -1));
                }
            }
        }
    }
    Tcl_SetObjResult(interp, listObjPtr);
    Blt_FreeSwitches(valuesSwitches, &switches, 0);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * AppendFormatToObj --
 *
 *      This function appends a list of Tcl_Obj's to a Tcl_Obj according to
 *      the formatting instructions embedded in the format string. The
 *      formatting instructions are inspired by sprintf(). Returns TCL_OK
 *      when successful. If there's an error in the arguments, TCL_ERROR is
 *      returned, and an error message is written to the interp, if
 *      non-NULL.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
#define FMT_ALLOCSEGMENT (1<<0)
#define FMT_CHAR        (1<<1)
#define FMT_HASH        (1<<2)
#define FMT_ISNEGATIVE  (1<<3)
#define FMT_LONG        (1<<4)
#define FMT_LONGLONG    (1<<5)
#define FMT_MINUS       (1<<6)
#define FMT_NEWXPG      (1<<7)
#define FMT_PLUS        (1<<8)
#define FMT_PRECISION   (1<<9)
#define FMT_SEQUENTIAL  (1<<10)
#define FMT_SHORT       (1<<11)
#define FMT_SPACE       (1<<12)
#define FMT_USEWIDE     (1<<13)
#define FMT_WIDTH       (1<<14)
#define FMT_XPG         (1<<15)
#define FMT_ZERO        (1<<16)

typedef struct {
    int precision;                      /* Precision to use. */
    int width;                          /* Minimum field width. */
    unsigned int flags;
    Tcl_UniChar ch;                     /* Last character parsed. */
} FormatParser;

static Tcl_Obj *
FormatDouble(Tcl_Interp *interp, double d, FormatParser *parserPtr)
{
#define MAX_FLOAT_SIZE 320
    Tcl_Obj *objPtr;
    char spec[2*TCL_INTEGER_SPACE + 9];
    char *p;
    static const char *overflow = "max size for a Tcl value exceeded";
    int length;
    char *bytes;

    length = MAX_FLOAT_SIZE;
    p = spec;
    *p++ = '%';
    if (parserPtr->flags & FMT_MINUS) {
        *p++ = '-';
    }
    if (parserPtr->flags & FMT_HASH) {
        *p++ = '#';
    }
    if (parserPtr->flags & FMT_ZERO) {
        *p++ = '0';
    }
    if (parserPtr->flags & FMT_SPACE) {
        *p++ = ' ';
    }
    if (parserPtr->flags & FMT_PLUS) {
        *p++ = '+';
    }
    if (parserPtr->flags & FMT_WIDTH) {
        p += sprintf(p, "%d", parserPtr->width);
        if (parserPtr->width > length) {
            length = parserPtr->width;
        }
    }
    if (parserPtr->flags & FMT_PRECISION) {
        *p++ = '.';
        p += sprintf(p, "%d", parserPtr->precision);
        if (parserPtr->precision > INT_MAX - length) {
            Tcl_AppendResult(interp, overflow, (char *)NULL);
            return NULL;
        }
        length += parserPtr->precision;
    }
    /*
     * Don't pass length modifiers!
     */
    *p++ = (char) parserPtr->ch;
    *p = '\0';
    objPtr = Tcl_NewObj();
    parserPtr->flags |= FMT_ALLOCSEGMENT;
    if (!Tcl_AttemptSetObjLength(objPtr, length)) {
        Tcl_AppendResult(interp, overflow, (char *)NULL);
        return NULL;
    }
    bytes = Tcl_GetString(objPtr);
    if (!Tcl_AttemptSetObjLength(objPtr, sprintf(bytes, spec, d))) {
        Tcl_AppendResult(interp, overflow, (char *)NULL);
        return NULL;
    }
    return objPtr;
}

static Tcl_Obj *
FormatLong(Tcl_Interp *interp, double d, FormatParser *parserPtr)
{
    Tcl_Obj *objPtr;
    char spec[2*TCL_INTEGER_SPACE + 9];
    char *p;
    int length;
    char *bytes;
    static const char *overflow = "max size for a Tcl value exceeded";
    length = MAX_FLOAT_SIZE;
    
    parserPtr->flags &= ~FMT_ISNEGATIVE;
    if (parserPtr->flags & FMT_LONGLONG) {
        int64_t ll;

        ll = (int64_t)d;
        if (ll < 0) {
            parserPtr->flags |= FMT_ISNEGATIVE;
        }
    } else if (parserPtr->flags & FMT_LONG) {
        long l;

        l = (long int)d;
        if (l < 0) {
            parserPtr->flags |= FMT_ISNEGATIVE;
        }
    } else if (parserPtr->flags & FMT_SHORT) {
        short s;

        s = (short int)d;
        if (s < 0) {
            parserPtr->flags |= FMT_ISNEGATIVE;
        }
    } else {
        long l;

        l = (long)d;
        if (l < (long)0) {
            parserPtr->flags |= FMT_ISNEGATIVE;
        }
    }
    objPtr = Tcl_NewObj();
    parserPtr->flags |= FMT_ALLOCSEGMENT;
    Tcl_IncrRefCount(objPtr);
    
    if ((parserPtr->flags & (FMT_ISNEGATIVE | FMT_PLUS | FMT_SPACE)) && 
        ((parserPtr->flags & FMT_LONGLONG) || (parserPtr->ch == 'd'))) {
        Tcl_AppendToObj(objPtr, 
                        ((parserPtr->flags & FMT_ISNEGATIVE) ? "-" : 
                         (parserPtr->flags & FMT_PLUS) ? "+" : " "), 1);
    }
    if (parserPtr->flags & FMT_HASH) {
        switch (parserPtr->ch) {
        case 'o':
            Tcl_AppendToObj(objPtr, "0", 1);
            parserPtr->precision--;
            break;
        case 'x':
        case 'X':
            Tcl_AppendToObj(objPtr, "0x", 2);
            break;
        }
    }
    p = spec;
    *p++ = '%';
    if (parserPtr->flags & FMT_MINUS) {
        *p++ = '-';
    }
    if (parserPtr->flags & FMT_HASH) {
        *p++ = '#';
    }
    if (parserPtr->flags & FMT_ZERO) {
        *p++ = '0';
    }
    if (parserPtr->flags & FMT_SPACE) {
        *p++ = ' ';
    }
    if (parserPtr->flags & FMT_PLUS) {
        *p++ = '+';
    }
    if (parserPtr->flags & FMT_WIDTH) {
        p += sprintf(p, "%d", parserPtr->width);
        if (parserPtr->width > length) {
            length = parserPtr->width;
        }
    }
    if (parserPtr->flags & FMT_PRECISION) {
        *p++ = '.';
        p += sprintf(p, "%d", parserPtr->precision);
        if (parserPtr->precision > INT_MAX - length) {
            Tcl_AppendResult(interp, overflow, (char *)NULL);
            return NULL;
        }
        length += parserPtr->precision;
    }
    /*
     * Don't pass length modifiers!
     */
    *p++ = (char)parserPtr->ch;
    *p = '\0';

    objPtr = Tcl_NewObj();
    parserPtr->flags |= FMT_ALLOCSEGMENT;
    if (!Tcl_AttemptSetObjLength(objPtr, length)) {
        Tcl_AppendResult(interp, overflow, (char *)NULL);
        return NULL;
    }
    bytes = Tcl_GetString(objPtr);
    if (!Tcl_AttemptSetObjLength(objPtr, sprintf(bytes, spec, d))) {
        Tcl_AppendResult(interp, overflow, (char *)NULL);
        return NULL;
    }
    return objPtr;
}

static int
AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *appendObjPtr, const char *format,
                  int *offsetPtr, VectorObject *vecObjPtr, int maxOffset)
{
    FormatParser parser;
    const char *span = format, *msg;
    int numBytes = 0, index, count;
    int originalLength, limit, offset;
    static const char *mixedXPG =
            "cannot mix \"%\" and \"%n$\" conversion specifiers";
    static const char *badIndex[2] = {
        "not enough arguments for all format specifiers",
        "\"%n$\" argument index out of range"
    };
    static const char *overflow = "max size for a Tcl value exceeded";

    msg = overflow;
    if (Tcl_IsShared(appendObjPtr)) {
        Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
    }
    Tcl_GetStringFromObj(appendObjPtr, &originalLength);
    limit = INT_MAX - originalLength;

    memset(&parser, 0, sizeof(parser));
    /*
     * Format string is NUL-terminated.
     */
    span = format;
    count = index = 0;
    offset = *offsetPtr;
    while (*format != '\0') {
        char *end;
        int numChars, segmentNumBytes;
        Tcl_Obj *segment;
        int step, done;
        double d;

        step = Tcl_UtfToUniChar(format, &parser.ch);
        format += step;
        if (parser.ch != '%') {
            numBytes += step;
            continue;
        }
        if (numBytes > 0) {
            if (numBytes > limit) {
                msg = overflow;
                goto errorMsg;
            }
            Tcl_AppendToObj(appendObjPtr, span, numBytes);
            limit -= numBytes;
            numBytes = 0;
        }

        /*
         * Saw a '%'. Process the format specifier.
         *
         * Step 0. Handle special case of escaped format marker (i.e., %%).
         */
        step = Tcl_UtfToUniChar(format, &parser.ch);
        if (parser.ch == '%') {
            span = format;
            numBytes = step;
            format += step;
            continue;                   /* This is an escaped percent. */
        }

        /*
         * Step 1. XPG3 position specifier
         */
        parser.flags &= ~FMT_NEWXPG;
        if (isdigit(UCHAR(parser.ch))) {
            int position;
            char *end;

            position = strtoul(format, &end, 10);
            if (*end == '$') {
                parser.flags |= FMT_NEWXPG;
                index = position - 1;
                format = end + 1;
                step = Tcl_UtfToUniChar(format, &parser.ch);
            }
        }
        if (parser.flags & FMT_NEWXPG) {
            if (parser.flags & FMT_SEQUENTIAL) {
                msg = mixedXPG;
                goto errorMsg;
            }
            parser.flags |= FMT_XPG;
        } else {
            if (parser.flags & FMT_XPG) {
                msg = mixedXPG;
                goto errorMsg;
            }
            parser.flags |= FMT_SEQUENTIAL;
        }
        if (index < 0) {
            /* Index is outside of available vector elements. */
            msg = badIndex[(parser.flags & FMT_XPG) != 0];
            goto errorMsg;              
        }

        /*
         * Step 2. Set of parser.flags.
         */
        parser.flags &= ~(FMT_MINUS|FMT_HASH|FMT_ZERO|FMT_SPACE|FMT_PLUS);
        done = FALSE;
        do {
            switch (parser.ch) {
            case '-': parser.flags |= FMT_MINUS;        break;
            case '#': parser.flags |= FMT_HASH;         break;
            case '0': parser.flags |= FMT_ZERO;         break;
            case ' ': parser.flags |= FMT_SPACE;        break;
            case '+': parser.flags |= FMT_PLUS;         break;
            default:
                done = TRUE;
            }
            if (!done) {
                format += step;
                step = Tcl_UtfToUniChar(format, &parser.ch);
            }
        } while (!done);

        /*
         * Step 3. Minimum field width.
         */
        parser.width = 0;
        if (isdigit(UCHAR(parser.ch))) {
            parser.flags |= FMT_WIDTH;
            parser.width = strtoul(format, &end, 10);
            format = end;
            step = Tcl_UtfToUniChar(format, &parser.ch);
        } else if (parser.ch == '*') {
            msg = "can't specify '*' in field width";
            goto errorMsg;
        }
        if (parser.width > limit) {
            msg = overflow;
            goto errorMsg;
        }

        /*
         * Step 4. Precision.
         */

        parser.flags &= ~(FMT_PRECISION);
        parser.precision = 0;
        if (parser.ch == '.') {
            parser.flags |= FMT_PRECISION;
            format += step;
            step = Tcl_UtfToUniChar(format, &parser.ch);
        }
        if (isdigit(UCHAR(parser.ch))) {
            parser.precision = strtoul(format, &end, 10);
            format = end;
            step = Tcl_UtfToUniChar(format, &parser.ch);
        } else if (parser.ch == '*') {
            msg = "can't specify '*' in precision";
            goto errorMsg;
        }

        /*
         * Step 5. Length modifier.
         */
        if (parser.ch == 'h') {
            format += step;
            step = Tcl_UtfToUniChar(format, &parser.ch);
            if (parser.ch == 'h') {
                parser.flags |= FMT_CHAR;
                format += step;
                step = Tcl_UtfToUniChar(format, &parser.ch);
            } else {
                parser.flags |= FMT_SHORT;
            }
        } else if (parser.ch == 'l') {
            format += step;
            step = Tcl_UtfToUniChar(format, &parser.ch);
            if (parser.ch == 'l') {
                parser.flags |= FMT_LONGLONG;
                format += step;
                step = Tcl_UtfToUniChar(format, &parser.ch);
            } else {
                parser.flags |= FMT_LONG;
            }
        }
        format += step;
        span = format;

        /*
         * Step 6. The actual conversion character.
         */
        if ((index + offset) > maxOffset) {
            continue;
        }
        d = vecObjPtr->valueArr[offset + index];
        numChars = -1;
        if (parser.ch == 'i') {
            parser.ch = 'd';
        }
        switch (parser.ch) {
        case '\0':
            msg = "format string ended in middle of field specifier";
            goto errorMsg;
        case 's':
            msg = "can't use %s or %c as field specifier";
            goto errorMsg;
        case 'u':
            if (parser.flags & FMT_LONGLONG) {
                msg = "unsigned bignum format is invalid";
                goto errorMsg;
            }
        case 'd':
        case 'o':
        case 'x':
        case 'X': 
            segment = FormatLong(interp, d, &parser);
            if (segment == NULL) {
                goto errorMsg;
            }
            break;

        case 'e':
        case 'E':
        case 'f':
        case 'g':
        case 'G': 
            segment = FormatDouble(interp, d, &parser);
            if (segment == NULL) {
                goto error;
            }
            break;

        default:
            if (interp != NULL) {
                char mesg[200];
                    
                sprintf(mesg, "bad field specifier \"%c\"", parser.ch);
                Tcl_AppendResult(interp, mesg, (char *)NULL);
            }
            goto error;
        }

        switch (parser.ch) {
        case 'E':
        case 'G':
        case 'X': {
            Tcl_SetObjLength(segment, Tcl_UtfToUpper(Tcl_GetString(segment)));
        }
        }

        if (parser.flags & FMT_WIDTH) {
            if (numChars < 0) {
                numChars = Tcl_GetCharLength(segment);
            }
            if (!(parser.flags & FMT_MINUS)) {
                if (numChars < parser.width) {
                    limit -= (parser.width - numChars);
                }
                while (numChars < parser.width) {
                    Tcl_AppendToObj(appendObjPtr, (FMT_ZERO ? "0" : " "), 1);
                    numChars++;
                }
            }
        }

        Tcl_GetStringFromObj(segment, &segmentNumBytes);
        if (segmentNumBytes > limit) {
            if (parser.flags & FMT_ALLOCSEGMENT) {
                Tcl_DecrRefCount(segment);
            }
            msg = overflow;
            goto errorMsg;
        }
        Tcl_AppendObjToObj(appendObjPtr, segment);
        limit -= segmentNumBytes;
        if (parser.flags & FMT_ALLOCSEGMENT) {
            Tcl_DecrRefCount(segment);
        }
        if (parser.flags & FMT_WIDTH) {
            if (numChars < parser.width) {
                limit -= (parser.width - numChars);
            }
            while (numChars < parser.width) {
                Tcl_AppendToObj(appendObjPtr, (FMT_ZERO ? "0" : " "), 1);
                numChars++;
            }
        }

        if (parser.flags & FMT_SEQUENTIAL) {
            index++;
        }
        count++;
    }
    if (numBytes) {
        if (numBytes > limit) {
            msg = overflow;
            goto errorMsg;
        }
        Tcl_AppendToObj(appendObjPtr, span, numBytes);
        limit -= numBytes;
    }
    *offsetPtr = offset + count;
    return TCL_OK;

  errorMsg:
    if (interp != NULL) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
    }
  error:
    Tcl_SetObjLength(appendObjPtr, originalLength);
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * ParseFormat --
 *
 *      Parses a printf-like format string into individual points.
 *
 * Results:
 *      A standard TCL result.  
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
ParseFormat(const char *format, int *numFmtsPtr, char ***fmtPtr)
{
    const char *p;
    char *q;
    char *string;
    char **fmt;
    size_t addrLength, length;
    int count, first;

    /* Step 1:  Find out how may descriptors exist. */
    count = 0;
    for (p = format; *p != '\0'; p++) {
        if (p[0] == '%') {
            if (p[1] == '%') {
                p+= 2;
                continue;
            }
            count++;
        }
    }
    /* Step 2: Create a format array to hold the individual descriptors. */
    length = count + (p - format) + 1;
    addrLength = (count + 1) * sizeof(char **);
    *numFmtsPtr = count;
    fmt = Blt_AssertMalloc(addrLength + length);
    string = (char *)fmt + addrLength;

    /* Step 3:  Load the format array with individual descriptors. */
    count = 1;
    fmt[0] = string;
    first = 0;
    for (q = string, p = format; *p != '\0'; p++) {
        if (p[0] == '%') {
            if (p[1] == '%') {
                q[0] = q[1] = '%';
                q += 2;
                p += 2;
                continue;
            }
            if (first > 0) {
                *q = '\0';
                q++;
                fmt[count++] = q;
            }
            first++;
            *q = '%';
            q++;
            continue;
        }
        *q = *p;
        q++;
    }
    *q = '\0';
    fmt[count] = NULL;
    *fmtPtr = fmt;
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * PrintOp --
 *
 *      Print the values vector according to the given format.
 *
 * Results:
 *      A standard TCL result.  
 *
 *      $v print $format ?switches?
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
PrintOp(ClientData clientData, Tcl_Interp *interp, int objc,
        Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    PrintSwitches switches;
    Tcl_Obj *objPtr;
    char **argv;
    int argc;
    char *fmt;
    int i;

    switches.from = 0;
    switches.to = vecObjPtr->length - 1;
    indexSwitch.clientData = vecObjPtr;

    fmt = Tcl_GetString(objv[2]);
    ParseFormat(fmt, &argc, &argv);
    if (argc == 0) {
        Tcl_AppendResult(interp, "format \"", fmt, "\" contains no specifiers", 
                         (char *)NULL);
        return TCL_ERROR;
    }
    if (Blt_ParseSwitches(interp, printSwitches, objc - 3, objv + 3, &switches,
        BLT_SWITCH_DEFAULTS) < 0) {
        return TCL_ERROR;
    }
    objPtr = Tcl_NewStringObj("", 0);
    for (i = switches.from; i <= switches.to; /*empty*/) {
        if (FINITE(vecObjPtr->valueArr[i])) {
            char string[200];
            int n;

            n = (i % argc);
            fmt = argv[n];
            sprintf(string, fmt, vecObjPtr->valueArr[i]);
            AppendFormatToObj(interp, objPtr, fmt, &i, vecObjPtr, switches.to);
        }
    }
    Blt_Free(argv);
    Tcl_SetObjResult(interp, objPtr);
    Blt_FreeSwitches(printSwitches, &switches, 0);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * RangeOp --
 *
 *      Returns a TCL list of the range of vector values specified.
 *
 * Results:
 *      A standard TCL result.  If the given range is invalid, TCL_ERROR
 *      is returned.  Otherwise TCL_OK is returned and interp->result
 *      will contain the list of values.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
RangeOp(ClientData clientData, Tcl_Interp *interp, int objc,
        Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    Tcl_Obj *listObjPtr;
    int first, last, i;

    if (objc == 2) {
        first = 0;
        last = vecObjPtr->length;
    } else if (objc == 4) {
        if ((Blt_VecObj_GetIndex(interp, vecObjPtr, Tcl_GetString(objv[2]), 
                                 &first) != TCL_OK) ||
            (Blt_VecObj_GetIndex(interp, vecObjPtr, Tcl_GetString(objv[3]), 
                                 &last) != TCL_OK)) {
            return TCL_ERROR;
        }
        last++;
    } else {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
                Tcl_GetString(objv[0]), " range ?first last?\"", (char *)NULL);
        return TCL_ERROR;       
    }
    if (vecObjPtr->length == 0) {
        return TCL_OK;                  /* Ignore range on empty vector */
    }
    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
    if (first > last) {
        /* Return the list reversed */
        for (i = last; i < first; i++) {
            Tcl_ListObjAppendElement(interp, listObjPtr, 
                Tcl_NewDoubleObj(vecObjPtr->valueArr[i]));
        }
    } else {
        for (i = first; i < last; i++) {
            Tcl_ListObjAppendElement(interp, listObjPtr, 
                Tcl_NewDoubleObj(vecObjPtr->valueArr[i]));
        }
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * IsBetween --
 *
 *      Determines if a value lies within a given range.
 *
 *      The value is normalized and compared against the interval
 *      [0..1], where 0.0 is the minimum and 1.0 is the maximum.
 *      DBL_EPSILON is the smallest number that can be represented
 *      on the host machine, such that (1.0 + epsilon) != 1.0.
 *
 *      Please note, min cannot be greater than max.
 *
 * Results:
 *      If the value is within of the interval [min..max], 1 is 
 *      returned; 0 otherwise.
 *
 *---------------------------------------------------------------------------
 */
INLINE static int
IsBetween(double value, double min, double max)
{
    double range;

    range = max - min;
    if (range < DBL_EPSILON) {
        return (FABS(max - value) < DBL_EPSILON);
    } else {
        double norm;

        norm = (value - min) / range;
        return ((norm >= -DBL_EPSILON) && ((norm - 1.0) < DBL_EPSILON));
    }
}

enum NativeFormats {
    NF_UNKNOWN = -1,
    NF_UCHAR, NF_CHAR,
    NF_USHORT, NF_SHORT,
    NF_UINT, NF_INT,
    NF_ULONG, NF_LONG,
    NF_FLOAT, NF_DOUBLE
};

/*
 *---------------------------------------------------------------------------
 *
 * GetBinaryFormat
 *
 *      Translates a format string into a native type.  Valid formats are
 *
 *              signed          i1, i2, i4, i8
 *              unsigned        u1, u2, u4, u8
 *              real            r4, r8, r16
 *
 *      There must be a corresponding native type.  For example, this for
 *      reading 2-byte binary integers from an instrument and converting them
 *      to unsigned shorts or ints.
 *
 *---------------------------------------------------------------------------
 */
static enum NativeFormats
GetBinaryFormat(Tcl_Interp *interp, const char *string, int *sizePtr)
{
    char c;

    c = tolower(string[0]);
    if (Tcl_GetInt(interp, string + 1, sizePtr) != TCL_OK) {
        Tcl_AppendResult(interp, "unknown binary format \"", string,
            "\": incorrect byte size", (char *)NULL);
        return NF_UNKNOWN;
    }
    switch (c) {
    case 'r':
        if (*sizePtr == sizeof(double)) {
            return NF_DOUBLE;
        } else if (*sizePtr == sizeof(float)) {
            return NF_FLOAT;
        }
        break;

    case 'i':
        if (*sizePtr == sizeof(char)) {
            return NF_CHAR;
        } else if (*sizePtr == sizeof(int)) {
            return NF_INT;
        } else if (*sizePtr == sizeof(long)) {
            return NF_LONG;
        } else if (*sizePtr == sizeof(short)) {
            return NF_SHORT;
        }
        break;

    case 'u':
        if (*sizePtr == sizeof(unsigned char)) {
            return NF_UCHAR;
        } else if (*sizePtr == sizeof(unsigned int)) {
            return NF_UINT;
        } else if (*sizePtr == sizeof(unsigned long)) {
            return NF_ULONG;
        } else if (*sizePtr == sizeof(unsigned short)) {
            return NF_USHORT;
        }
        break;

    default:
        Tcl_AppendResult(interp, "unknown binary format \"", string,
            "\": should be either i#, r#, u# (where # is size in bytes)",
            (char *)NULL);
        return NF_UNKNOWN;
    }
    Tcl_AppendResult(interp, "can't handle format \"", string, "\"", 
                     (char *)NULL);
    return NF_UNKNOWN;
}

static int
CopyValues(VectorObject *vecObjPtr, char *byteArr, enum NativeFormats fmt, 
           int size, int length, int swap, int *indexPtr)
{
    int newSize, i, n;

    if ((swap) && (size > 1)) {
        int numBytes = size * length;

        for (i = 0; i < numBytes; i += size) {
            int left, right;
            unsigned char *p;
        
            p = (unsigned char *)(byteArr + i);
            for (left = 0, right = size - 1; left < right; left++, right--) {
                p[left] ^= p[right];
                p[right] ^= p[left];
                p[left] ^= p[right];
            }

        }
    }
    newSize = *indexPtr + length;
    if (newSize > vecObjPtr->length) {
        if (Blt_VecObj_ChangeLength(vecObjPtr->interp, vecObjPtr, newSize) 
            != TCL_OK) {
            return TCL_ERROR;
        }
    }
#define CopyArrayToVector(vecObjPtr, arr) \
    for (i = 0, n = *indexPtr; i < length; i++, n++) { \
        (vecObjPtr)->valueArr[n] = (double)(arr)[i]; \
    }

    switch (fmt) {
    case NF_CHAR:
        CopyArrayToVector(vecObjPtr, (char *)byteArr);
        break;

    case NF_UCHAR:
        CopyArrayToVector(vecObjPtr, (unsigned char *)byteArr);
        break;

    case NF_INT:
        CopyArrayToVector(vecObjPtr, (int *)byteArr);
        break;

    case NF_UINT:
        CopyArrayToVector(vecObjPtr, (unsigned int *)byteArr);
        break;

    case NF_LONG:
        CopyArrayToVector(vecObjPtr, (long *)byteArr);
        break;

    case NF_ULONG:
        CopyArrayToVector(vecObjPtr, (unsigned long *)byteArr);
        break;

    case NF_SHORT:
        CopyArrayToVector(vecObjPtr, (short int *)byteArr);
        break;

    case NF_USHORT:
        CopyArrayToVector(vecObjPtr, (unsigned short int *)byteArr);
        break;

    case NF_FLOAT:
        CopyArrayToVector(vecObjPtr, (float *)byteArr);
        break;

    case NF_DOUBLE:
        CopyArrayToVector(vecObjPtr, (double *)byteArr);
        break;

    case NF_UNKNOWN:
        break;
    }
    *indexPtr += length;
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * BinreadOp --
 *
 *      Reads binary values from a TCL channel. Values are either appended
 *      to the end of the vector or placed at a given index (using the
 *      "-at" option), overwriting existing values.  Data is read until EOF
 *      is found on the channel or a specified number of values are read.
 *      (note that this is not necessarily the same as the number of
 *      bytes).
 *
 *      The following flags are supported:
 *              -swap           Swap bytes
 *              -at index       Start writing data at the index.
 *              -format fmt     Specifies the format of the data.
 *
 *      This binary reader was created and graciously donated by Harald
 *      Kirsch (kir@iitb.fhg.de).  Anything that's wrong is due to my (gah)
 *      munging of the code.
 *
 * Results:
 *      Returns a standard TCL result. The interpreter result will contain
 *      the number of values (not the number of bytes) read.
 *
 * Caveats:
 *      Channel reads must end on an element boundary.
 *
 *      vecName binread channel count ?switches?
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
BinreadOp(ClientData clientData, Tcl_Interp *interp, int objc,
          Tcl_Obj *const *objv)
{
    Tcl_Channel channel;
    VectorObject *vecObjPtr = clientData;
    char *byteArr;
    const char *string;
    enum NativeFormats fmt;
    int fmtSize;
    int mode, swap;
    int count, total, first, i;
    size_t arraySize;

    string = Tcl_GetString(objv[2]);
    channel = Tcl_GetChannel(interp, string, &mode);
    if (channel == NULL) {
        return TCL_ERROR;
    }
    if ((mode & TCL_READABLE) == 0) {
        Tcl_AppendResult(interp, "channel \"", string,
            "\" wasn't opened for reading", (char *)NULL);
        return TCL_ERROR;
    }
    first = vecObjPtr->length;
    fmt = NF_DOUBLE;
    fmtSize = sizeof(double);
    swap = FALSE;
    count = 0;

    if (objc > 3) {
        string = Tcl_GetString(objv[3]);
        if (string[0] != '-') {
            /* Get the number of values to read.  */
            if (Tcl_GetIntFromObj(interp, objv[3], &count) != TCL_OK) {
                return TCL_ERROR;
            }
            objc--, objv++;
        }
    }
    /* Process any option-value pairs that remain.  */
    for (i = 3; i < objc; i++) {
        string = Tcl_GetString(objv[i]);
        if (strcmp(string, "-swap") == 0) {
            swap = TRUE;
        } else if (strcmp(string, "-format") == 0) {
            i++;
            if (i >= objc) {
                Tcl_AppendResult(interp, "missing arg after \"", string,
                    "\"", (char *)NULL);
                return TCL_ERROR;
            }
            string = Tcl_GetString(objv[i]);
            fmt = GetBinaryFormat(interp, string, &fmtSize);
            if (fmt == NF_UNKNOWN) {
                return TCL_ERROR;
            }
        } else if (strcmp(string, "-at") == 0) {
            i++;
            if (i >= objc) {
                Tcl_AppendResult(interp, "missing arg after \"", string,
                    "\"", (char *)NULL);
                return TCL_ERROR;
            }
            string = Tcl_GetString(objv[i]);
            if (Blt_VecObj_GetIndex(interp, vecObjPtr, string, &first) 
                != TCL_OK) {
                return TCL_ERROR;
            }
            if (first > vecObjPtr->length) {
                Tcl_AppendResult(interp, "index \"", string,
                    "\" is out of range", (char *)NULL);
                return TCL_ERROR;
            }
        }
    }

#define BUFFER_SIZE 1024
    if (count == 0) {
        arraySize = BUFFER_SIZE * fmtSize;
    } else {
        arraySize = count * fmtSize;
    }

    byteArr = Blt_AssertMalloc(arraySize);
    /* FIXME: restore old channel translation later? */
    if (Tcl_SetChannelOption(interp, channel, "-translation",
            "binary") != TCL_OK) {
        return TCL_ERROR;
    }
    total = 0;
    while (!Tcl_Eof(channel)) {
        int length;
        ssize_t bytesRead;

        bytesRead = Tcl_Read(channel, byteArr, arraySize);
        if (bytesRead < 0) {
            Tcl_AppendResult(interp, "error reading channel: ",
                Tcl_PosixError(interp), (char *)NULL);
            return TCL_ERROR;
        }
        if ((bytesRead % fmtSize) != 0) {
            Tcl_AppendResult(interp, "error reading channel: short read",
                (char *)NULL);
            return TCL_ERROR;
        }
        length = bytesRead / fmtSize;
        if (CopyValues(vecObjPtr, byteArr, fmt, fmtSize, length, swap, &first)
            != TCL_OK) {
            return TCL_ERROR;
        }
        total += length;
        if (count > 0) {
            break;
        }
    }
    Blt_Free(byteArr);

    if (vecObjPtr->flush) {
        Blt_VecObj_FlushCache(vecObjPtr);
    }
    Blt_VecObj_UpdateClients(vecObjPtr);

    /* Set the result as the number of values read.  */
    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), total);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ExportOp --
 *
 *      Exports the vector as a binary bytearray.
 *
 * Results:
 *      A standard TCL result.  
 *
 *      vecName bytearray ?-empty bool -format float|double -from -to?
 *      vecName bytearray obj
 *
 *      vecName import float -data obj -file file ?switches?
 *      vecName export float -data obj -file file 
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
ExportOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    ExportSwitches switches;
    int numValues;
    char *fmt;
    int format;
    Blt_DBuffer dbuffer;
    int result;

#define FMT_FLOAT       0
#define FMT_DOUBLE      1
    memset(&switches, 0, sizeof(switches));
    switches.from = 0;
    switches.to = vecObjPtr->length - 1;
    switches.empty = Blt_NaN();
    indexSwitch.clientData = vecObjPtr;
    fmt = Tcl_GetString(objv[2]);
    if (strcmp(fmt, "double") == 0) {
        format = FMT_DOUBLE;
    } else if (strcmp(fmt, "float") == 0) {
        format = FMT_FLOAT;
    } else {
        Tcl_AppendResult(interp, "unknown export format \"", fmt, "\"",
                         (char *)NULL);
        return TCL_ERROR;
    }
    if (Blt_ParseSwitches(interp, exportSwitches, objc - 3, objv + 3, 
                          &switches, BLT_SWITCH_DEFAULTS) < 0) {
        return TCL_ERROR;
    }
    numValues = switches.to - switches.from + 1;
    dbuffer = Blt_DBuffer_Create();
    if (format == FMT_DOUBLE) {
        double *darray;
        size_t count;

        Blt_DBuffer_SetLength(dbuffer, numValues * sizeof(double));
        darray = (double *)Blt_DBuffer_Bytes(dbuffer);
        count = 0;
        if (switches.empty) {
            long i;

            for (i = switches.from; i <= switches.to; i++) {
                darray[count] = vecObjPtr->valueArr[i];
                count++;
            }
        } else {
            long i;

            for (i = switches.from; i <= switches.to; i++) {
                if (FINITE(vecObjPtr->valueArr[i])) {
                    darray[count] = vecObjPtr->valueArr[i];
                    count++;
                }
            }
        }
        Blt_DBuffer_SetLength(dbuffer, count * sizeof(double));
    } else if (format == FMT_FLOAT) {
        float *farray;
        size_t count;

        Blt_DBuffer_SetLength(dbuffer, numValues * sizeof(float));
        farray = (float *)Blt_DBuffer_Bytes(dbuffer);
        count = 0;
        if (switches.empty) {
            int i;

            for (i = switches.from; i <= switches.to; i++) {
                farray[count] = (float)vecObjPtr->valueArr[i];
                count++;
            }
        } else {
            int i;

            for (i = switches.from; i <= switches.to; i++) {
                if (FINITE(vecObjPtr->valueArr[i])) {
                    farray[count] = (float)vecObjPtr->valueArr[i];
                    count++;
                }
            }
        }
        Blt_DBuffer_SetLength(dbuffer, count * sizeof(float));
    }
    if (switches.fileObjPtr != NULL) {
        const char *fileName;

        /* Write the image into the designated file. */
        fileName = Tcl_GetString(switches.fileObjPtr);
        result = Blt_DBuffer_SaveFile(interp, fileName, dbuffer);
    } else if (switches.dataObjPtr != NULL) {
        Tcl_Obj *objPtr;

        /* Write the image into the designated TCL variable. */
        objPtr = Tcl_ObjSetVar2(interp, switches.dataObjPtr, NULL, 
                Blt_DBuffer_ByteArrayObj(dbuffer), 0);
        result = (objPtr == NULL) ? TCL_ERROR : TCL_OK;
    } else {
        Tcl_Obj *objPtr;

        /* Return the image as a base64 string in the interpreter result. */
        result = TCL_ERROR;
        objPtr = Blt_DBuffer_Base64EncodeToObj(dbuffer);
        if (objPtr != NULL) {
            Tcl_SetObjResult(interp, objPtr);
            result = TCL_OK;
        }
    }
    Blt_FreeSwitches(exportSwitches, (char *)&switches, 0);
    Blt_DBuffer_Destroy(dbuffer);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * CountOp --
 *
 *      Returns the number of values in the vector.  This excludes
 *      empty values.
 *
 * Results:
 *      A standard TCL result.  
 *
 *---------------------------------------------------------------------------
 */
static int
CountOp(ClientData clientData, Tcl_Interp *interp, int objc,
        Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    int count;
    const char *string;
    char c;

    string = Tcl_GetString(objv[2]);
    c = string[0];
    count = 0;
    if ((c == 'e') && (strcmp(string, "empty") == 0)) {
        int i;

        for (i = 0; i < vecObjPtr->length; i++) {
            if (!FINITE(vecObjPtr->valueArr[i])) {
                count++;
            }
        }
    } else if ((c == 'z') && (strcmp(string, "zero") == 0)) {
        int i;

        for (i = 0; i < vecObjPtr->length; i++) {
            if (FINITE(vecObjPtr->valueArr[i]) && 
                (vecObjPtr->valueArr[i] == 0.0)) {
                count++;
            }
        }
    } else if ((c == 'n') && (strcmp(string, "nonzero") == 0)) {
        int i;

        for (i = 0; i < vecObjPtr->length; i++) {
            if (FINITE(vecObjPtr->valueArr[i]) && 
                (vecObjPtr->valueArr[i] != 0.0)) {
                count++;
            }
        }
    } else if ((c == 'n') && (strcmp(string, "nonempty") == 0)) {
        int i;

        for (i = 0; i < vecObjPtr->length; i++) {
            if (FINITE(vecObjPtr->valueArr[i])) {
                count++;
            }
        }
    } else {
        Tcl_AppendResult(interp, "unknown operation \"", string, 
                "\": should be empty, zero, nonzero, or nonempty",
                (char *)NULL);
        return TCL_ERROR;
    }
    Tcl_SetIntObj(Tcl_GetObjResult(interp), count);
    return TCL_OK;
}


/*
 *---------------------------------------------------------------------------
 *
 * IndicesOp --
 *
 *      Returns the indices of values in the vector.  This excludes
 *      empty values.
 *
 * Results:
 *      A standard TCL result.  
 *
 *---------------------------------------------------------------------------
 */
static int
IndicesOp(ClientData clientData, Tcl_Interp *interp, int objc,
          Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    const char *string;
    char c;
    Tcl_Obj *listObjPtr;

    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
    string = Tcl_GetString(objv[2]);
    c = string[0];
    if ((c == 'e') && (strcmp(string, "empty") == 0)) {
        int i;

        for (i = 0; i < vecObjPtr->length; i++) {
            if (!FINITE(vecObjPtr->valueArr[i])) {
                Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewIntObj(i));
            }
        }
    } else if ((c == 'z') && (strcmp(string, "zero") == 0)) {
        int i;

        for (i = 0; i < vecObjPtr->length; i++) {
            if (FINITE(vecObjPtr->valueArr[i]) && 
                (vecObjPtr->valueArr[i] == 0.0)) {
                Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewIntObj(i));
            }
        }
    } else if ((c == 'n') && (strcmp(string, "nonzero") == 0)) {
        int i;

        for (i = 0; i < vecObjPtr->length; i++) {
            if (FINITE(vecObjPtr->valueArr[i]) && 
                (vecObjPtr->valueArr[i] != 0.0)) {
                Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewIntObj(i));
            }
        }
    } else if ((c == 'n') && (strcmp(string, "nonempty") == 0)) {
        int i;

        for (i = 0; i < vecObjPtr->length; i++) {
            if (FINITE(vecObjPtr->valueArr[i])) {
                Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewIntObj(i));
            }
        }
    } else {
        Tcl_AppendResult(interp, "unknown operation \"", string, 
                "\": should be empty, zero, nonzero, or nonempty",
                (char *)NULL);
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SearchOp --
 *
 *      Searches for a value in the vector. Returns the indices of all
 *      vector elements matching a particular value.
 *
 * Results:
 *      Always returns TCL_OK.  interp->result will contain a list of the
 *      indices of array elements matching value. If no elements match,
 *      interp->result will contain the empty string.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SearchOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    double min, max;
    int i;
    int wantValue;
    char *string;
    Tcl_Obj *listObjPtr;

    wantValue = FALSE;
    string = Tcl_GetString(objv[2]);
    if ((string[0] == '-') && (strcmp(string, "-value") == 0)) {
        wantValue = TRUE;
        objv++, objc--;
    }
    if (Blt_ExprDoubleFromObj(interp, objv[2], &min) != TCL_OK) {
        return TCL_ERROR;
    }
    max = min;
    if (objc > 4) {
        Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                Tcl_GetString(objv[0]), " search ?-value? min ?max?", 
                (char *)NULL);
        return TCL_ERROR;
    }
    if ((objc > 3) && 
        (Blt_ExprDoubleFromObj(interp, objv[3], &max) != TCL_OK)) {
        return TCL_ERROR;
    }
    if ((min - max) >= DBL_EPSILON) {
        return TCL_OK;          /* Bogus range. Don't bother looking. */
    }
    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
    if (wantValue) {
        for (i = 0; i < vecObjPtr->length; i++) {
            if (IsBetween(vecObjPtr->valueArr[i], min, max)) {
                Tcl_ListObjAppendElement(interp, listObjPtr, 
                        Tcl_NewDoubleObj(vecObjPtr->valueArr[i]));
            }
        }
    } else {
        for (i = 0; i < vecObjPtr->length; i++) {
            if (IsBetween(vecObjPtr->valueArr[i], min, max)) {
                Tcl_ListObjAppendElement(interp, listObjPtr,
                         Tcl_NewIntObj(i + vecObjPtr->offset));
            }
        }
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * OffsetOp --
 *
 *      Queries or sets the offset of the array index from the base address
 *      of the data array of values.
 *
 * Results:
 *      A standard TCL result.  If the source vector doesn't exist or the
 *      source list is not a valid list of numbers, TCL_ERROR returned.
 *      Otherwise TCL_OK is returned.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
OffsetOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    if (objc == 3) {
        int64_t newOffset;

        if (Blt_GetInt64FromObj(interp, objv[2], &newOffset) != TCL_OK) {
            return TCL_ERROR;
        }
        if (newOffset < 0) {
            newOffset = 0;
        }
        vecObjPtr->offset = newOffset;
    }
    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)vecObjPtr->offset);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * RandomOp --
 *
 *      Generates random values for the length of the vector.
 *
 * Results:
 *      A standard TCL result.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
RandomOp(ClientData clientData, Tcl_Interp *interp, int objc,
         Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    int i;

    if (objc == 3) {
        int64_t seed;

        if (Blt_GetInt64FromObj(interp, objv[2], &seed) != TCL_OK) {
            return TCL_ERROR;
        }
        srand48((long)seed);
    }
    for (i = 0; i < vecObjPtr->length; i++) {
        vecObjPtr->valueArr[i] = drand48();
    }
    if (vecObjPtr->flush) {
        Blt_VecObj_FlushCache(vecObjPtr);
    }
    Blt_VecObj_UpdateClients(vecObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SequenceOp --
 *
 *      Generates a sequence of values in the vector.
 *
 * Results:
 *      A standard TCL result.
 *
 *      $v sequence start stop ?step?
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SequenceOp(ClientData clientData, Tcl_Interp *interp, int objc,
           Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    const char *string;
    double start, stop, step;
    int numSteps;

    if (Tcl_GetDoubleFromObj(interp, objv[2], &start) != TCL_OK) {
        return TCL_ERROR;
    }
    string = Tcl_GetString(objv[3]);
    step = 1.0;
    stop = 0.0;
    numSteps = 0;
    if ((string[0] == 'e') && (strcmp(string, "end") == 0)) {
        numSteps = vecObjPtr->length;
    } else if (Tcl_GetDoubleFromObj(interp, objv[3], &stop) != TCL_OK) {
        return TCL_ERROR;
    }
    step = 1.0;                         /* By default, increment is 1.0 */
    if ((objc > 4) && 
        (Tcl_GetDoubleFromObj(interp, objv[4], &step) != TCL_OK)) {
        return TCL_ERROR;
    }
    if (numSteps == 0) {
        double r, s;

	r = stop - start;
	s = r / step;
        numSteps = (int)(s) + 1;
    }
    if (numSteps > 0) {
        int i;
        
        if (Blt_VecObj_SetLength(interp, vecObjPtr, numSteps) != TCL_OK) {
            return TCL_ERROR;
        }
        for (i = 0; i < numSteps; i++) {
            vecObjPtr->valueArr[i] = start + (step * (double)i);
        }
        if (vecObjPtr->flush) {
            Blt_VecObj_FlushCache(vecObjPtr);
        }
        Blt_VecObj_UpdateClients(vecObjPtr);
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * LinspaceOp --
 *
 *      Generate linearly spaced values.
 *
 * Results:
 *      A standard TCL result.
 *
 *      $v linspace first last ?numSteps?
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
LinspaceOp(ClientData clientData, Tcl_Interp *interp, int objc,
           Tcl_Obj *const *objv)
{
    VectorObject *destObjPtr = clientData;
    long numSteps;
    double first, last;
    
    if (Tcl_GetDoubleFromObj(interp, objv[2], &first) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_GetDoubleFromObj(interp, objv[3], &last) != TCL_OK) {
        return TCL_ERROR;
    }
    numSteps = destObjPtr->length;         /* By default, generate one step
                                         * for each entry in the vector. */
    if ((objc > 4) && 
        (Tcl_GetLongFromObj(interp, objv[4], &numSteps) != TCL_OK)) {
        return TCL_ERROR;
    }
    if (numSteps > 1) {                 /* Silently ignore non-positive
                                         * numSteps */
        long i;
        double step;

        if (Blt_VecObj_SetLength(interp, destObjPtr, numSteps) != TCL_OK) {
            return TCL_ERROR;
        }
        step = (last - first) / (double)(numSteps - 1);
        for (i = 0; i < numSteps; i++) { 
            destObjPtr->valueArr[i] = first + (step * i);
        }
        if (destObjPtr->flush) {
            Blt_VecObj_FlushCache(destObjPtr);
        }
        Blt_VecObj_UpdateClients(destObjPtr);
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetOp --
 *
 *      Sets the data of the vector object from a list of values.
 *
 * Results:
 *      A standard TCL result.  If the source vector doesn't exist or the
 *      source list is not a valid list of numbers, TCL_ERROR returned.
 *      Otherwise TCL_OK is returned.
 *
 * Side Effects:
 *      The vector data is reset.  Clients of the vector are notified.  Any
 *      cached array indices are flushed.
 *
 *
 *      vecName set $list 
 *      vecName set anotherVector
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SetOp(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    int result;
    VectorObject *srcObjPtr;
    int numElem;
    Tcl_Obj **elemObjArr;

    /* The source can be either a list of numbers or another vector.  */

    srcObjPtr = Blt_VecObj_ParseElement((Tcl_Interp *)NULL, vecObjPtr->dataPtr, 
           Tcl_GetString(objv[2]), NULL, NS_SEARCH_BOTH);
    if (srcObjPtr != NULL) {
        if (vecObjPtr == srcObjPtr) {
            VectorObject *tmpPtr;
            /* 
             * Source and destination vectors are the same.  Copy the source
             * first into a temporary vector to avoid memory overlaps.
             */
            tmpPtr = Blt_VecObj_New(vecObjPtr->dataPtr);
            result = Blt_VecObj_Duplicate(tmpPtr, srcObjPtr);
            if (result == TCL_OK) {
                result = Blt_VecObj_Duplicate(vecObjPtr, tmpPtr);
            }
            Blt_VecObj_Free(tmpPtr);
        } else {
            result = Blt_VecObj_Duplicate(vecObjPtr, srcObjPtr);
        }
    } else if (Tcl_ListObjGetElements(interp, objv[2], &numElem, &elemObjArr) 
               == TCL_OK) {
        result = CopyList(vecObjPtr, interp, numElem, elemObjArr);
    } else {
        return TCL_ERROR;
    }

    if (result == TCL_OK) {
        /*
         * The vector has changed; so flush the array indices (they're wrong
         * now), find the new range of the data, and notify the vector's
         * clients that it's been modified.
         */
        if (vecObjPtr->flush) {
            Blt_VecObj_FlushCache(vecObjPtr);
        }
        Blt_VecObj_UpdateClients(vecObjPtr);
    }
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * SimplifyOp --
 *
 *      Siets the data of the vector object from a list of values.
 *
 * Results:
 *      A standard TCL result.  If the source vector doesn't exist or the
 *      source list is not a valid list of numbers, TCL_ERROR returned.
 *      Otherwise TCL_OK is returned.
 *
 * Side Effects:
 *      The vector data is reset.  Clients of the vector are notified.  Any
 *      cached array indices are flushed.
 *
 *      vectorName simplify x y tol
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SimplifyOp(ClientData clientData, Tcl_Interp *interp, int objc,
           Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    VectorObject *x, *y;
    int i, n, vecSize;
    int numPoints;
    long *indices;
    Point2d *origPts;
    double *xArr, *yArr;
    SimplifySwitches switches;
    
    if (GetVectorObject(interp, vecObjPtr->dataPtr, objv[2], &x) ||
        GetVectorObject(interp, vecObjPtr->dataPtr, objv[3], &y)) {
        return TCL_ERROR;
    }
    switches.flags = 0;
    switches.tol = 10.0;
    if (Blt_ParseSwitches(interp, simplifySwitches, objc - 4, objv + 4,
                          &switches, BLT_SWITCH_DEFAULTS) < 0) {
        return TCL_ERROR;
    }
    if (x->length != y->length) {
        Tcl_AppendResult(interp, "x and y vectors are not the same length",
                         (char *)NULL);
        return TCL_ERROR;
    }
    numPoints = x->length;
    if (numPoints < 3) {
        Tcl_AppendResult(interp, "too few points in vectors",
                         (char *)NULL);
        return TCL_ERROR;
    }
    origPts = Blt_Malloc(sizeof(Point2d) * numPoints);
    if (origPts == NULL) {
        Tcl_AppendResult(interp, "can't allocate \"", Blt_Itoa(numPoints), 
                "\" points", (char *)NULL);
        return TCL_ERROR;
    }
    xArr = Blt_VecData(x);
    yArr = Blt_VecData(y);
    for (i = 0; i < numPoints; i++) {
        origPts[i].x = xArr[i];
        origPts[i].y = yArr[i];
    }
    indices = Blt_Malloc(sizeof(long) * numPoints);
    if (indices == NULL) {
        Tcl_AppendResult(interp, "can't allocate \"", Blt_Ltoa(numPoints), 
                         "\" indices for simplication vector", (char *)NULL);
        Blt_Free(origPts);
        return TCL_ERROR;
    }
    n = Blt_SimplifyLine(origPts, 0, numPoints - 1, switches.tol, indices);
    if (switches.flags & SIMPLIFY_INDICES) {
        vecSize = n;
    } else {
        vecSize = n + n;
    }
    if (Blt_VecObj_ChangeLength(interp, vecObjPtr, vecSize) != TCL_OK) {
        Blt_Free(origPts);
        return TCL_ERROR;
    }
    xArr = Blt_VecData(vecObjPtr);
    if (switches.flags & SIMPLIFY_INDICES) {
        int i;
        
        for (i = 0; i < n; i++) {
            xArr[i] = (double)indices[i];
        }
    } else {
        int j;
        
        for (i = 0, j = 0; i < n; i++, j += 2) {
            xArr[j] = origPts[indices[i]].x;
            xArr[j+1] = origPts[indices[i]].y;
        }
    }
    Blt_Free(origPts);
    Blt_Free(indices);
    /*
     * The vector has changed; so flush the array indices (they're wrong now),
     * find the new range of the data, and notify the vector's clients that
     * it's been modified.
     */
    if (vecObjPtr->flush) {
        Blt_VecObj_FlushCache(vecObjPtr);
    }
    Blt_VecObj_UpdateClients(vecObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SplitOp --
 *
 *      Copies the values from the vector evenly into one of more vectors.
 *
 * Results:
 *      A standard TCL result.  
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SplitOp(ClientData clientData, Tcl_Interp *interp, int objc,
        Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    int numVectors;

    numVectors = objc - 2;
    if ((vecObjPtr->length % numVectors) != 0) {
        Tcl_AppendResult(interp, "can't split vector \"", vecObjPtr->name, 
           "\" into ", Blt_Itoa(numVectors), " even parts", (char *)NULL);
        return TCL_ERROR;
    }
    if (numVectors > 0) {
        int i;
        int extra;

        extra = vecObjPtr->length / numVectors;
        for (i = 0; i < numVectors; i++) {
            VectorObject *destObjPtr;
            int oldSize, newSize;
            int j, k;

            if (GetVectorObject(interp, vecObjPtr->dataPtr, objv[i + 2], 
                                &destObjPtr) != TCL_OK) {
                return TCL_ERROR;
            }
            oldSize = destObjPtr->length;
            newSize = oldSize + extra;
            if (Blt_VecObj_SetLength(interp, destObjPtr, newSize) != TCL_OK) {
                return TCL_ERROR;
            }
            for (j = i, k = oldSize; j < vecObjPtr->length; 
                 j += numVectors, k++) {
                destObjPtr->valueArr[k] = vecObjPtr->valueArr[j];
            }
            Blt_VecObj_UpdateClients(destObjPtr);
            if (destObjPtr->flush) {
                Blt_VecObj_FlushCache(destObjPtr);
            }
        }
    }
    return TCL_OK;
}


static VectorObject **sortVectors;      /* Pointer to the array of values
                                         * currently being sorted. */
static int numSortVectors;
static int sortDecreasing;              /* Indicates the ordering of the
                                         * sort. If non-zero, the vectors
                                         * are sorted in decreasing
                                         * order. */

static int
CompareValues(double a, double b)
{
    double d;
    
    if (!FINITE(a)) {
        if (!FINITE(b)) {
            return 0;                   /* Both points are empty */
        }
        return 1;                       /* Only 1st point is empty. */
    } else if (!FINITE(b)) {
        return -1;                      /* Only 2nd point is empty. */
    }
    d = a - b;
    if (d < 0.0) {
        return -1;
    } else if (d > 0.0) {
        return 1;
    }
    return 0;
}

static int
ComparePoints(const void *aPtr, const void *bPtr)
{
    int i;
    const int i1 = *(int *)aPtr;
    const int i2 = *(int *)bPtr;

    for (i = 0; i < numSortVectors; i++) {
        int cond;
        VectorObject *vecObjPtr;
        
        vecObjPtr = sortVectors[i];
        cond = CompareValues(vecObjPtr->valueArr[i1], vecObjPtr->valueArr[i2]);
        if (cond != 0) {
            return (sortDecreasing) ? -cond : cond;
        }
    }
    return 0;
}

/*
 *---------------------------------------------------------------------------
 *
 * Blt_VecObj_SortMap --
 *
 *      Returns an array of indices that represents the sorted mapping of
 *      the original vector.
 *
 * Results:
 *      A standard TCL result.  If any of the auxiliary vectors are a
 *      different size than the sorted vector object, TCL_ERROR is
 *      returned.  Otherwise TCL_OK is returned.
 *
 * Side Effects:
 *      The vectors are sorted.
 *
 *      vecName sort ?switches? vecName vecName...
 *---------------------------------------------------------------------------
 */
void
Blt_VecObj_SortMap(VectorObject **vectors, int numVectors, long **mapPtr)
{
    long *map;
    long i;
    VectorObject *vecObjPtr = vectors[0];

    map = Blt_AssertMalloc(sizeof(long) * vecObjPtr->length);
    for (i = 0; i < vecObjPtr->length; i++) {
        map[i] = i;
    }
    /* Set global variables for sorting routine. */
    sortVectors = vectors;
    numSortVectors = numVectors;
    qsort((char *)map, vecObjPtr->length, sizeof(long), ComparePoints);
    *mapPtr = map;
}

/*
 *---------------------------------------------------------------------------
 *
 * Blt_VecObj_NonemptySortMap --
 *
 *      Returns an array of indices that represents the sorted mapping of
 *      the original vector. Only non-empty points are considered.
 *
 * Results:
 *      A standard TCL result.  If any of the auxiliary vectors are a
 *      different size than the sorted vector object, TCL_ERROR is
 *      returned.  Otherwise TCL_OK is returned.
 *
 * Side Effects:
 *      The vectors are sorted.
 *
 *      vecName sort ?switches? vecName vecName...
 *---------------------------------------------------------------------------
 */

int
Blt_VecObj_NonemptySortMap(VectorObject *vecObjPtr, long **mapPtr)
{
    long *map;
    long i, j, count;

    count = 0;
    for (i = 0; i < vecObjPtr->length; i++) {
        if (FINITE(vecObjPtr->valueArr[i])) {
            count++;
        }
    }
    map = Blt_AssertMalloc(sizeof(long) * count);
    for (i = 0, j = 0; i < vecObjPtr->length; i++) {
        if (FINITE(vecObjPtr->valueArr[i])) {
            map[j] = i;
            j++;
        }
    }
    /* Set global variables for sorting routine. */
    sortVectors = &vecObjPtr;
    numSortVectors = 1;
    qsort((char *)map, count, sizeof(long), ComparePoints);
    *mapPtr = map;
    return count;
}

/*
 *---------------------------------------------------------------------------
 *
 * SortOp --
 *
 *      Sorts the vector object and any other vectors according to sorting
 *      order of the vector object.
 *
 * Results:
 *      A standard TCL result.  If any of the auxiliary vectors are a
 *      different size than the sorted vector object, TCL_ERROR is returned.
 *      Otherwise TCL_OK is returned.
 *
 * Side Effects:
 *      The vectors are sorted.
 *
 *      vecName sort ?switches? vecName vecName...
 *---------------------------------------------------------------------------
 */
static int
SortOp(ClientData clientData, Tcl_Interp *interp, int objc,
       Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;
    SortSwitches switches;
    VectorObject **vectors;
    double *copy;
    int i;
    long *map;
    size_t numBytes, sortLength, numVectors;

    /* Global flag to to pass to comparison routines.  */
    sortDecreasing = FALSE;

    switches.flags = 0;
    i = Blt_ParseSwitches(interp, sortSwitches, objc - 2, objv + 2, &switches, 
                BLT_SWITCH_OBJV_PARTIAL);
    if (i < 0) {
        return TCL_ERROR;
    }
    objc -= i, objv += i;
    sortDecreasing = (switches.flags & SORT_DECREASING);

    vectors = Blt_AssertMalloc(sizeof(VectorObject *) * (objc + 1));
    vectors[0] = vecObjPtr;
    numVectors = 1;
    sortLength = vecObjPtr->length;
    for (i = 2; i < objc; i++) {
        VectorObject *srcObjPtr;

        if (GetVectorObject(interp, vecObjPtr->dataPtr, objv[i], &srcObjPtr) 
            != TCL_OK) {
            Blt_Free(vectors);
            return TCL_ERROR;
        }
        if (srcObjPtr->length != vecObjPtr->length) {
            Tcl_AppendResult(interp, "vector \"", srcObjPtr->name,
                "\" is not the same size as \"", vecObjPtr->name, "\"",
                (char *)NULL);
            Blt_Free(vectors);
            return TCL_ERROR;
        }
        vectors[numVectors] = srcObjPtr;
        numVectors++;
    }

    /* Sort the vector. We get a sorted map. */
    Blt_VecObj_SortMap(vectors, numVectors, &map);
    if (map == NULL) {
        Blt_Free(vectors);
        return TCL_ERROR;
    }
    /* If all we care about is the unique values then compress the map. */
    if (switches.flags & SORT_UNIQUE) {
        int count, i;

        count = 1;
        for (i = 1; i < vecObjPtr->length; i++) {
            int next, prev;

            next = map[i];
            prev = map[i - 1];
            if (ComparePoints(&next, &prev) != 0) {
                map[count] = next;
                count++;
            }
        }
        sortLength = count;
    }

    /* If we're returning the indices or values of the sorted points.
     * do that now. */
    if (switches.flags & (SORT_VALUES | SORT_INDICES)) {
        Tcl_Obj *listObjPtr;
        long i;
        
        listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);

        if (switches.flags & SORT_INDICES) {
            for (i = 0; i < sortLength; i++) {
                Tcl_Obj *objPtr;

                objPtr = Tcl_NewLongObj(map[i]);
                Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
            }            
        } else {
            for (i = 0; i < sortLength; i++) {
                long j;
                
                for (j = 0; j < numVectors; j++) {
                    VectorObject *vecObjPtr;
                    Tcl_Obj *objPtr;
                    
                    vecObjPtr = vectors[j];
                    objPtr = Tcl_NewDoubleObj(vecObjPtr->valueArr[map[i]]);
                    Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
                }
            }
        }
        Blt_Free(map);
        Blt_Free(vectors);
        Tcl_SetObjResult(interp, listObjPtr);
        return TCL_OK;
    }

    /*
     * Create an array to store a copy of the current values of the
     * vector. We'll merge the values back into the vector based upon the
     * indices found in the index array.
     */
    numBytes = sizeof(double) * vecObjPtr->length;
    copy = Blt_AssertMalloc(numBytes);

    /* Now rearrange the designated vectors according to the sort map.  The
     * vectors must be the same size as the map.  */
    for (i = 0; i < numVectors; i++) {
        int j;
        VectorObject *destObjPtr;
        
        destObjPtr = vectors[i];
        memcpy((char *)copy, (char *)destObjPtr->valueArr, numBytes);
        if (sortLength != destObjPtr->length) {
            Blt_VecObj_SetLength(interp, destObjPtr, sortLength);
        }
        for (j = 0; j < sortLength; j++) {
            destObjPtr->valueArr[j] = copy[map[j]];
        }
        Blt_VecObj_UpdateClients(destObjPtr);
        if (destObjPtr->flush) {
            Blt_VecObj_FlushCache(destObjPtr);
        }
    }
    Blt_Free(vectors);
    Blt_Free(copy);
    Blt_Free(map);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * InstExprOp --
 *
 *      Computes the result of the expression which may be either a scalar
 *      (single value) or vector (list of values).
 *
 * Results:
 *      A standard TCL result.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
InstExprOp(ClientData clientData, Tcl_Interp *interp, int objc,
           Tcl_Obj *const *objv)
{
    VectorObject *vecObjPtr = clientData;

    if (Blt_ExprVector(interp, Tcl_GetString(objv[2]), (Blt_Vector *)vecObjPtr) 
        != TCL_OK) {
        return TCL_ERROR;
    }
    if (vecObjPtr->flush) {
        Blt_VecObj_FlushCache(vecObjPtr);
    }
    Blt_VecObj_UpdateClients(vecObjPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ArithOp --
 *
 * Results:
 *      A standard TCL result.  If the source vector doesn't exist or the
 *      source list is not a valid list of numbers, TCL_ERROR returned.
 *      Otherwise TCL_OK is returned.
 *
 * Side Effects:
 *      The vector data is reset.  Clients of the vector are notified.
 *      Any cached array indices are flushed.
 *
 *---------------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
ArithOp(ClientData clientData, Tcl_Interp *interp, int objc,
        Tcl_Obj *const *objv)
{
    VectorObject *destObjPtr = clientData;
    double value;
    int i;
    VectorObject *srcObjPtr;
    double scalar;
    Tcl_Obj *listObjPtr;
    const char *string;

    srcObjPtr = Blt_VecObj_ParseElement((Tcl_Interp *)NULL, destObjPtr->dataPtr, 
        Tcl_GetString(objv[2]), NULL, NS_SEARCH_BOTH);
    if (srcObjPtr != NULL) {
        int j;

        if (srcObjPtr->length != destObjPtr->length) {
            Tcl_AppendResult(interp, "vectors \"", Tcl_GetString(objv[0]), 
                "\" and \"", Tcl_GetString(objv[2]), 
                "\" are not the same length", (char *)NULL);
            return TCL_ERROR;
        }
        string = Tcl_GetString(objv[1]);
        listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
        switch (string[0]) {
        case '*':
            for (i = 0, j = 0; i < destObjPtr->length; i++, j++) {
                value = destObjPtr->valueArr[i] * srcObjPtr->valueArr[j];
                Tcl_ListObjAppendElement(interp, listObjPtr,
                         Tcl_NewDoubleObj(value));
            }
            break;

        case '/':
            for (i = 0, j = 0; i < destObjPtr->length; i++, j++) {
                value = destObjPtr->valueArr[i] / srcObjPtr->valueArr[j];
                Tcl_ListObjAppendElement(interp, listObjPtr,
                         Tcl_NewDoubleObj(value));
            }
            break;

        case '-':
            for (i = 0, j = 0; i < destObjPtr->length; i++, j++) {
                value = destObjPtr->valueArr[i] - srcObjPtr->valueArr[j];
                Tcl_ListObjAppendElement(interp, listObjPtr,
                         Tcl_NewDoubleObj(value));
            }
            break;

        case '+':
            for (i = 0, j = 0; i < destObjPtr->length; i++, j++) {
                value = destObjPtr->valueArr[i] + srcObjPtr->valueArr[j];
                Tcl_ListObjAppendElement(interp, listObjPtr,
                         Tcl_NewDoubleObj(value));
            }
            break;
        }
        Tcl_SetObjResult(interp, listObjPtr);

    } else if (Blt_ExprDoubleFromObj(interp, objv[2], &scalar) == TCL_OK) {
        listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
        string = Tcl_GetString(objv[1]);
        switch (string[0]) {
        case '*':
            for (i = 0; i < destObjPtr->length; i++) {
                value = destObjPtr->valueArr[i] * scalar;
                Tcl_ListObjAppendElement(interp, listObjPtr,
                         Tcl_NewDoubleObj(value));
            }
            break;

        case '/':
            for (i = 0; i < destObjPtr->length; i++) {
                value = destObjPtr->valueArr[i] / scalar;
                Tcl_ListObjAppendElement(interp, listObjPtr,
                         Tcl_NewDoubleObj(value));
            }
            break;

        case '-':
            for (i = 0; i < destObjPtr->length; i++) {
                value = destObjPtr->valueArr[i] - scalar;
                Tcl_ListObjAppendElement(interp, listObjPtr,
                         Tcl_NewDoubleObj(value));
            }
            break;

        case '+':
            for (i = 0; i < destObjPtr->length; i++) {
                value = destObjPtr->valueArr[i] + scalar;
                Tcl_ListObjAppendElement(interp, listObjPtr,
                         Tcl_NewDoubleObj(value));
            }
            break;
        }
        Tcl_SetObjResult(interp, listObjPtr);
    } else {
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * VectorInstCmd --
 *
 *      Parses and invokes the appropriate vector instance command option.
 *
 * Results:
 *      A standard TCL result.
 *
 *---------------------------------------------------------------------------
 */
static Blt_OpSpec vectorInstOps[] =
{
    {"*",         1, ArithOp,     3, 3, "item",},       /*Deprecated*/
    {"+",         1, ArithOp,     3, 3, "item",},       /*Deprecated*/
    {"-",         1, ArithOp,     3, 3, "item",},       /*Deprecated*/
    {"/",         1, ArithOp,     3, 3, "item",},       /*Deprecated*/
    {"append",    1, AppendOp,    3, 0, "item ?item...?",},
    {"binread",   2, BinreadOp,   3, 0, "channel ?numValues? ?flags?",},
    {"clear",     2, ClearOp,     2, 2, "",},
    {"count",     2, CountOp,     3, 3, "what",},
    {"delete",    2, DeleteOp,    2, 0, "index ?index...?",},
    {"duplicate", 2, DupOp,       2, 3, "?vecName?",},
    {"export",    4, ExportOp,    3, 0, "format ?switches?",},
    {"expr",      4, InstExprOp,  3, 3, "expression",},
    {"fft",       2, FFTOp,       3, 0, "vecName ?switches?",},
    {"frequency", 2, FrequencyOp, 4, 4, "vecName numBins",},
    {"indices",   3, IndicesOp,   3, 3, "what",},
    {"inversefft",3, InverseFFTOp,4, 4, "vecName vecName",},
    {"length",    2, LengthOp,    2, 3, "?newSize?",},
    {"limits",    3, LimitsOp,    2, 2, "",},
    {"linspace",  3, LinspaceOp, 4, 5, "first last ?numSteps?",},
    {"maximum",   2, MaxOp,       2, 2, "",},
    {"merge",     2, MergeOp,     3, 0, "vecName ?vecName...?",},
    {"minimum",   2, MinOp,       2, 2, "",},
    {"normalize", 3, NormalizeOp, 2, 3, "?vecName?",},  /*Deprecated*/
    {"notify",    3, NotifyOp,    3, 3, "keyword",},
    {"offset",    1, OffsetOp,    2, 3, "?offset?",},
    {"pack",      2, PackOp,      2, 2, "",},
    {"populate",  2, PopulateOp,  4, 4, "vecName density",},
    {"print",     2, PrintOp,     3, 0, "format ?switches?",},
    {"random",    4, RandomOp,    2, 3, "?seed?",},     /*Deprecated*/
    {"range",     4, RangeOp,     2, 4, "first last",},
    {"search",    3, SearchOp,    3, 5, "?-value? value ?value?",},
    {"sequence",  3, SequenceOp,  4, 5, "start stop ?step?",},
    {"set",       3, SetOp,       3, 3, "item",},
    {"simplify",  2, SimplifyOp,  4, 5, "x y ?tol?" },
    {"sort",      2, SortOp,      2, 0, "?switches? ?vecName...?",},
    {"split",     2, SplitOp,     2, 0, "?vecName...?",},
    {"value",     5, ValueOp,     2, 0, "oper",},
    {"values",    6, ValuesOp,    2, 0, "?switches?",},
    {"variable",  3, MapOp,       2, 3, "?varName?",},
};

static int numInstOps = sizeof(vectorInstOps) / sizeof(Blt_OpSpec);

int
Blt_VecObj_InstCmd(ClientData clientData, Tcl_Interp *interp, int objc,
                Tcl_Obj *const *objv)
{
    Tcl_ObjCmdProc *proc;
    VectorObject *vecObjPtr = clientData;

    vecObjPtr->first = 0;
    vecObjPtr->last = vecObjPtr->length;
    proc = Blt_GetOpFromObj(interp, numInstOps, vectorInstOps, BLT_OP_ARG1,
                            objc, objv, 0);
    if (proc == NULL) {
        return TCL_ERROR;
    }
    return (*proc) (vecObjPtr, interp, objc, objv);
}


/*
 *---------------------------------------------------------------------------
 *
 * Blt_VecObj_VarTrace --
 *
 * Results:
 *      Returns NULL on success.  Only called from a variable trace.
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
char *
Blt_VecObj_VarTrace(ClientData clientData, Tcl_Interp *interp, const char *part1, 
                 const char *part2, int flags)
{
    Blt_VectorIndexProc *indexProc;
    VectorObject *vecObjPtr = clientData;
    int first, last;
    int varFlags;
#define MAX_ERR_MSG     1023
    static char message[MAX_ERR_MSG + 1];

    varFlags = TCL_LEAVE_ERR_MSG | (TCL_GLOBAL_ONLY & flags);
    if (part2 == NULL) {
        /* Whole array processing only when unsetting the variable. */
        if (flags & TCL_TRACE_UNSETS) {
            Blt_Free(vecObjPtr->arrayName);
            vecObjPtr->arrayName = NULL;
            if (vecObjPtr->freeOnUnset) {
                Blt_VecObj_Free(vecObjPtr);
            }
        }
        return NULL;
    }
    if (strcmp(part2, "++end") == 0) {
        Tcl_Obj *objPtr;
        double value;

        /* ++end indicates to create a new slot and write the value into it.
         * It can't be used for reads or unsets. */
        if (flags & (TCL_TRACE_READS | TCL_TRACE_UNSETS)) {
            return (char *)"read-only index";
        }
        first = vecObjPtr->length;
        last = vecObjPtr->length + 1;
        /* Add a new slot. */
        if (Blt_VecObj_ChangeLength((Tcl_Interp *)NULL, vecObjPtr, 
                                    vecObjPtr->length + 1) != TCL_OK) {
            return (char *)"error resizing vector";
        }
        objPtr = Tcl_GetVar2Ex(interp, part1, part2, varFlags);
        if (objPtr == NULL) {
            goto error;
        }
        if (Blt_ExprDoubleFromObj(interp, objPtr, &value) != TCL_OK) {
            Tcl_SetVar2Ex(interp, part1, part2, objPtr, varFlags);
            goto error;
        }
        /* Set the value of the new slot. */
        ReplicateValue(vecObjPtr, first, last, value);
    } else if (Blt_VecObj_GetSpecialIndex(NULL, vecObjPtr, part2, &indexProc)
               == TCL_OK) {
        Tcl_Obj *objPtr;
        double value;
        
        /* Special indices like "min", "max", "prod", etc. are read-only. */
        if (flags & (TCL_TRACE_WRITES|TCL_TRACE_UNSETS)) {
            return (char *)"read-only index";
        }
        /* Reset to use the entire vector and call the index routine. */
        vecObjPtr->first = 0, vecObjPtr->last = vecObjPtr->length;
        value = (*indexProc) ((Blt_Vector *) vecObjPtr);

        /* Return the value by setting the variable. */
        objPtr = Tcl_NewDoubleObj(value);
        if (Tcl_SetVar2Ex(interp, part1, part2, objPtr, varFlags) == NULL) {
            Tcl_DecrRefCount(objPtr);
            goto error;
        }
    } else if (Blt_VecObj_GetRange(interp, vecObjPtr, part2) == TCL_OK) {
        /* Possibly a range of indices in the vector. */
        if (flags & TCL_TRACE_READS) {
            Tcl_Obj *objPtr;

            objPtr = GetValues(vecObjPtr, vecObjPtr->first, vecObjPtr->last);
            if (Tcl_SetVar2Ex(interp, part1, part2, objPtr, varFlags) == NULL) {
                Tcl_DecrRefCount(objPtr);
                goto error;
            }
        } else if (flags & TCL_TRACE_WRITES) {
            Tcl_Obj *objPtr;
            double value;

            objPtr = Tcl_GetVar2Ex(interp, part1, part2, varFlags);
            if (objPtr == NULL) {
                goto error;
            }
            if (Blt_ExprDoubleFromObj(interp, objPtr, &value) != TCL_OK) {
                /* Failed to parse value. Reset the variable to the old
                 * value. Do this only for a single index. */
                if ((vecObjPtr->last + 1) == vecObjPtr->first) {
                    /* Single numeric index. Reset the array element to
                     * its old value on errors */
                    Tcl_SetVar2Ex(interp, part1, part2, objPtr, varFlags);
                }
                goto error;
            }
            /* Set possibly a range of values */
            ReplicateValue(vecObjPtr, vecObjPtr->first, vecObjPtr->last, value);
        } else if (flags & TCL_TRACE_UNSETS) {
            /* Unset possibly a range of values */
            ReplicateValue(vecObjPtr, vecObjPtr->first, vecObjPtr->last, 
                           Blt_NaN());
        }
    } else {
        goto error;
    }
    if (vecObjPtr->flush) {
        Blt_VecObj_FlushCache(vecObjPtr);
    }
    if (flags & (TCL_TRACE_UNSETS | TCL_TRACE_WRITES)) {
        Blt_VecObj_UpdateClients(vecObjPtr);
    }
    Tcl_ResetResult(interp);
    return NULL;

 error: 
    strncpy(message, Tcl_GetStringResult(interp), MAX_ERR_MSG);
    message[MAX_ERR_MSG] = '\0';
    return message;
}


