#include <tcl.h>
#include <iomanip>
#include <fstream>
#include <stdlib.h>
#include <string.h>
#include <assert.h>

#include <vector>
#include <sstream>
#include <iostream>

// This demo illustrates use of 4 different iteration interfaces that can be useful in Tcl.    The interfaces presented are:
//
//    1) List - simply construct a Tcl list and return it to the caller.  This is the simplest mechanism.
//
//    2) Vector - this interface provides random access to an underlying C/C++ datastructure through a size and indexed retrieval function.
//
//    3) customized foreach command - this provides serial one directional access that looks a lot like Tcl foreach
//
//    4) iterator object command - this provides serial one directional access that looks more like C++'s STL iterator mechanism.
//

//
// Generic code used by all of the iteration examples 
//
// Each of the 4 examples provides access to the current contents of the some_stats class.  The data in some_stats is just a simple C++ vector<double>
//
struct some_stats {
    public:
    std::vector<double> data;
    std::string string_rep;
    some_stats() {}
    void set( const char* in_str ) {
        data.clear();
        append(in_str);
    }
    void append( const char* in_str ) {
        std::stringstream in(in_str);
        // take a csv input stream and convert it into a some_stat
        char comma;
        double d;
        while( in ) {
            in >> d;
            data.push_back(d);    
            in >> comma; 
        }
        //std::cout << "Data entries: " << data.size() << std::endl;
    }
};

// This not very interesting set of numbers is used to puts some actual data into some_stats.  
const char* dummy_records[]= {
      "101.3,482.5,9.8,25.23,853.209834,4309.8,4,55,88,4.2389,2039.20,20346.0239,3849.2309,20389.22,4e-07,0.123,23.1351324" ,
      "2.332049,48.5,5.8,25.23,2853.234,049.8,42.4,55,88,20984,2039.20,20346.0239,3849.2309,20389.22,4e-07,0.123,403023.1351324" ,
      "203923409473.3,482.5,5.8,9825.23,2853.234,4349.8,42.4,55,88,2034,2039.20,20346.0239,3849.2309,20389.22,4e-07,0.123,135.1324" ,
      "433.3,42.6,5.8,9825.23,2853.9834,439.8,42.78,55,88,3984,2039.20,20346.0239,3849.2309,20389.22,4e-07,0.123,135.1324" ,
      "5200.3,48.5,5.8,9825.23,2853.834,430.8,42.50349,55,88,2039,2039.20,20346.0239,3849.2309,20389.22,4e-07,0.123,5132.4" 
};

// How many times do we create new data records and run the Tcl proc (this is a purely arbitrary number)
int iteration_count=5;


// Each interface will do its own specific setup - this typedef is handy for giving them a common mechanism for initialization.
typedef void (*some_stats_interface_function)( Tcl_Interp *interp, class Iterator_Environment* );

//
// This class provides some setup common to all of the interface mechanisms (boring stuff like starting up the interpreter etc.
class Iterator_Environment {

    public:
    std::string procname;
    Tcl_Interp *interp;

    // Return values
    Tcl_Obj *long_result;
    Tcl_Obj *double_result;
    Tcl_Obj *int_result;

    some_stats curr_record;

    Iterator_Environment( std::string &proc ) : procname(proc), interp(NULL), long_result(NULL), double_result(NULL), int_result(NULL)
    {
    }

    ~Iterator_Environment() {
        if ( interp ) Tcl_DeleteInterp(interp);
        interp=NULL;
    }

