

#import <stdio.h>
#import <math.h>
#import "COWSMathLibrary.h"

@implementation COWSMathLibrary

#define ERRBFLEN 128

// changed by Sean

char *needs1 = "Needs exactly one argument";
char *needs2 = "Needs exactly two argument";

static id
COWSMathErr(id result, const char *fname, const char *errmes)
{
    char buf[ERRBFLEN];

    if (NULL == errmes)
        sprintf(buf, "%s: %s", fname, strerror(errno));
    else 
        sprintf(buf, "%s %s", fname, errmes);
    [result setString: buf];
    [result setError: YES];
    return result;
}


- math_acos: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:acos([arg doubleVal])];
        if (errno) {    // set by acos if error occurred
            result = COWSMathErr(result, "Acos", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Acos", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_asin: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:asin([arg doubleVal])];
        if (errno) {    // set by asin if error occurred
            result = COWSMathErr(result, "Asin", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Asin", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_atan: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:atan([arg doubleVal])];
        if (errno) {    // set by atan if error occurred
            result = COWSMathErr(result, "Atan", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Atan", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_atan2: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:atan2([arg1 doubleVal], [arg2 doubleVal])];
        if (errno) {    // set by atan2 if error occurred
            result = COWSMathErr(result, "Atan2", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Atan2", needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- math_cos: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:cos([arg doubleVal])];
        if (errno) {    // set by cos if error occurred
            result = COWSMathErr(result, "Cos", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Cos", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_sin: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:sin([arg doubleVal])];
        if (errno) {    // set by sin if error occurred
            result = COWSMathErr(result, "Sin", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Sin", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_tan: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:tan([arg doubleVal])];
        if (errno) {    // set by tan if error occurred
            result = COWSMathErr(result, "Tan", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Tan", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_cosh: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:cosh([arg doubleVal])];
        if (errno) {    // set by cosh if error occurred
            result = COWSMathErr(result, "Cosh", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Cosh", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_sinh: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:sinh([arg doubleVal])];
        if (errno) {    // set by sinh if error occurred
            result = COWSMathErr(result, "Sinh", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Sinh", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_tanh: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:tanh([arg doubleVal])];
        if (errno) {    // set by tanh if error occurred
            result = COWSMathErr(result, "Tanh", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Tanh", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_exp: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:exp([arg doubleVal])];
        if (errno) {    // set by exp if error occurred
            result = COWSMathErr(result, "Exp", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Exp", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_ldexp: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:ldexp([arg1 doubleVal], [arg2 intVal])];
        if (errno) {    // set by ldexp if error occurred
            result = COWSMathErr(result, "Ldexp", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Ldexp", needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- math_log: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:log([arg doubleVal])];
        if (errno) {    // set by log if error occurred
            result = COWSMathErr(result, "Log", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Log", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_log10: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:log10([arg doubleVal])];
        if (errno) {    // set by log10 if error occurred
            result = COWSMathErr(result, "Log10", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Log10", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_pow: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:pow([arg1 doubleVal], [arg2 doubleVal])];
        if (errno) {    // set by pow if error occurred
            result = COWSMathErr(result, "Pow", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Pow", needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- math_sqrt: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:sqrt([arg doubleVal])];
        if (errno) {    // set by sqrt if error occurred
            result = COWSMathErr(result, "Sqrt", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Sqrt", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_ceil: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:ceil([arg doubleVal])];
        if (errno) {    // set by ceil if error occurred
            result = COWSMathErr(result, "Ceil", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Ceil", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_fabs: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:fabs([arg doubleVal])];
        if (errno) {    // set by fabs if error occurred
            result = COWSMathErr(result, "Fabs", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Fabs", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_floor: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:floor([arg doubleVal])];
        if (errno) {    // set by floor if error occurred
            result = COWSMathErr(result, "Floor", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Floor", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_fmod: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:fmod([arg1 doubleVal], [arg2 doubleVal])];
        if (errno) {    // set by fmod if error occurred
            result = COWSMathErr(result, "Fmod", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Fmod", needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- math_asinh: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:asinh([arg doubleVal])];
        if (errno) {    // set by asinh if error occurred
            result = COWSMathErr(result, "Asinh", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Asinh", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_acosh: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:acosh([arg doubleVal])];
        if (errno) {    // set by acosh if error occurred
            result = COWSMathErr(result, "Acosh", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Acosh", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_atanh: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:atanh([arg doubleVal])];
        if (errno) {    // set by atanh if error occurred
            result = COWSMathErr(result, "Atanh", NULL);
        }
    }
    else {
        result = COWSMathErr(result, "Atanh", needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

// From here on down I've either cut out stuff, made changes, or added.
// Sean Luke, May 14


#define COWSMATHLIBRARY_PI	3.141592653589793238462643383279502884197
#define COWSMATHLIBRARY_E	2.718281828459045235360287471352662497757

// these is defined to 40 decimal places

- math_pi: arg_list {
	id result=[[COWSStringNode alloc] init];
	
	[result setDoubleVal: COWSMATHLIBRARY_PI];
	return result;
}

- math_e: arg_list {
	id result=[[COWSStringNode alloc] init];
	
	[result setDoubleVal: COWSMATHLIBRARY_E];
	return result;
}

- math_rand: arg_list {
	id result=[[COWSStringNode alloc] init];
	double random=(double)rand();
	random/=(double)RAND_MAX;
	[result setDoubleVal: random];				// so 0 <= random <= 1
	return result;
}

- math_round: arg_list {
	id result=[[COWSStringNode alloc] init];
	id value;
	double val;
	
	if ((value=[arg_list top])==NULL) 
		return COWSMathErr(result, "round", needs1);
	val=[value doubleVal];
	
	if (val-floor(val)>.5) val=ceil(val);
	else val=floor(val);
	[result setDoubleVal:val];
	
	return result;
}

- math_strip: arg_list {
	id result=[[COWSStringNode alloc] init];
	id value;
	double val;
	
	if ((value=[arg_list top])==NULL) 
		return COWSMathErr(result, "round", needs1);
	val=[value doubleVal];

	if (val>0) val=floor(val);
	else val=ceil(val);	

	[result setDoubleVal:val];
	
	return result;
}


- math_max: arg_list {
	id result=[[COWSStringNode alloc] init];
	id value;
	double max;
	double new;
	
	[arg_list first];
	
	if ((value=[arg_list now])==NULL) 
		return COWSMathErr(result, "round", needs1);
	max=[value doubleVal];

	while ([arg_list next]!=NULL)
		{
		new=[[arg_list now] doubleVal];
		max= (max > new ? max : new);
		}

	[result setDoubleVal:max];
	
	return result;
}


- math_min: arg_list {
	id result=[[COWSStringNode alloc] init];
	id value;
	double min;
	double new;
	
	[arg_list first];
	
	if ((value=[arg_list now])==NULL) 
		return COWSMathErr(result, "round", needs1);
	min=[value doubleVal];

	while ([arg_list next]!=NULL)
		{
		new=[[arg_list now] doubleVal];
		min= (min < new ? min : new);
		}

	[result setDoubleVal:min];
	
	return result;
}


- math_ge:arg_list					// numerically compares the first
									// value against all the other values.
									// if it is greater or equal, returns t.
									// returns f if there are no values,
									// or in any other situation.
	{
	double first;
	BOOL success=YES;
	id return_val=[[COWSStringNode alloc] init];
	id current;
	
	if ([arg_list top]==NULL) 				// no args
		{
		[return_val setBooleanVal:NO];
		return return_val;
		}
	else
		{
		current=[arg_list pop];
		first=[current doubleVal];
		[current free];
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		if (first<[current doubleVal])
			{
			success=NO;
			[current free];
			break;
			}
		[current free];
		}
	if (success)
		{
		[return_val setBooleanVal:YES];
		}
	else
		{
		[return_val setBooleanVal:NO];
		}
	return return_val;
	}




- math_le:arg_list			// numerically compares the first
									// value against all the other values.
									// if it is smaller or equal, returns t.
									// returns f if there are no values,
									// or in any other situation.
	{
	double first;
	BOOL success=YES;
	id return_val=[[COWSStringNode alloc] init];
	id current;
	
	if ([arg_list top]==NULL) 				// no args
		{
		[return_val setBooleanVal:NO];
		return return_val;
		}
	else
		{
		current=[arg_list pop];
		first=[current doubleVal];
		[current free];
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		if (first>[current doubleVal])
			{
			success=NO;
			[current free];
			break;
			}
		[current free];
		}
	if (success)
		{
		[return_val setBooleanVal:YES];
		}
	else
		{
		[return_val setBooleanVal:NO];
		}
	return return_val;
	}





- math_factorial: arg_list
	{
	id result=[[COWSStringNode alloc] init];
	int x;
	int max_val;
	id value;
	double total=1.0;
	
	if ((value=[arg_list top])==NULL) 
		return COWSMathErr(result, "!", needs1);

	max_val=[value intVal];
	
	if (max_val<0) return 
		COWSMathErr(result,"!","Can't factorialize a negative number");
	
	if (max_val==0)
		{
		[result setDoubleVal:1.0];		// by definition
		return result;
		}
	
	// this function could go on for a VERY VERY long time accidentally.
	// So I have it check for user abort every 100 multiplies.
	
	for (x=1;x<=max_val;x++)
		{
		if ( !(x%100) && NXUserAborted() ) 
			return COWSMathErr(result,"!","Factorialization cancelled");
		total*=(double)x;		// must be double because ! rises very fast
		}
	[result setDoubleVal:total];
	return result;
	}




- loadLibrary:sender {
    id result = [super loadLibrary:sender];
	
	// seed random number generator
	
	srand((int)time(NULL));		// based on time of day 

    if (![sender conformsTo:@protocol(LibraryControl)]) {
        puts ("MathLibrary error: "
              "Interpreter doesn't conform to LibraryControl!");
        return NULL;
    }

    [sender addLibraryFunction: "acos"
                        selector:@selector(math_acos:)
                        target:self];
    [sender addLibraryFunction: "asin"
                        selector:@selector(math_asin:)
                        target:self];
    [sender addLibraryFunction: "atan"
                        selector:@selector(math_atan:)
                        target:self];
    [sender addLibraryFunction: "atan2"
                        selector:@selector(math_atan2:)
                        target:self];
    [sender addLibraryFunction: "cos"
                        selector:@selector(math_cos:)
                        target:self];
    [sender addLibraryFunction: "sin"
                        selector:@selector(math_sin:)
                        target:self];
    [sender addLibraryFunction: "tan"
                        selector:@selector(math_tan:)
                        target:self];
    [sender addLibraryFunction: "cosh"
                        selector:@selector(math_cosh:)
                        target:self];
    [sender addLibraryFunction: "sinh"
                        selector:@selector(math_sinh:)
                        target:self];
    [sender addLibraryFunction: "tanh"
                        selector:@selector(math_tanh:)
                        target:self];
    [sender addLibraryFunction: "log"
                        selector:@selector(math_log:)
                        target:self];
    [sender addLibraryFunction: "log-10"
                        selector:@selector(math_log10:)
                        target:self];
    [sender addLibraryFunction: "^"
                        selector:@selector(math_pow:)
                        target:self];
    [sender addLibraryFunction: "square-root"
                        selector:@selector(math_sqrt:)
                        target:self];
    [sender addLibraryFunction: "ceiling"
                        selector:@selector(math_ceil:)
                        target:self];
    [sender addLibraryFunction: "abs"
                        selector:@selector(math_fabs:)
                        target:self];
    [sender addLibraryFunction: "floor"
                        selector:@selector(math_floor:)
                        target:self];
    [sender addLibraryFunction: "mod"
                        selector:@selector(math_fmod:)
                        target:self];
    [sender addLibraryFunction: "asinh"
                        selector:@selector(math_asinh:)
                        target:self];
    [sender addLibraryFunction: "acosh"
                        selector:@selector(math_acosh:)
                        target:self];
    [sender addLibraryFunction: "atanh"
                        selector:@selector(math_atanh:)
                        target:self];    
    [sender addLibraryFunction: "pi"
                        selector:@selector(math_pi:)
                        target:self];    
    [sender addLibraryFunction: "e"
                        selector:@selector(math_e:)
                        target:self];
    [sender addLibraryFunction: "!"
                        selector:@selector(math_factorial:)
                        target:self];
    [sender addLibraryFunction: "random"
                        selector:@selector(math_rand:)
                        target:self];
    [sender addLibraryFunction: "round"
                        selector:@selector(math_round:)
                        target:self];
    [sender addLibraryFunction: "strip"
                        selector:@selector(math_strip:)
                        target:self];
    [sender addLibraryFunction: "min"
                        selector:@selector(math_min:)
                        target:self];
    [sender addLibraryFunction: "max"
                        selector:@selector(math_max:)
                        target:self];
    [sender addLibraryFunction: ">="
                        selector:@selector(math_ge:)
                        target:self];
    [sender addLibraryFunction: "<="
                        selector:@selector(math_le:)
                        target:self];
  return result;
}

@end
