/*
 * tclXmath.c --
 *
 * Mathematical Tcl commands.
 *-----------------------------------------------------------------------------
 * Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
 *
 * Permission to use, copy, modify, and distribute this software and its
 * documentation for any purpose and without fee is hereby granted, provided
 * that the above copyright notice appear in all copies.  Karl Lehenbauer and
 * Mark Diekhans make no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without express or
 * implied warranty.
 *
 * Copyright 2005 ActiveState Corporation.
 *
 *-----------------------------------------------------------------------------
 * $Id: tclXmath.c,v 1.2 2005/03/16 23:48:21 hobbs Exp $
 *-----------------------------------------------------------------------------
 */

#include "tclExtdInt.h"

#ifndef tclx_random
#  define tclx_srandom srandom
#  define tclx_random random
#endif

#ifdef TCL_WIDE_INT_TYPE
#define GET_DOUBLE_VALUE(doubleVar, argPtr, type)		\
    if ((type) == TCL_INT) {					\
	(doubleVar) = (double) (argPtr).intValue;		\
    } else if ((type) == TCL_WIDE_INT) {			\
	(doubleVar) = Tcl_WideAsDouble((argPtr).wideValue);	\
    } else { /* TCL_DOUBLE */					\
	(doubleVar) = (argPtr).doubleValue;			\
    }
#else
#define GET_DOUBLE_VALUE(doubleVar, argPtr, type)		\
    if ((type) == TCL_INT) {					\
	(doubleVar) = (double) (argPtr).intValue;		\
    } else { /* TCL_DOUBLE */					\
	(doubleVar) = (argPtr).doubleValue;			\
    }
#endif

/*
 * Prototypes of internal functions.
 */
static int	ConvertIntOrDoubleObj (Tcl_Interp *interp,
				                   Tcl_Obj    *numStrObj,
                                   double     *valuePtr);

static long	ReallyRandom (long my_range);

static int	TclX_MaxObjCmd (ClientData clientData,
                            Tcl_Interp *interp,
                            int         objc,
                            Tcl_Obj    *const objv[]);

static int	TclX_MinObjCmd (ClientData  clientData,
                            Tcl_Interp *interp,
                            int         objc,
                            Tcl_Obj    *const objv[]);

static int	TclX_MinMaxFunc (ClientData   clientData,
                             Tcl_Interp  *interp,
				             Tcl_Value *args,
                             Tcl_Value *resultPtr);

static int	TclX_RandomObjCmd (ClientData  clientData,
                               Tcl_Interp *interp,
				               int         objc,
                               Tcl_Obj     *const objv[]);


/*-----------------------------------------------------------------------------
 * ConvertIntOrDoubleObj --
 *
 *   Convert a number object that can be in any legal integer or floating point
 * format (including integer hex and octal specifications) to a double.
 *
 * Parameters:
 *   o interp (I) - Interpreters, errors are returns in result.
 *   o numStr (I) - Number to convert.
 *   o valuePtr (O) - Double value is returned here.
 * Returns:
 *   TCL_OK or TCL_ERROR.
 *-----------------------------------------------------------------------------
 */
static int	ConvertIntOrDoubleObj (Tcl_Interp *interp,
				                   Tcl_Obj    *numStrObj,
                                   double     *valuePtr)
{
#ifdef TCL_WIDE_INT_TYPE
    Tcl_WideInt wVal;

    if (Tcl_GetWideIntFromObj (interp, numStrObj, &wVal) == TCL_OK) {
	*valuePtr = Tcl_WideAsDouble(wVal);
	return TCL_OK;
    }
#else
    long lvalue;

    if (Tcl_GetLongFromObj (interp, numStrObj, &lvalue) == TCL_OK) {
	*valuePtr = (double) lvalue;
	return TCL_OK;
    }
#endif

    if (Tcl_GetDoubleFromObj (interp, numStrObj, valuePtr) == TCL_OK)
	return TCL_OK;

    return TCL_ERROR;
}