    Tcl_Interp *setup_interpreter( std::string& load_file, some_stats_interface_function ifc_function ) {

        interp = Tcl_CreateInterp();
        long_result=Tcl_NewLongObj(0);
        Tcl_IncrRefCount(long_result);
        double_result=Tcl_NewDoubleObj(0.0);
        int_result=Tcl_NewIntObj(0);
        Tcl_IncrRefCount(double_result);

        int rc=0;
        // Initialize the interpreter for the interface we are using
        ifc_function( interp, this );
        Tcl_Obj* tcl_script = Tcl_NewObj();
        Tcl_IncrRefCount( tcl_script );
        std::ifstream file_loader( load_file.c_str() );
        std::string load_line;
        while( file_loader ) {
            std::getline(file_loader, load_line);
            Tcl_AppendStringsToObj( tcl_script, load_line.c_str(), "\n", NULL );
        }

        rc = Tcl_EvalObjEx( interp, tcl_script, TCL_EVAL_GLOBAL );

        if ( rc != TCL_OK ) {
            Tcl_AppendResult(interp, "An error was encountered during evaluation of TCL code. ", NULL);
            const char * errorInfoStr  = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
            if ( errorInfoStr ) std::cout << errorInfoStr << std::endl;
            return NULL;
        }

        return interp;
    }
    some_stats* get_current_record() {
        return &curr_record;
    }
    some_stats* set_record(int i) {
        //This example, quite lazily adds some more junk to what ever was already there
        assert(i<iteration_count);
        curr_record.set( dummy_records[i] );
        return &curr_record;
    }
};


//
// PART I - List interface
//
// Implementation details for the Tcl List interface:
//
// 1. There is no specific initialization required for the Tcl list
//
// 2. All of the work for the Tcl script is done in the main event loop
//     2a. - construct a list
//     2b. - run the script on it
//
void do_list_iterations( Iterator_Environment *env ) {

    Tcl_Obj *command[2];

    command[0] = Tcl_NewStringObj( env->procname.c_str(), -1 );
    Tcl_IncrRefCount(command[0]);

    for( int i=0; i<iteration_count; ++i ) 
    {
        env->set_record(i);
        command[1] = Tcl_NewObj();
        Tcl_IncrRefCount(command[1]);
        for( std::vector<double>::iterator i = env->get_current_record()->data.begin();
                i != env->get_current_record()->data.end(); ++i )
        {
            Tcl_ListObjAppendElement(env->interp, command[1], Tcl_NewDoubleObj( *i ));
        }

        double ret_val;
        // Now call the proc 
        int rc = Tcl_EvalObjv( env->interp, 2, command, TCL_EVAL_GLOBAL );
        if ( rc != TCL_OK ) {
            Tcl_AppendResult(env->interp, "An error was encountered during evaluation of TCL code. ", NULL);
            const char * errorInfoStr  = Tcl_GetVar(env->interp, "errorInfo", TCL_GLOBAL_ONLY);
            if ( errorInfoStr ) std::cout << errorInfoStr << std::endl;
        }

        Tcl_Obj *res = Tcl_GetObjResult( env->interp );
        rc = Tcl_GetDoubleFromObj(env->interp, res, &ret_val );
        if ( rc != TCL_OK ) {
            Tcl_AppendResult(env->interp, "A floating point value was expected. ", NULL);
            const char * errorInfoStr  = Tcl_GetVar(env->interp, "errorInfo", TCL_GLOBAL_ONLY);
            if ( errorInfoStr ) std::cout << errorInfoStr << std::endl;
        }


        std::cout << ret_val << std::endl;
        Tcl_DecrRefCount(command[1]);

    }
    Tcl_DecrRefCount(command[0]);
}

