/*
        Example embedding a tcl interpreter
        for GUI enabling a Cobol program.

        Recife, Brazil, 2001 -- Rildo Pragana
 */

#include <tcl.h>
#include <tk.h>
#include <stdio.h>
#include <stdlib.h>
#include <memory.h>

/**** general use tcl procs for processing arguments ****/
#include "cobtools.h"

#ifdef WINDOWS
#include <windows.h>
#define TCTCL_PATH_DELIM_STR '\\'

BOOL _export WINAPI DllEntryPoint(HINSTANCE hInstance, DWORD seginfo,
                                  LPVOID lpCmdLine)
{
    /* Microsoft ONLY MAKES CRAP!!!!!!!!
    THIS DUMB FUNCTION EXISTS ONLY TO FULFILL MS-WINDOWS NEEDS.
    Bill Gates will burn in HELL. */
    return TRUE;
}
#else
#define TCTCL_PATH_DELIM_STR '/'
#endif

Tcl_Interp *interp;
int error_code;
Tk_Window mainwin;
int script_sourced = 0;

int tclErr(const char *msg)
{
    char *r;
    r = (char *) Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    fprintf(stderr, "%s:%s\n", msg, r);
    exit(1);
}

int initTcl()
{
    //	int argc=0;
    //	char *argv[]= { "tinycobol", ""};
    Tcl_FindExecutable("");
    interp = Tcl_CreateInterp();
    Tcl_AppInit(interp);
    mainwin = Tk_MainWindow(interp);
    return TCL_OK;
}

int newGui()
{
    script_sourced = 0;
    error_code = Tcl_Eval(interp, newgui);
    if (error_code != TCL_OK)
    {
        tclErr("newGui: error in Tcl_Eval");
    }
    return TCL_OK;
}

int endTcl()
{
    Tcl_DeleteInterp(interp);
    return TCL_OK;
}

int tcleval(char *data, char *scriptn)
{
    char *r;
    char *cobbuf;
    int size;
    char script[128], *s, *s1, *d;
    d = getenv("TCTCL_LIBRARY_PATH");
    s = script;
    s1 = scriptn;
    if (d)
    {
        while (*d != 0) *s++ = *d++;

        if (*d != TCTCL_PATH_DELIM_STR) *s++ = TCTCL_PATH_DELIM_STR;
    }

    while (*s1 != ' ') *s++ = *s1++;
    *s = 0;
    if (!script_sourced)
    {
        script_sourced++;
        error_code = Tcl_Eval(interp, cobtools);
        if (error_code != TCL_OK)
        {
            tclErr("tcleval: error evaluating cobtools");
        }
        error_code = Tcl_EvalFile(interp, script);
        if (error_code != TCL_OK)
        {
            tclErr("tcleval: error evaluating script");
        }
    }
    else
    {
        error_code = Tcl_Eval(interp, "cobol_update");
        if (error_code != TCL_OK)
        {
            tclErr("tcleval: error evaluating cobol_update");
        }
    }
    error_code = Tcl_Eval(interp, compute_block_size);
    if (error_code != TCL_OK)
    {
        tclErr("tcleval: error evaluating compute_block_size");
    }
    Tcl_GetInt(interp, Tcl_GetVar(interp, "block_size", TCL_GLOBAL_ONLY), &size);
    cobbuf = malloc(size + 1);
    memmove(cobbuf, data, size);
    cobbuf[size] = 0;
    /*printf("C script: %s received: %s\n",script,cobbuf);*/
    Tcl_SetVar(interp, "data_block", cobbuf, TCL_GLOBAL_ONLY);
    Tcl_Eval(interp, wait_ready);
    r = (char *) Tcl_GetVar(interp, "result", TCL_GLOBAL_ONLY);
    if (r != NULL)
    {
        memmove(data, r, strlen(r));
    }
    free(cobbuf);
    return TCL_OK;
}

int
Tcl_AppInit(Tcl_Interp *interp)
{

    if (Tcl_Init(interp) == TCL_ERROR)
    {
        return TCL_ERROR;
    }
    /*	Tcl_Eval(interp,"set dir $tcl_library;source $dir/tclIndex;unset dir");
     */
    if (Tk_Init(interp) == TCL_ERROR)
    {
        return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tk", Tk_Init, 0);
    /*Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);*/
    /*	Tcl_Eval(interp,"set dir $tk_library;source $dir/tclIndex;unset dir");
     */
    Tcl_SetVar(interp, "tcl_rcFileName", "~/.tctclrc", TCL_GLOBAL_ONLY);
    return TCL_OK;
}