/*
 * dviTcl.c --
 *
 *      This file ties together the Tcl interfaces to the DVI routines.
 *      It also contains some Tcl command procedures that don't seem to
 *      fit elsewhere.
 *
 * Copyright © 1999 Anselm Lingnau <lingnau@tm.informatik.uni-frankfurt.de>
 * See file COPYING for conditions on use and distribution.
 */

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

EXTERN int Dvicf_Init _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int Dviinterp_Init _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int Dvifont_Init _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int Dviimg_Init _ANSI_ARGS_((Tcl_Interp *interp));

static int GetPixelsCmd _ANSI_ARGS_((ClientData, Tcl_Interp*, int,
				    Tcl_Obj * CONST[]));
static int GetDistanceCmd _ANSI_ARGS_((ClientData, Tcl_Interp*, int,
				    Tcl_Obj * CONST[]));
static int PageSpecCmd _ANSI_ARGS_((ClientData, Tcl_Interp*, int,
				    Tcl_Obj * CONST[]));
static int AssocCmd _ANSI_ARGS_((ClientData, Tcl_Interp *, int,
				 Tcl_Obj * CONST[]));

/*
 * ------------------------------------------------------------------------
 *
 * Dvi_GetPixels --
 *
 *     Calculate the number of pixels for a given dimension (scale factor
 *     and unit) at a given resolution.
 *
 * Results:
 *     A standard Tcl result. If the result is TCL_OK, the number of
 *     pixels is in the variable pointed to by `result'. If the result
 *     is TCL_ERROR, an error has occurred. If TCL_LEAVE_ERR_MSG is set
 *     in `flags', a more detailed error message is put into the Tcl
 *     result string.
 *
 * ------------------------------------------------------------------------
 */

static struct units {
    char *name;
    double conv;
} units[] = {
    { "px", 1.0 },		/* This must be the first entry */
    { "in", 1.0 },
    { "cm", 2.54 },
    { "mm", 25.4 },
    { "pt", 72.27 },
    { "bp", 72 },
    { "pc", 72.27 / 12 },
    { "dd", 72.27 * 1157.0 / 1238 },
    { "cc", 72.27 * 1157.0 / 1238 / 12 },
    { "sp", 72.27 * 65536 },
    { (char *)0, 0 }
};

int
Dvi_GetPixels (interp, resolution, string, result, flags)
    Tcl_Interp *interp;
    const int resolution;
    const char *string;
    int *result;
    const int flags;
{
    double scale = 0.0;
    char *unit;
    struct units *u;

    *result = 0;
    if ((scale = strtod(string, &unit)) == HUGE_VAL || scale < 0) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    Tcl_SetResult(interp, "scale factor out of range", TCL_STATIC);
	}
	return TCL_ERROR;
    }
    
    if (unit == string) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    Tcl_SetResult(interp, "invalid scale factor", TCL_STATIC);
	}
	return TCL_ERROR;
    }

    if (*unit == '\0') {
	*result = (int)ceil(scale);
	return TCL_OK;
    }

    units[0].conv = resolution;
    for (u = units; u->name && strcmp(unit, u->name) != 0; u++)
	;
    if (u->name) {
	*result = (int)ceil(scale / u->conv * resolution);
	return TCL_OK;
    }
    if (flags & TCL_LEAVE_ERR_MSG) {
	Tcl_SetResult(interp, "unknown unit", TCL_STATIC);
    }
    return TCL_ERROR;
}

/*
 * ------------------------------------------------------------------------
 *
 * Dvi_GetDistance --
 *
 *     Calculate a distance (in a specified unit) from a number of pixels
 *     at a given resolution.
 *
 * Results:
 *     A standard Tcl result. If the result is TCL_OK, the
 *     distance is left in the variable pointed to by `result',
 *     If the result is TCL_ERROR, an error has occurred. In this case,
 *     if TCL_LEAVE_ERR_MSG is set in `flags', a more detailed error
 *     message is put into the Tcl result string.
 *
 * ------------------------------------------------------------------------
 */

int
Dvi_GetDistance (interp, resolution, pixels, unit, result, flags)
    Tcl_Interp *interp;
    const int resolution;
    const double pixels;
    const char *unit;
    double *result;
    const int flags;
{
    struct units *u;

    units[0].conv = resolution;
    for (u = units; u->name && strcmp(unit, u->name) != 0; u++)
	;
    if (u->name == 0) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    Tcl_SetResult(interp, "unknown unit", TCL_STATIC);
	}
	return TCL_ERROR;
    }

    *result = u->conv * pixels / resolution;
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *
 * GetPixelsCmd --
 *
 *      Implements the `::dvi::pixels' command. See the user documentation
 *      for details.
 *
 * ------------------------------------------------------------------------
 */

static int
GetPixelsCmd (clientData, interp, objc, objv)
    ClientData clientData __attribute__((unused));
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj * CONST objv[];
{
    int resolution;		/* Resolution for pixel conversion */
    int result;			/* Resulting distance */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "resolution distance");
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &resolution) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Dvi_GetPixels(interp, resolution,
		      Tcl_GetStringFromObj(objv[2], (int *)0),
		      &result, TCL_LEAVE_ERR_MSG) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *
 * GetDistanceCmd --
 *
 *      Implements the `::dvi::distance' command. See the user
 *      documentation for details.
 *
 * ------------------------------------------------------------------------
 */