//
//     PART II - vector object interface
//  
//     provide an interface that the user can use as a vector random access type interface. Useful when
//     all members of a container might require 
//     
int some_stats_vector_interface( ClientData cd, struct Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[] ) {
    Iterator_Environment* env = static_cast<Iterator_Environment*>(cd);
    some_stats* record  = env->get_current_record();
    if ( !record || objc < 2 ) {
        Tcl_AddErrorInfo( interp, "Unknown command or argument for vector interface access Object" );
        return TCL_ERROR;
    }

    const char* command = Tcl_GetStringFromObj( objv[1], NULL );
    // Example of the indexed random access method
    if ( strcmp( command, "size" ) == 0 ) {
        size_t sz = record->data.size();
        if (Tcl_IsShared(env->long_result)) {
            // Handle the case where the user has retained a reference to the old result.
            Tcl_DecrRefCount(env->long_result);
            env->long_result=Tcl_NewLongObj(sz);
            Tcl_IncrRefCount(env->long_result);
        } else {
            // Use existing copy since no references exist but our own.
            Tcl_SetLongObj(env->long_result, sz);
        }
        Tcl_SetObjResult( interp, env->long_result );
    } else if ( strcmp( command, "value" ) == 0 ) {
        if ( objc != 3 ) {
            Tcl_AddErrorInfo( interp, "Unknown command or argument for vector interface access Object" );
            return TCL_ERROR;
        }
        long index_val;
        int rc = Tcl_GetLongFromObj( interp, objv[2], &index_val );
        if ( rc != TCL_OK ) return rc;
        if ( index_val < 0 || index_val >= record->data.size() ) {
            Tcl_AddErrorInfo( interp, "Index out of bounds for vector interface access Object" );
            return TCL_ERROR;
        }
        double val = record->data[index_val];
        if (Tcl_IsShared(env->double_result)) {
            // Handle the case where the user has retained a reference to the old result.
            Tcl_DecrRefCount(env->double_result);
            env->double_result=Tcl_NewDoubleObj(val);
            Tcl_IncrRefCount(env->double_result);
        } else {
            // Use existing copy since no references exist but our own.
            Tcl_SetDoubleObj(env->double_result, val);
        }
        Tcl_SetObjResult( interp, env->double_result );
    } else {
        Tcl_AddErrorInfo( interp, "Unknown command for vector interface access Object" );
        return TCL_ERROR;
    }
    return TCL_OK;
}

// Vector command init
void Vector_Interface_Init( Tcl_Interp *interp, Iterator_Environment* env ) {
    Tcl_CreateObjCommand( interp, "arg1", some_stats_vector_interface, env, NULL );
}


//
//     PART III - foreach_instance interface
//
//     provide an interface that the user can call as a foreach style script where each 
//     member of the collection is presented as a value.  This is useful for streaming style 
//     interfaces where large numbers of objects are processed and only one object is available
//     at a time.
//

// Doing a foreach_instance command interface requires just a bit more data in the environment class
class Foreach_Iterator_Environment : public Iterator_Environment {
    public:
    Foreach_Iterator_Environment( std::string& proc ) : Iterator_Environment( proc ), iterator_is_active(false) {}
    std::vector<double>::iterator data_iterator;
    bool iterator_is_active;
};

//
// This implements the foreach_instance command itself
//
int some_stats_foreach_foreach_interface( ClientData cd, struct Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[] ) {
    if (objc != 2 ) {
        Tcl_AddErrorInfo( interp, "Incorrect arguments for VECTOR foreach_instance command: foreach_instance {body}" );
        return TCL_ERROR;
    }
    Foreach_Iterator_Environment* env = static_cast<Foreach_Iterator_Environment*>(cd);
    some_stats* record  = env->get_current_record();

    // As written, this interace doesn't allow nesting  - or multiple foreach_instance commands to run at the same time.
    if ( env->iterator_is_active ) {
        Tcl_AddErrorInfo( interp, "foreach_instance interface access Object does not allow nested foreach_instance calls." );
        return TCL_ERROR;
    }

    // Acquire the lock on use of foreach_instance
    env->iterator_is_active=true;

    std::vector<double>::iterator* evaluate_instances_iterator =  &env->data_iterator;

    for( *evaluate_instances_iterator = record->data.begin();
         (*evaluate_instances_iterator) != record->data.end();
         ++(*evaluate_instances_iterator)
       ) 
    {
        int code=Tcl_EvalObjEx(interp, objv[1], 0);
        /* Some simple handling of exception codes... */
        if (code == TCL_BREAK) break;
        if (code == TCL_CONTINUE) continue;
        if (code == TCL_ERROR) {
            Tcl_AddErrorInfo(interp, "\n    (in loop body)");
        }
        if (code != TCL_OK) return code;
    }
    // Release the lock on use of foreach_instance
    env->iterator_is_active=false;
    return TCL_OK;

}

