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

#include "kpathsea/kpathsea.h"
#include "dviInt.h"

static int DviFontCmd _ANSI_ARGS_((ClientData, Tcl_Interp*, int,
				   Tcl_Obj * CONST[]));

/*
 * ------------------------------------------------------------------------
 *
 * DviFontCmd --
 *
 *      Implements the `::dvi::font' command. See the user documentation
 *      for details.
 *
 * ------------------------------------------------------------------------
 */

static int
DviFontCmd (clientData, interp, objc, objv)
    ClientData clientData __attribute__((unused));
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj * CONST objv[];
{
    static enum {
	DVIFN_FINDFILE, DVIFN_LIST, DVIFN_PURGE,
#if DVI_DEBUG
	DVIFN_INTERP, DVIFN_LOAD, DVIFN_INFO, DVIFN_FREE,
#endif /* DVI_DEBUG */
    } idx;
    static char *subCmds[] = {
	"findfile", "list", "purge",
#if DVI_DEBUG
	"_interp", "_load", "_info", "_free",
#endif /* DVI_DEBUG */
	(char *)0
    };

    unsigned int res;
    Dvi_FontType type;
    char *fontName;
    int fontNameLength;
    char *fileName;
    char buf[20];
#if DVI_DEBUG
    U32 check;
    U32 fontScale;
    U32 designSize;
    U32 resolution;
    static Dvi_Interp *dviInterp = 0;
    static Tcl_HashTable *fontNamesPtr = 0;
    Dvi_Font *fontPtr;
#endif /* DVI_DEBUG */
    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) {

	/*
	 * Find the file name, actual resolution and font type used
	 * for the given font at the given resolution.
	 */

    case DVIFN_FINDFILE:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "fontname resolution");
	    return TCL_ERROR;
	}

	if (Tcl_GetIntFromObj(interp, objv[3], (int *)&res) != TCL_OK) {
            return TCL_ERROR;
        }
	fontName = Tcl_GetStringFromObj(objv[2], &fontNameLength);
        fileName = Dvi_FindFontFile((unsigned int)fontNameLength, fontName,
                                &res, &type);
        if (fileName == (char *)0) {
            Tcl_AppendResult(interp, "Font \"", fontName, "\" at ",
			     Tcl_GetStringFromObj(objv[3], (int *)0),
			     " dpi not found", (char *)0);
            return TCL_ERROR;
        }
        Tcl_ListObjAppendElement(interp, resultPtr,
				 Tcl_NewStringObj(fileName, -1));
        sprintf(buf, "%u", res);
	Tcl_ListObjAppendElement(interp, resultPtr,
				 Tcl_NewStringObj(buf, -1));
        sprintf(buf, "%d", type);
	Tcl_ListObjAppendElement(interp, resultPtr,
				 Tcl_NewStringObj(buf, -1));
        ckfree(fileName);
	break;