/*-----------------------------------------------------------------------------
 * TclX_MaxObjCmd --
 *      Implements the Tcl max command:
 *        max num1 ?..numN?
 *
 * Results:
 *      Standard TCL results.
 *-----------------------------------------------------------------------------
 */
static int	TclX_MaxObjCmd (ClientData clientData,
                            Tcl_Interp *interp,
                            int         objc,
                            Tcl_Obj    *const objv[])
{
    double value, maxValue = -MAXDOUBLE;
    int idx, maxIdx = 1;

    if (objc < 2)
	return TclX_WrongArgs (interp, objv[0], "num1 ?..numN?");

    for (idx = 1; idx < objc; idx++) {
	if (ConvertIntOrDoubleObj (interp, objv [idx], &value) != TCL_OK)
	    return TCL_ERROR;
        if (value > maxValue) {
            maxValue = value;
            maxIdx = idx;
        }
    }
    Tcl_SetObjResult (interp, objv [maxIdx]);
    return TCL_OK;
}

/*-----------------------------------------------------------------------------
 * TclX_MinObjCmd --
 *     Implements the TCL min command:
 *         min num1 ?..numN?
 *
 * Results:
 *      Standard TCL results.
 *-----------------------------------------------------------------------------
 */
static int	TclX_MinObjCmd (ClientData  clientData,
                            Tcl_Interp *interp,
                            int         objc,
                            Tcl_Obj    *const objv[])
{
    double value, minValue = MAXDOUBLE;
    int idx, minIdx   = 1;

    if (objc < 2)
	return TclX_WrongArgs (interp, objv[0], "num1 ?..numN?");

    for (idx = 1; idx < objc; idx++) {
        if (ConvertIntOrDoubleObj (interp, objv [idx], &value) != TCL_OK)
            return TCL_ERROR;
        if (value < minValue) {
            minValue = value;
            minIdx = idx;
	}
    }
    Tcl_SetObjResult (interp, objv [minIdx]);
    return TCL_OK;
}

/*-----------------------------------------------------------------------------
 *
 * TclX_MaxFunc --
 *      Implements the Tcl max math function
 *        expr max(num1, num2)
 *
 * Results:
 *      Standard TCL results.
 *
 *-----------------------------------------------------------------------------
 */
static int	TclX_MinMaxFunc (ClientData   clientData,
                             Tcl_Interp  *interp,
				             Tcl_Value *args,
                             Tcl_Value *resultPtr)
{
    size_t isMax = (size_t) clientData;
    Tcl_ValueType t0 = args[0].type;
    Tcl_ValueType t1 = args[1].type;

    if ((t1 == TCL_DOUBLE) || (t0 == TCL_DOUBLE)) {
	double d0, d1;
	/*
	 * Compare as doubles.
	 */
	GET_DOUBLE_VALUE(d0, args[0], t0);
	GET_DOUBLE_VALUE(d1, args[1], t1);

        resultPtr->type = TCL_DOUBLE;
	if (isMax) {
	    resultPtr->doubleValue = (d0 < d1) ? d1 : d0;
	} else {
	    resultPtr->doubleValue = (d0 > d1) ? d1 : d0;
	}
#ifdef TCL_WIDE_INT_TYPE
    } else if ((t1 == TCL_WIDE_INT) || (t0 == TCL_WIDE_INT)) {
	Tcl_WideInt w0, w1;
	/*
	 * Compare as wide ints (neither are doubles)
	 */
	w0 = (t0 == TCL_INT) ? Tcl_LongAsWide(args[0].intValue) :
	    args[0].wideValue;
	w1 = (t1 == TCL_INT) ? Tcl_LongAsWide(args[1].intValue) :
	    args[1].wideValue;

        resultPtr->type = TCL_WIDE_INT;
	if (isMax) {
	    resultPtr->wideValue = (w0 < w1) ? w1 : w0;
	} else {
	    resultPtr->wideValue = (w0 > w1) ? w1 : w0;
	}
#endif
    } else {
	/*
	 * Compare as ints.
	 */
	long i0 = args[0].intValue;
	long i1 = args[1].intValue;

        resultPtr->type = TCL_INT;
	if (isMax) {
	    resultPtr->intValue = (i0 < i1) ? i1 : i0;
	} else {
	    resultPtr->intValue = (i0 > i1) ? i1 : i0;
	}
    }
    return TCL_OK;
}