//
// This implements the value retrieval inside a foreach command
//
int some_stats_foreach_value_interface( ClientData cd, struct Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[] ) {
    Foreach_Iterator_Environment* env = static_cast<Foreach_Iterator_Environment*>(cd);
    if ( objc != 2 ) {
        Tcl_AddErrorInfo( interp, "Unknown command or argument for foreach interface access Object" );
        return TCL_ERROR;
    }

    const char* command = Tcl_GetStringFromObj( objv[1], NULL );
    // Example of the indexed random access method
    if ( strcmp( command, "value" ) == 0 ) {
        if ( objc != 2 ) {
            Tcl_AddErrorInfo( interp, "Unknown command or argument for foreach interface access Object" );
            return TCL_ERROR;
        }
        double val = *env->data_iterator;
        if (Tcl_IsShared(env->double_result)) {
            // Handle the case where the user has retained a reference to the old result.
            Tcl_DecrRefCount(env->double_result);
            env->double_result=Tcl_NewDoubleObj(val);
            Tcl_IncrRefCount(env->double_result);
        } else {
            // Use existing copy since no references exist but our own.
            Tcl_SetDoubleObj(env->double_result, val);
        }
        Tcl_SetObjResult( interp, env->double_result );
    } else {
        Tcl_AddErrorInfo( interp, "Unknown command for person record Object" );
        return TCL_ERROR;
    }
    return TCL_OK;
}

// foreach_instance command init - used by the Iterator_Environment class to initialize the interface
void Foreach_Interface_Init( Tcl_Interp *interp, Iterator_Environment* env ) {
    Tcl_CreateObjCommand( interp, "foreach_instance", some_stats_foreach_foreach_interface, env, NULL );
    Tcl_CreateObjCommand( interp, "arg1", some_stats_foreach_value_interface, env, NULL );
}



//
//     PART IV - iterator object interface
//  
//     provide an interface that the user can use as an iterator style interface similar to the
//     C++ style iterators used in the Standard Template Library.
//

//
// This provides the Tcl_ObjType command interface needed for the iterator object itself.
// The 4 required object functions are put into the Tcl_ObjType structure to define the type
//
int iterator_object_set_from_any( Tcl_Interp *interp, Tcl_Obj *obj_Ptr ) {
    Tcl_AddErrorInfo( interp, "iterator interface can only be created from program argument." );
    return TCL_ERROR;
}
void iterator_object_update_string( Tcl_Obj *obj_ptr ) {
    const char* name = "vector_iterator";
    obj_ptr->bytes = (char*)ckalloc(strlen(name)+1);
    strcpy(obj_ptr->bytes,name);
}
void iterator_object_duplicate( Tcl_Obj *src_ptr, Tcl_Obj* dest_ptr ) {
    dest_ptr->internalRep.otherValuePtr = (void*) new std::vector<double>::iterator(
            *(reinterpret_cast<std::vector<double>::iterator*>(src_ptr->internalRep.otherValuePtr))
    );
}
void iterator_object_free( Tcl_Obj *obj_ptr ) {
    delete reinterpret_cast<std::vector<double>::iterator*>(obj_ptr->internalRep.otherValuePtr);
}
Tcl_ObjType iterator_object = {
    (char*)"iterator_object",
    iterator_object_free,
    iterator_object_duplicate,
    iterator_object_update_string,
    iterator_object_set_from_any
};

