/*
 * dviInterpTcl.c --
 *
 *      This file implements a Tcl interface to the routines in dviInterp.c.
 *      This is mostly useful for debugging.
 *
 * Copyright © 1999 Anselm Lingnau <lingnau@tm.informatik.uni-frankfurt.de>
 * See file COPYING for conditions on use and distribution.
 */

#include <string.h>
#include "dviInt.h"

#ifndef lint
static char rcsid[] VAR_UNUSED = "$Id: dviInterpTcl.c,v 1.3 2000/06/29 11:00:31 lingnau Exp $";
#endif /* lint */

EXTERN Dvi_Code *Dvi_GetCodeByCookie _ANSI_ARGS_((Tcl_Interp *, const char *,
						  const int));

#if DVI_DEBUG
/*
 * ------------------------------------------------------------------------
 *
 * DviInterpCmd --
 *
 *      Implements the `::dvi::interp' command. See the user documentation
 *      for details.
 *
 * ------------------------------------------------------------------------
 */

static int
DviInterpCmd (clientData, interp, objc, objv)
    ClientData clientData __attribute__((unused));
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj * CONST objv[];
{
    static enum {
	DVII_FONTS, DVII_GETFONTS, DVII_INIT, DVII_PARAMS,
	DVII_RENDER, DVII_RESET,
    } idx;
    static char *subCmds[] = {
	"fonts", "getfonts", "init", "parameters",
	"render", "reset",
	(char *)0
    };

    U32 resolution;
    char *cookie;
    Dvi_Code *dviCode;
    static Dvi_Interp *dviInterp = 0;
    char buf[40];
    int full;
    Dvi_FontList *listPtr;
    char *pageSpecStr;
    Dvi_PageSpec pageSpec;
    unsigned int currPage = 1;
    U8 *code;
    unsigned int pageNo;
    Tcl_DString dviOpcodes;

    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?parameters?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
			    TCL_EXACT, (int *)&idx) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (idx) {

    case DVII_INIT:
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "resolution -code cookie");
	    return TCL_ERROR;
	}

	if (Tcl_GetIntFromObj(interp, objv[2], (int *)&resolution) != TCL_OK) {
	    return TCL_ERROR;
	}

	cookie = Tcl_GetStringFromObj(objv[4], (int *)0);
	#if 0
	dviCode = Dvi_GetCodeByCookie(interp, cookie, TCL_LEAVE_ERR_MSG);
	if (dviCode == (Dvi_Code *)0) {
	    return TCL_ERROR;
	}
#endif
	if (dviInterp != 0) {
	    ckfree((char *)dviInterp);
	}
	dviInterp = Dvi_CreateInterpForCode(interp, resolution, resolution,
					    dviCode);
	break;

    case DVII_PARAMS:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
	    return TCL_ERROR;
	}

	if (dviInterp == 0) {
	    Tcl_SetResult(interp, "DVI interpreter uninitialized", TCL_STATIC);
	    return TCL_ERROR;
	}

#define APPEND(buf) Tcl_ListObjAppendElement(interp, resultPtr, \
					     Tcl_NewStringObj((buf), -1));
	sprintf(buf, "%lu", (unsigned long)dviInterp->xResolution);
	APPEND(buf);
	sprintf(buf, "%lu", (unsigned long)dviInterp->yResolution);
	APPEND(buf);
	sprintf(buf, "%.17e", (double)dviInterp->tfmConv); APPEND(buf);
	sprintf(buf, "%.17e", (double)dviInterp->xConv); APPEND(buf);
	sprintf(buf, "%.17e", (double)dviInterp->yConv); APPEND(buf);
	sprintf(buf, "%.17e", (double)dviInterp->trueXConv); APPEND(buf);
	sprintf(buf, "%.17e", (double)dviInterp->trueYConv); APPEND(buf);
	sprintf(buf, "%lu", (unsigned long)dviInterp->maxDrift); APPEND(buf);
	sprintf(buf, "%u", dviInterp->stackSize); APPEND(buf);
	break;

    case DVII_GETFONTS:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
	    return TCL_ERROR;
	}

	if (dviInterp == 0) {
	    Tcl_SetResult(interp, "DVI interpreter uninitialized", TCL_STATIC);
	    return TCL_ERROR;
	}

