root/trunk/orca/math.c

/*============================================================================
    ORCA Interpreter
    Copyright (C) 2005-2006  Karl Robillard

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
===========================================================================*/


#include "os_math.h"
#include "ovalue.h"
#include "internal.h"


extern int  orSeriesUsed( OValue* );
extern void orErrorOp( const char* name, OValue* );

extern void   init_genrand(unsigned long s);
extern long   genrand_int32();
extern double genrand_real2();


#define PI              3.14159265358979323846
#define DEG_TO_RAD      (PI / 180.0)


#define REF_RADIANS     a1+1


#define TRIG_FUNC(func) \
    double n; \
    if( a1->type == OT_DECIMAL ) { \
        n = orDecimal(a1); \
    } else { \
        n = (double) orInt(a1); \
        orSetTF( a1, OT_DECIMAL ); \
    } \
    if( orRefineSet(REF_RADIANS) ) \
        orDecimal(a1) = func( n ); \
    else \
        orDecimal(a1) = func( DEG_TO_RAD * n );


OR_NATIVE( orSineNative )
{
    TRIG_FUNC( mathSine )
}


OR_NATIVE( orCosineNative )
{
    TRIG_FUNC( mathCosine )
}


OR_NATIVE( orTangentNative )
{
    TRIG_FUNC( mathTan )
}


OR_NATIVE( orArcsineNative )
{
    TRIG_FUNC( mathASine )
}


OR_NATIVE( orArccosineNative )
{
    TRIG_FUNC( mathACosine )
}


OR_NATIVE( orArctangentNative )
{
    TRIG_FUNC( mathATan )
}


OR_NATIVE( orSquareRootNative )
{
    double n;
    if( a1->type == OT_DECIMAL )
    {
        n = orDecimal(a1);
    }
    else
    {
        n = (double) orInt(a1);
        orSetTF( a1, OT_DECIMAL );
    }
    orDecimal(a1) = mathSqrt( n );
}


#define REF_RAND_SEED       a1+1
#define REF_RAND_ONLY       a1+2

/* NOTE: random does not follow REBOL behavior. */
OR_NATIVE( orRandomNative )
{
    if( orRefineSet(REF_RAND_SEED) )
    {
        unsigned long seed;
        if( orInt(a1) )
            seed = orInt(a1);
        else
            seed = randomSeed();
        init_genrand( seed );
    }
    else
    {
        if( orIsSeries( orType(a1) ) )
        {
            if( orRefineSet(REF_RAND_ONLY) )
            {
                orError( "random/only not yet implemented " );
                return;
            }
            else
            {
                unsigned long rn;
                int used;

                used = orSeriesUsed( a1 );
                if( used > -1 )
                {
                    rn = genrand_int32();
                    used -= a1->series.it;
                    a1->series.it += rn % used;
                    return;
                }
            }
        }
        else if( orIs(a1, OT_DECIMAL) )
        {
            orDecimal(a1) *= genrand_real2();
            return;
        }
        else if( orIs(a1, OT_INTEGER) )
        {
            unsigned long rn = genrand_int32();
            orInt(a1) = (rn % orInt(a1)) + 1;
            return;
        }
        else if( orIs(a1, OT_LOGIC) )
        {
            orInt(a1) = genrand_int32() & 1;
            return;
        }
        /*
        else if( a1->type == OT_TUPLE )
        {
        }
        */
    }
    orError( "random does not handle %s", orDatatypeName(a1->type) );
}


static void orOpPower( OValue* a1 )
{
    double x, y;
    OValue* b = a1 + 1;
    if( a1->type == OT_INTEGER )
    {
        if( b->type == OT_INTEGER )
        {
            int sum;
            int n = orInt(b);
            if( n )
            {
                sum = orInt(a1);
                while( --n )
                    sum *= orInt(a1);
            }
            else
            {
                sum = 0;
            }
            orResult( OT_INTEGER, sum );
            return;
        }
        else if( b->type == OT_DECIMAL )
        {
            x = (double) orInt(a1);
            y = orDecimal(b);
            goto fp;
        }
        a1 = b;
    }
    else if( a1->type == OT_DECIMAL )
    {
        x = orDecimal(a1);
        if( b->type == OT_INTEGER )
        {
            y = (double) orInt(b);
            goto fp;
        }
        else if( b->type == OT_DECIMAL )
        {
            y = orDecimal(b);
            goto fp;
        }
        a1 = b;
    }
    orErrorOp( "**", a1 );
    return;

fp:
    orResultDECIMAL( pow(x, y) );
}


