/* Agent Tcl
   Bob Gray
   6 August 1998

   tclBlobCmd.cc

   This file implements the Tcl commands that provide the interface between Tcl 
   and the BinaryData classes.

   Copyright (c) 1995-1998, Bob Gray, Dartmouth College

   See the file "agent.terms" for information on usage and redistribution
   of this file and for a DISCLAIMER OF ALL WARRANTIES.
*/

#include "platPorting.h"
#include "suppBinary.h"
#include "blobTcl.h"
#include "tcl.h"

/* Tcl_BlobCmd

   Tcl syntax: blob create [structure | vector]
	       blob destroy <handle>
	       blob add <handle> <type-descriptor> {value value ...}

      Purpose: 

        Input:
     
       Output:
*/

static int BlobAddCmd (ClientData, Tcl_Interp *interp, int argc, char **argv)
{
#define c_STATIC_TYPE_LIST_SIZE 4
    int handle;
    BinaryDataStructure binaryStructure;
    BinaryDataTypes staticTypeList [c_STATIC_TYPE_LIST_SIZE];

	// check the number of arguments

    if (argc != 5) {
	Tcl_AppendResult (interp, "wrong # of args: should be \"", argv[0], " add <handle> {type type ...} {value value ...}\"", (char *) NULL);
	return TCL_ERROR;
    }

	// get the handle

    if ((Tcl_GetInt (interp, argv[2], &handle) != TCL_OK) || (handle < 0)) {
	Tcl_AppendResult (interp, "invalid blob handle \"", argv[2], "\": must be an unsigned integer", (char *) NULL);
	return TCL_ERROR;
    }

	// get the types of the fields that we are adding

    int numFields = strlen (argv[3]);

    if (numFields == 0) {
	Tcl_AppendResult (interp, "type descriptor can not be an empty string", (char *) NULL);
	return TCL_ERROR;
    }

    BinaryDataTypes *typeList;

    if (numFields <= c_STATIC_TYPE_LIST_SIZE) {
	typeList = staticTypeList;
    } else {
	typeList = new BinaryDataTypes [numFields];
    }

#ifdef FIX_LATER

    for (i = 0; i < numFields; ++i) {

	if ((typeListArgv[i][0] == 'i') && (!strcmp (typeListArgv[i], "integer"))) {

	    typeList[i] = e_BinaryInteger;

	} else if ((typeListArgv[i][0] == 's') && (!strcmp (typeListArgv[i], "structure"))) {

	    typeList[i] = e_BinaryStructure;

	} else {

	    Tcl_AppendResult (interp, "unknown field type \"", typeListArgv[i], "\": should be integer or structure", (char *) NULL);
	
	    if (typeList != staticTypeList) {
		delete typeList;
	    }

	    free (typeListArgv);
	    return TCL_ERROR;
	}
    }

    free (typeListArgv);

#endif





    return (TCL_OK);
}

static int BlobCreateCmd (ClientData, Tcl_Interp *interp, int argc, char **argv)
{
    int rc;
    BinaryDataTypes blobType;

	// get the blob type

    if (argc == 2) {

	 blobType = e_BinaryStructure;
	 rc = TCL_OK;

    } else if (argc != 3) {

	Tcl_AppendResult (interp, "wrong # of args: should be \"", argv[0], " create [structure | vector]\"", (char *) NULL);
	rc = TCL_ERROR;

    } else if (!strcmp (argv[2], "structure")) {

	blobType = e_BinaryStructure;
	rc = TCL_OK;

    } else if (!strcmp (argv[2], "vector")) {

	rc = TCL_OK;

    } else {
	 
	Tcl_AppendResult (interp, "unknown blob type \"", argv[2], "\": should be structure or vector", (char *) NULL);
	rc = TCL_ERROR;
    }

	// create the blob

    if (rc == TCL_OK) {

	UINT_32 handle;
	    
	if ((rc = Blob_Create (interp, blobType, &handle)) == TCL_OK) {
	    char temp[16];
	    sprintf (temp, "%u", handle);
	    Tcl_SetResult (interp, temp, TCL_VOLATILE);
	}
    }

    return (rc);
}

static int BlobDestroyCmd (ClientData, Tcl_Interp *interp, int argc, char **argv)
{
    int rc;
    int handle;

    if (argc != 3) {

	Tcl_AppendResult (interp, "wrong # of args: should be \"", argv[0], " destroy <handle>\"", (char *) NULL);
	rc = TCL_ERROR;

    } else if ((Tcl_GetInt (interp, argv[2], &handle) != TCL_OK) || (handle < 0)) {

	Tcl_AppendResult (interp, "invalid blob handle \"", argv[2], "\": must be an unsigned integer", (char *) NULL);
	rc = TCL_ERROR;

    } else {

	rc = Blob_Destroy (interp, (UINT_32) handle);	
    }

    return (rc);
}

int Tcl_BlobCmd (ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
{
    int rc;

	// check for at least one argument

    if (argc < 2) {
	Tcl_AppendResult (interp, "wrong # of args: should be \"", argv[0], " option ?arg? ?arg? ...\"", (char *) NULL);
	return (TCL_ERROR);
    }

	// check the suboption

    if ((argv[1][0] == 'c') && (!strcmp(argv[1], "create"))) {

	rc = BlobCreateCmd (clientData, interp, argc, argv);

    } else if ((argv[1][0] == 'd') && (!strcmp(argv[1], "destroy"))) {

	rc = BlobDestroyCmd (clientData, interp, argc, argv);

    } else if ((argv[1][0] == 'a') && (!strcmp(argv[1], "add"))) {

	rc = BlobAddCmd (clientData, interp, argc, argv);

    } else {

	Tcl_AppendResult (interp, "unknown subcommand \"", argv[1], "\": should be create", (char *) NULL);
	rc = TCL_ERROR;	
    }

    return (rc);
}

/* Blob_Init

   Purpose: Add the blob commands to the Tcl interpreter

     Input: interp = the Tcl interpreter
                     (struct Tcl_Interp *)

    Output: The procedure adds the blob commands to the Tcl interpreter and
            returns TCL_OK.
*/

int Blob_Init (Tcl_Interp *interp)
{
    Tcl_CreateCommand (interp, "blob", Tcl_BlobCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}