#if 0
	if (Dvi_FontsFromPostamble(dviInterp, /* FIXME */
				   dviInterp->dviFile) != TCL_OK) {
	    return TCL_ERROR;
	}
#endif
	break;

    case DVII_FONTS:
	if (objc != 2 && objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-full?");
	    return TCL_ERROR;
	}

	full = 0;
	if (objc == 3) {
	    char *flag = Tcl_GetStringFromObj(objv[2], (int *)0);
	    if (strcmp(flag, "-full") != 0) {
		Tcl_SetResult(interp, "invalid option", TCL_STATIC);
		return TCL_ERROR;
	    } else {
		full = 1;
	    }
	}

	if (dviInterp == 0) {
	    Tcl_SetResult(interp, "DVI interpreter uninitialized", TCL_STATIC);
	    return TCL_ERROR;
	}

	for (listPtr = dviInterp->fonts; listPtr; listPtr = listPtr->nextPtr) {
	    Tcl_Obj *item[2] = { 0, 0 };
	    item[0] = Tcl_NewLongObj((long)listPtr->fontNum);
	    item[1] = full
		? Dvi_FontDump(interp, listPtr->fontPtr)
		    : Tcl_NewStringObj(listPtr->fontPtr->fontName, -1);
	    Tcl_ListObjAppendElement(interp, resultPtr,
				     Tcl_NewListObj(2, item));
	}
	break;

    case DVII_RENDER:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "pagespec");
	    return TCL_ERROR;
	}

	if (dviInterp == 0) {
	    Tcl_SetResult(interp, "DVI interpreter uninitialized", TCL_STATIC);
	    return TCL_ERROR;
	}

	pageSpecStr = Tcl_GetStringFromObj(objv[2], (int *)0);
	if (Dvi_CodeGetPageSpec(pageSpecStr, &pageSpec) == 0) {
	    Tcl_AppendResult(interp, "Page specification \"", pageSpecStr,
			     "\" is invalid", (char *)0);
	    return TCL_ERROR;
	}

	pageNo = Dvi_CodeFindTeXPage(dviInterp->dviCode, &pageSpec);
	if (pageNo == -1) {
	    Tcl_AppendResult(interp, "Couldn't find page \"", pageSpecStr,
			     "\"", (char *)0);
	    return TCL_ERROR;
	}
	code = Dvi_CodeFindCodeForPage(dviInterp->dviCode, pageNo);
	if (code == (U8 *)0) {
	    Tcl_AppendResult(interp, "Couldn't find DVI code for page \"",
			     pageSpecStr, "\"", (char *)0);
	    return TCL_ERROR;
	}

	Tcl_DStringInit(&dviOpcodes);
	dviInterp->procData = (ClientData)&dviOpcodes;
	Dvi_ResetInterp(dviInterp, 0);
	Dvi_Interpret(dviInterp, code + 44);
	Tcl_DStringResult(interp, &dviOpcodes);
	break;

    case DVII_RESET:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
	    return TCL_ERROR;
	}

	if (dviInterp != 0) {
	    Dvi_ResetInterp(dviInterp, 1);
	}
	break;
    }
    return TCL_OK;
}
#endif /* DVI_DEBUG */

int
Dviinterp_Init (interp)
    Tcl_Interp *interp;
{
    Tcl_Obj *resultPtr;

#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, "8.0", 0) == 0) {
	return TCL_ERROR;
    }
#endif /* USE_TCL_STUBS */

    if (Tcl_PkgRequire(interp, "Dvicf", VERSION, 1) == (char *)0) {
	return TCL_ERROR;
    }

    if (Tcl_PkgProvide(interp, "Dviinterp", VERSION) != TCL_OK) {
	return TCL_ERROR;
    }

#if DVI_DEBUG
    Tcl_CreateObjCommand(interp, "::dvi::interp", DviInterpCmd,
			 (ClientData)0,
			 (Tcl_CmdDeleteProc *)0);
#endif /* DVI_DEBUG */

    return TCL_OK;
}