static void orOpRemainder( OValue* a1 )
{
    double x, y;
    OValue* b = a1 + 1;
    if( a1->type == OT_INTEGER )
    {
        if( b->type == OT_INTEGER )
        {
            orResult( OT_INTEGER, orInt(a1) % orInt(b) );
            return;
        }
        else if( b->type == OT_DECIMAL )
        {
            x = (double) orInt(a1);
            y = orDecimal(b);
            goto fp;
        }
        a1 = b;
    }
    else if( a1->type == OT_DECIMAL )
    {
        x = orDecimal(a1);
        if( b->type == OT_INTEGER )
        {
            y = (double) orInt(b);
            goto fp;
        }
        else if( b->type == OT_DECIMAL )
        {
            y = orDecimal(b);
            goto fp;
        }
        a1 = b;
    }
    orErrorOp( "//", a1 );
    return;

fp:
    orResultDECIMAL( mathMod(x, y) );
}


OR_NATIVE( orComplementNative )
{
    switch( a1->type )
    {
        case OT_LOGIC:
            orInt(a1) ^= 1;
            break;

        case OT_INTEGER:
            orInt(a1) = ~orInt(a1);
            break;

        case OT_BITSET:
        {
            OString* bin = orCopyString( a1->index, a1->series.it );
            uint8_t* it  = bin->byteArray;
            uint8_t* end = bin->byteArray + bin->used;
            while( it != end )
            {
                *it = ~(*it);
                ++it;
            }
            orSetSeries( a1, orStringN(bin), 0 );
        }
            break;
    }
}


OR_NATIVE( orAbsNative )
{
    switch( a1->type )
    {
        case OT_INTEGER:
            if( orInt(a1) < 0 )
                orInt(a1) = -orInt(a1);
            break;

        case OT_DECIMAL:
            if( orDecimal(a1) < 0.0 )
                orDecimal(a1) = -orDecimal(a1);
            break;

        case OT_PAIR:
            if( a1->pair[0] < 0 )
                a1->pair[0] = -a1->pair[0];
            if( a1->pair[1] < 0 )
                a1->pair[1] = -a1->pair[1];
            break;

        //case OT_DATE:
        //case OT_TIME:
        //    break;
    }
}


OR_NATIVE( orNegateNative )
{
    switch( a1->type )
    {
        case OT_INTEGER:
            orInt(a1) = -orInt(a1);
            break;

        case OT_DECIMAL:
            orDecimal(a1) = -orDecimal(a1);
            break;

        case OT_PAIR:
            a1->pair[0] = -a1->pair[0];
            a1->pair[1] = -a1->pair[1];
            break;

        case OT_BITSET:
            orComplementNative( a1 );
            break;

#ifdef OR_CONFIG_MATH3D
        case OT_VEC2:
        case OT_VEC3:
            a1->vec3.x = -a1->vec3.x;
            a1->vec3.y = -a1->vec3.y;
            a1->vec3.z = -a1->vec3.z;
            break;
#endif

        //case OT_TIME:
        //    break;
    }
}


#ifdef OR_CONFIG_MATH3D
extern void orDotNative( OValue* );
extern void orCrossNative( OValue* );
extern void orNormalizeNative( OValue* );
#endif

void orMathNatives()
{
    OValue* val;
    OContext ctx;

    orGlobalCtx( ctx );
    val = orIntern( &ctx, "pi", 2, 0 );
    orSetTF( val, OT_DECIMAL );
    orDecimal(val) = PI;

    init_genrand( randomSeed() );

    orMakeOp( orOpPower,    "**" );
    orMakeOp( orOpRemainder,"//" );

    orNative( orSineNative,         "sine"        );
    orNative( orCosineNative,       "cosine"      );
    orNative( orTangentNative,      "tangent"     );
    orNative( orArcsineNative,      "arcsine"     );
    orNative( orArccosineNative,    "arccosine"   );
    orNative( orArctangentNative,   "arctangent"  );
    orNative( orSquareRootNative,   "square-root" );
    orNative( orRandomNative,       "random"      );
    orNative( orOpPower,            "power"       );
    orNative( orOpRemainder,        "remainder"   );
    orNative( orComplementNative,   "complement"  );
    orNative( orAbsNative,          "abs"         );
    orNative( orNegateNative,       "negate"      );

#ifdef OR_CONFIG_MATH3D
    orNative( orDotNative,          "dot"         );
    orNative( orCrossNative,        "cross"       );
    orNative( orNormalizeNative,    "normalize"   );
#endif
}


/*EOF*/