#if DVI_DEBUG
	/*
	 * List all fonts currently in use.
	 */

    case DVIFN_LIST:
	Tcl_SetObjResult(interp, Dvi_FontDumpAll(interp));
	break;

	/*
	 * Initialize a DVI interpreter, which is necessary for
	 * explicit font loading.
	 */

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

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

	if (dviInterp != 0) {
	    ckfree((char *)dviInterp);
	}
	dviInterp = Dvi_CreateInterp(interp, resolution, resolution,
				     32, 25400000, 473628672, 1000);
	break;

	/*
	 * Load a named font.
	 */

    case DVIFN_LOAD:
	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name check scale designSize");
	    return TCL_ERROR;
	}

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

	if (fontNamesPtr == 0) {
	    fontNamesPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	    Tcl_InitHashTable(fontNamesPtr, TCL_STRING_KEYS);
	}

	fontName = Tcl_GetStringFromObj(objv[2], &fontNameLength);
	if (Tcl_GetIntFromObj(interp, objv[3], (int *)&check) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[4], (int *)&fontScale) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[5], (int *)&designSize) != TCL_OK) {
	    return TCL_ERROR;
	}
	
	fontPtr = Dvi_FontFind(dviInterp, check, fontScale, designSize,
			       fontNameLength, fontName);
	if (fontPtr == (Dvi_Font *)0) {
	    return TCL_ERROR;
	} else {
	    char key[20];
	    Tcl_HashEntry *entryPtr;
	    int new;
	    sprintf(key, "fn%lx", (unsigned long)fontPtr);
	    entryPtr = Tcl_CreateHashEntry(fontNamesPtr, key, &new);
	    if (new) {
		Tcl_SetHashValue(entryPtr, (ClientData)fontPtr);
	    }
	    Tcl_SetResult(interp, key, TCL_VOLATILE);
	}
	break;

	/*
	 * Free a font, or display info about a font.
	 */

    case DVIFN_INFO: case DVIFN_FREE:
	if (fontNamesPtr == 0) {
	    fontNamesPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	    Tcl_InitHashTable(fontNamesPtr, TCL_STRING_KEYS);
	}

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "fontId");
	    return TCL_ERROR;
	} else {
	    char *fontId = Tcl_GetStringFromObj(objv[2], (int *)0);
	    Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(fontNamesPtr, fontId);
	    if (entryPtr == 0) {
		Tcl_SetResult(interp, "font ID does not exist", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (idx == DVIFN_FREE) {
		Dvi_FontFree((Dvi_Font *)Tcl_GetHashValue(entryPtr));
	    } else {
		Tcl_SetObjResult(interp, Dvi_FontDump(interp,
				 (Dvi_Font *)Tcl_GetHashValue(entryPtr)));
	    }
	}
	break;
#endif /* DVI_DEBUG */

	/*
	 * Remove all fonts that are currently unused.
	 */

    case DVIFN_PURGE:
        Dvi_FontPurge();
	break;
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *
 * Dvifont_Init --
 *
 *      This procedure initializes the `Dvifont' Tcl extension. It has the
 *      fairly important job of setting up everything for the Kpathsea
 *      library.
 *
 * ------------------------------------------------------------------------
 */

int
Dvifont_Init (interp)
    Tcl_Interp *interp;
{
    char *progName;
    char *envSuffix;
    int makePK;
    char *mfMode;
    char *defaultFont;
    int resolution;

    Tcl_Obj *resultPtr;
    Tcl_Obj *dviObjPtr;
    Tcl_Obj *namePtr, *objPtr;

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

    Dvi_CreateFontType_PK();
    Dvi_CreateFontType_VF();
    Dvi_CreateFontType_TFM();

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

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

    /*
     * Try to determine the program name for the benefit of Kpathsea.
     */

    if (Tcl_EvalObj(interp, Tcl_NewStringObj("info script", -1)) != TCL_OK) {
	return TCL_ERROR;
    }
    resultPtr = Tcl_GetObjResult(interp);
    progName = Tcl_GetStringFromObj(resultPtr, (int *)0);
    if (strlen(progName) == 0) {
	if (Tcl_EvalObj(interp, Tcl_NewStringObj("info nameofexecutable", -1))
	    != TCL_OK) {
	    return TCL_ERROR;
	}
	resultPtr = Tcl_GetObjResult(interp);
	progName = Tcl_GetStringFromObj(resultPtr, (int *)0);
    }

    /*
     * The Kpathsea library lets us specify names of the form XYZ.foo,
     * where `foo' is a suffix specific to a certain program, to give
     * various alternatives for the variable XYZ. TkDVI uses the value
     * of the Tcl variable dvi(progname), or (by default) "tkdvi".
     */

    dviObjPtr = Tcl_NewStringObj("dvi", 3);
    namePtr = Tcl_NewStringObj("progname", 8);
    objPtr = Tcl_ObjGetVar2(interp, dviObjPtr, namePtr, TCL_GLOBAL_ONLY);
    if (objPtr == (Tcl_Obj *)0) {
	envSuffix = "tkdvi";
    } else {
	envSuffix = Tcl_GetStringFromObj(objPtr, (int *)0);
    }

    kpse_set_program_name(progName, envSuffix);

    /*
     * Try to get the (horizontal) resolution from dvi(xresolution),
     * the desired Metafont mode from dvi(mfmode), and the font to be
     * used in emergencies from dvi(defaultfont), for the purposes of
     * locating and generating fonts.
     */

    namePtr = Tcl_NewStringObj("xresolution", 11);
    objPtr = Tcl_ObjGetVar2(interp, dviObjPtr, namePtr, TCL_GLOBAL_ONLY);
    if (objPtr == (Tcl_Obj *)0) {
	resolution = 600;
    } else {
	if (Tcl_GetIntFromObj(interp, objPtr, &resolution) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    Tcl_SetStringObj(namePtr, "makepk", 6);
    objPtr = Tcl_ObjGetVar2(interp, dviObjPtr, namePtr, TCL_GLOBAL_ONLY);
    if (objPtr == (Tcl_Obj *)0) {
	makePK = 1;
    } else {
	if (Tcl_GetBooleanFromObj(interp, objPtr, &makePK) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    Tcl_SetStringObj(namePtr, "mfmode", 6);
    objPtr = Tcl_ObjGetVar2(interp, dviObjPtr, namePtr, TCL_GLOBAL_ONLY);
    if (objPtr == (Tcl_Obj *)0) {
	mfMode = "ljfour";
    } else {
	mfMode = Tcl_GetStringFromObj(objPtr, (int *)0);
    }

    Tcl_SetStringObj(namePtr, "defaultfont", 11);
    objPtr = Tcl_ObjGetVar2(interp, dviObjPtr, namePtr, TCL_GLOBAL_ONLY);
    if (objPtr == (Tcl_Obj *)0) {
	defaultFont = "cmr10";
    } else {
	defaultFont = Tcl_GetStringFromObj(objPtr, (int *)0);
    }

#if 0
    fprintf(stderr, "envSuffix = \"%s\", resolution = %d\n", envSuffix,
	    resolution);
    fprintf(stderr, "mfMode = \"%s\", defaultFont = \"%s\"\n", mfMode,
	    defaultFont);
#endif

    Tcl_ResetResult(interp);

    kpse_init_prog(envSuffix, resolution, mfMode, defaultFont);
    kpse_set_program_enabled(kpse_pk_format, makePK, kpse_src_cmdline);

    Tcl_CreateObjCommand(interp, "::dvi::font", DviFontCmd,
			 (ClientData)0,
			 (Tcl_CmdDeleteProc *)0);

    return TCL_OK;
}