// This is the interface that the iterator uses for value retrieval and its increment function
int some_stats_iterator_value_interface( ClientData cd, struct Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[] ) {
    Iterator_Environment* env = static_cast<Iterator_Environment*>(cd);
    some_stats* record  = env->get_current_record();
    if ( !record || objc < 2 ) {
        Tcl_AddErrorInfo( interp, "Unknown command or argument for iterator interface access Object" );
        return TCL_ERROR;
    }

    const char* command = Tcl_GetStringFromObj( objv[1], NULL );
    if ( strcmp( command, "value" ) == 0 ) {
        // get the value associated with the iterator
        if ( objc != 3 ) {
            Tcl_AddErrorInfo( interp, "Unknown command or argument for iterator interface access Object" );
            return TCL_ERROR;
        }
        if ( objv[2]->typePtr  != &iterator_object ) {
            Tcl_AddErrorInfo( interp, "value command is only valid on an iterator object - see get_iterator." );
            return TCL_ERROR;
        }

        std::vector<double>::iterator* evaluate_instances_iterator = reinterpret_cast<std::vector<double>::iterator*> (objv[2]->internalRep.otherValuePtr);
        if ( *evaluate_instances_iterator == record->data.end() ) {
            Tcl_AddErrorInfo( interp, "value command not valid - iterator is at the end.  Use at_end to test for this." );
            return TCL_ERROR;
        }
        double val = **evaluate_instances_iterator;
        if (Tcl_IsShared(env->double_result)) {
            // Handle the case where the user has retained a reference to the old result.
            Tcl_DecrRefCount(env->double_result);
            env->double_result=Tcl_NewDoubleObj(val);
            Tcl_IncrRefCount(env->double_result);
        } else {
            // Use existing copy since no references exist but our own.
            Tcl_SetDoubleObj(env->double_result, val);
        }
        Tcl_SetObjResult( interp, env->double_result );
    } else if ( strcmp( command, "at_end" ) == 0 ) {
        // determine whether we are past the last element of the container
        if ( objc != 3 ) {
            Tcl_AddErrorInfo( interp, "Unknown command or argument for iterator interface access Object" );
            return TCL_ERROR;
        }
        if ( objv[2]->typePtr  != &iterator_object ) {
            Tcl_AddErrorInfo( interp, "at_end command is only valid on an iterator object - see get_iterator." );
            return TCL_ERROR;
        }
        std::vector<double>::iterator* evaluate_instances_iterator = reinterpret_cast<std::vector<double>::iterator*> (objv[2]->internalRep.otherValuePtr);

        int val = ( *evaluate_instances_iterator == record->data.end() ) ? 1 : 0;

        if (Tcl_IsShared(env->int_result)) {
            // Handle the case where the user has retained a reference to the old result.
            Tcl_DecrRefCount(env->int_result);
            env->int_result=Tcl_NewIntObj(val);
            Tcl_IncrRefCount(env->int_result);
        } else {
            // Use existing copy since no references exist but our own.
            Tcl_SetDoubleObj(env->int_result, val);
        }
        Tcl_SetObjResult( interp, env->int_result );
    } else if ( strcmp( command, "incr" ) == 0 ) {
        // get the value associated with the iterator
        if ( objc != 3 ) {
            Tcl_AddErrorInfo( interp, "Unknown command or argument for iterator interface access Object" );
            return TCL_ERROR;
        }
        if ( objv[2]->typePtr  != &iterator_object ) {
            Tcl_AddErrorInfo( interp, "incr command is only valid on an iterator object - see get_iterator." );
            return TCL_ERROR;
        }
        std::vector<double>::iterator* evaluate_instances_iterator = reinterpret_cast<std::vector<double>::iterator*> (objv[2]->internalRep.otherValuePtr);

        if ( *evaluate_instances_iterator == record->data.end() ) {
            Tcl_AddErrorInfo( interp, "incr called - iterator is already at the end.  Use at_end to test for this." );
            return TCL_ERROR;
        }
        ++(*evaluate_instances_iterator);

        // No return value
        return TCL_OK;
    } else if ( strcmp( command, "get_iterator" ) == 0 ) {
        Tcl_Obj *obj_ptr = Tcl_NewObj();
        obj_ptr->bytes=NULL;
        obj_ptr->internalRep.otherValuePtr = (void*) new std::vector<double>::iterator(record->data.begin());
        obj_ptr->typePtr = &iterator_object;
        Tcl_SetObjResult(interp,obj_ptr);
        return TCL_OK;
    } else {
        Tcl_AddErrorInfo( interp, "Unknown command for iterator interface access Object" );
        return TCL_ERROR;
    }
    return TCL_OK;
}

// Iterator command init
void Iterator_Interface_Init( Tcl_Interp *interp, Iterator_Environment* env ) {
    Tcl_CreateObjCommand( interp, "arg1", some_stats_iterator_value_interface, env, NULL );
}