/*-----------------------------------------------------------------------------
 * ReallyRandom --
 *     Insure a good random return for a range, unlike an arbitrary
 *     random() % n, thanks to Ken Arnold, Unix Review, October 1987.
 *-----------------------------------------------------------------------------
 */
#define RANDOM_RANGE 0x7fffffffL

static long 
ReallyRandom (long myRange)
{
    long maxMultiple, rnum;

    maxMultiple = RANDOM_RANGE / myRange;
    maxMultiple *= myRange;
    while ((rnum = tclx_random ()) >= maxMultiple)
        continue;
    return (rnum % myRange);
}

/*-----------------------------------------------------------------------------
 * TclX_RandomObjCmd  --
 *     Implements the TCL random command:
 *     random limit | seed ?seedval?
 *
 * Results:
 *  Standard TCL results.
 *-----------------------------------------------------------------------------
 */
static int	TclX_RandomObjCmd (ClientData  clientData,
                               Tcl_Interp *interp,
				               int         objc,
                               Tcl_Obj     *const objv[])
{
    long range;
    char *seedString;

    if ((objc < 2) || (objc > 3))
        goto invalidArgs;

    if (Tcl_GetLongFromObj ((Tcl_Interp *) NULL, objv [1], &range) == TCL_OK) {
        if (objc != 2)
            goto invalidArgs;

        if ((range <= 0) || (range > RANDOM_RANGE))
            goto outOfRange;
    } else {
        int seed;

	seedString = Tcl_GetStringFromObj (objv [1], NULL);
	if (!STREQU (seedString, "seed"))
	    goto invalidArgs;

	if (objc == 3) {
	    if (Tcl_GetIntFromObj (interp, objv[2], &seed) != TCL_OK)
		return TCL_ERROR;
	} else {
	    seed = (getpid () + time ((time_t *)NULL));
	}
	(void) tclx_srandom (seed);
	return TCL_OK;
    }
    Tcl_SetIntObj (Tcl_GetObjResult (interp), ReallyRandom (range));
    return TCL_OK;

  invalidArgs:
    return TclX_WrongArgs (interp, objv[0], "limit | seed ?seedval?");

  outOfRange:
    {
        char buf [18];

        sprintf (buf, "%ld", RANDOM_RANGE);
        TclX_AppendObjResult (interp, " range must be > 0 and <= ", buf,
                              (char *) NULL);
        return TCL_ERROR;
    }
}

/*-----------------------------------------------------------------------------
 *  TclX_MathInit --
 *
 *    Initialize the TclX math commands and functions.
 *-----------------------------------------------------------------------------
 */
void
TclX_MathInit (Tcl_Interp *interp)
{
    int major, minor;
    Tcl_ValueType minMaxArgTypes[2];

    minMaxArgTypes[0] = TCL_EITHER;
    minMaxArgTypes[1] = TCL_EITHER;

    Tcl_CreateObjCommand (interp, "max", TclX_MaxObjCmd,
	    (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);

    Tcl_CreateObjCommand (interp, "min", TclX_MinObjCmd,
	    (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);

    Tcl_CreateObjCommand (interp, "random", TclX_RandomObjCmd,
	    (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);

    /*
     * Tcl 8.5 added core min/max expr functions
     */
    Tcl_GetVersion(&major, &minor, NULL, NULL);
    if ((major == 8) && (minor <= 4)) {
	Tcl_CreateMathFunc(interp, "max", 2, minMaxArgTypes,
		TclX_MinMaxFunc, (ClientData) 1 /* IS_MAX */);

	Tcl_CreateMathFunc (interp, "min", 2, minMaxArgTypes,
		TclX_MinMaxFunc, (ClientData) 0 /* IS_MIN */);
    }
}


/* vim: set ts=4 sw=4 sts=4 et : */