static int
GetDistanceCmd (clientData, interp, objc, objv)
    ClientData clientData __attribute__((unused));
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj * CONST objv[];
{
    int resolution;		/* Resolution for pixel conversion */
    double pixels;		/* Pixel quantity to be converted */
    double result;		/* Result buffer */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "resolution pixels unit");
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &resolution) != TCL_OK
	|| Tcl_GetDoubleFromObj(interp, objv[2], &pixels) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Dvi_GetDistance(interp, resolution, pixels,
			Tcl_GetStringFromObj(objv[3], (int *)0),
			&result, TCL_LEAVE_ERR_MSG) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(result));
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *
 * DviPageSpecCmd --
 *
 *     This command exposes the Dvi_CodeGetPageSpec() function for use in
 *     the test suite.
 *
 * ------------------------------------------------------------------------
 */

#if DVI_DEBUG
static int
PageSpecCmd (clientData, interp, objc, objv)
    ClientData clientData __attribute__((unused));
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj * CONST objv[];
{
    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
    Dvi_PageSpec pageSpec;
    char careVec[10];
    Tcl_Obj *tmpObj;
    int i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "pagespec");
	return TCL_ERROR;
    }

    if (Dvi_CodeGetPageSpec(Tcl_GetStringFromObj(objv[1], (int *)0),
			    &pageSpec) == 0) {
	Tcl_AppendStringsToObj(resultPtr, "page specification \"",
			       Tcl_GetStringFromObj(objv[1], (int *)0),
			       "\" is invalid", (char *)0);
	return TCL_ERROR;
    }

    if (pageSpec.countersUsed == DVI_PS_ABSOLUTE) {
	tmpObj = Tcl_NewStringObj("Abs", -1);
	if (Tcl_ListObjAppendElement(interp, resultPtr, tmpObj) != TCL_OK) {
	    return TCL_ERROR;
	}
	tmpObj = Tcl_NewIntObj(pageSpec.number[0]);
	if (Tcl_ListObjAppendElement(interp, resultPtr, tmpObj) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	tmpObj = Tcl_NewIntObj(pageSpec.countersUsed);
	if (Tcl_ListObjAppendElement(interp, resultPtr, tmpObj) != TCL_OK) {
	    return TCL_ERROR;
	}

	sprintf(careVec, "%0x", pageSpec.careVector);
	tmpObj = Tcl_NewStringObj(careVec, -1);
	if (Tcl_ListObjAppendElement(interp, resultPtr, tmpObj) != TCL_OK) {
	    return TCL_ERROR;
	}

	tmpObj = Tcl_NewIntObj(pageSpec.occurrences);
	if (Tcl_ListObjAppendElement(interp, resultPtr, tmpObj) != TCL_OK) {
	    return TCL_ERROR;
	}

	for (i = 0; i < pageSpec.countersUsed; i++) {
	    tmpObj = Tcl_NewIntObj(pageSpec.number[i]);
	    if (Tcl_ListObjAppendElement(interp, resultPtr, tmpObj)!=TCL_OK) {
		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
}

static int
AssocCmd (clientData, interp, objc, objv)
    ClientData clientData __attribute__((unused));
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj * CONST objv[];
{
    char buf[20];
    sprintf(buf, "%p",
	    (void *)Tcl_GetAssocData(interp, "Dvi",
				     (Tcl_InterpDeleteProc **)0));
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}
#endif /* DVI_DEBUG */

int
Tkdvi_Init (interp)
    Tcl_Interp *interp;
{
#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, "8.0", 0) == 0) {
	return TCL_ERROR;
    }
#endif /* USE_TCL_STUBS */

    Tcl_CreateObjCommand(interp, "::dvi::pixels", GetPixelsCmd,
		      (ClientData)0, (Tcl_CmdDeleteProc *)0);
    Tcl_CreateObjCommand(interp, "::dvi::distance", GetDistanceCmd,
		      (ClientData)0, (Tcl_CmdDeleteProc *)0);

#if DVI_DEBUG
    Tcl_CreateObjCommand(interp, "::dvi::pagespec", PageSpecCmd,
		      (ClientData)0, (Tcl_CmdDeleteProc *)0);

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

    /*
     * This makes use of a trick explained by Paul Duffin. All the
     * different Tcl extensions are collected into one shareable
     * library, which speeds up loading. The downside is that we
     * need a custom pkgIndex.tcl.
     */

    Tcl_StaticPackage((Tcl_Interp *)0, "Dvicf", Dvicf_Init,
		      (Tcl_PackageInitProc *)0);
    Tcl_StaticPackage((Tcl_Interp *)0, "Dviinterp", Dviinterp_Init,
		      (Tcl_PackageInitProc *)0);
    Tcl_StaticPackage((Tcl_Interp *)0, "Dvifont", Dvifont_Init,
		      (Tcl_PackageInitProc *)0);

#if ENABLE_TK
    Tcl_StaticPackage((Tcl_Interp *)0, "Dviimg", Dviimg_Init,
		      (Tcl_PackageInitProc *)0);
#endif

    return TCL_OK;
}