//
// Basic event loop used by each of the interfaces except for List
//
void do_iterations( Iterator_Environment *env ) {

    std::string invoke_line = env->procname;
    invoke_line.append( " arg1" );

    for( int i=0; i<iteration_count; ++i ) 
    {
        env->set_record(i);

        double ret_val;
        // Now call the proc 
        int rc = Tcl_Eval( env->interp, invoke_line.c_str() );
        if ( rc != TCL_OK ) {
            Tcl_AppendResult(env->interp, "An error was encountered during evaluation of TCL code. ", NULL);
            const char * errorInfoStr  = Tcl_GetVar(env->interp, "errorInfo", TCL_GLOBAL_ONLY);
            if ( errorInfoStr ) std::cout << errorInfoStr << std::endl;
            break;
        }

        Tcl_Obj *res = Tcl_GetObjResult( env->interp );
        rc = Tcl_GetDoubleFromObj(env->interp, res, &ret_val );
        if ( rc != TCL_OK ) {
            Tcl_AppendResult(env->interp, "A floating point value was expected. ", NULL);
            const char * errorInfoStr  = Tcl_GetVar(env->interp, "errorInfo", TCL_GLOBAL_ONLY);
            if ( errorInfoStr ) std::cout << errorInfoStr << std::endl;
            break;
        }


        std::cout << ret_val << std::endl;

    }
}

main( int argc, const char** argv ) {

    const char* usage = "\n\nUsage: tcl_iter config_file\n\n"
                        "The config_file contains one line with three fields:\n\n"
                        "     script_file procname {vector|foreach|iterator}\n\n"
                        "The config_file field descriptions are:\n\n"
                        "     script_file - a file that contains a Tcl script.\n\n"
                        "     procname - the name of the Tcl proc in the script_file that you want called.\n\n"
                        "     {vector|foreach|iterator} - choose one of:\n"
                        "        list - provides a real Tcl list to procname.\n"
                        "        vector - provides a vector style interface to procname.\n"
                        "        foreach - provides a foreach style interface to procname.\n"
                        "        iterator - provides an iterator style interface to procname.\n"
                        ;


    // Parse arguments
    bool run_vector=false;
    bool run_foreach=false;
    bool run_iterator=false;
    bool run_list=false;
    if ( argc != 2 ) {
        std::cout << usage << std::endl;
        return 1;
    }
    std::string config_file = argv[1];
    std::ifstream infile( config_file.c_str() );
    if ( !infile ) {
        std::cout << usage << std::endl;
        return 1;
    }

    std::string user_script;
    infile >> user_script;
    if ( !infile ) {
        std::cout << "ERROR: no user_script found in config file." << std::endl;
        std::cout << usage << std::endl;
        return 1;
    }

    std::string proc_name;
    infile >> proc_name;
    if ( !infile ) {
        std::cout << "ERROR: no proc_name found in config file." << std::endl;
        std::cout << usage << std::endl;
        return 1;
    }

    std::string interface_type;
    infile >> interface_type;
    if ( interface_type == "vector" ) {
        run_vector=true;
    } else if ( interface_type == "foreach" ) {
        run_foreach=true;
    } else if ( interface_type == "iterator" ) {
        run_iterator=true;
    } else if ( interface_type == "list" ) {
        run_list=true;
    } else {
        std::cout << "ERROR: interface type not recognized: " << interface_type << std::endl;
        std::cout << usage << std::endl;
        return 1;
    }

    if (run_list) {
        Iterator_Environment Env(proc_name);
        Env.setup_interpreter( user_script, Vector_Interface_Init );
        do_list_iterations(&Env);
    } else if ( run_vector ) {
        Iterator_Environment Env(proc_name);
        Env.setup_interpreter( user_script, Vector_Interface_Init );
        do_iterations(&Env);
    } else if ( run_foreach ) {
        Foreach_Iterator_Environment Env(proc_name);
        Env.setup_interpreter( user_script, Foreach_Interface_Init );
        do_iterations(&Env);
    } else if ( run_iterator ) {
        Iterator_Environment Env(proc_name);
        Env.setup_interpreter( user_script, Iterator_Interface_Init );
        do_iterations(&Env);
    }
}