/*
	Copyright (C) 1994 Sean Luke

	COWSStandardLibrary.m
	Version 1.0
	Sean Luke
	
*/




#import "COWSStandardLibrary.h"
#import <stdio.h>

@implementation COWSStandardLibrary

- loadLibrary:sender
	{
	id returnval=[super loadLibrary:sender];
	
	if (![sender conformsTo:@protocol(LibraryControl)])
		{
		printf ("StandardLibrary error:  Interpreter cannot accept Library Control protocol!\n");
		return NULL;
		}
	
	[sender addLibraryFunction:"="
			selector:@selector(COWSfunc_equal:)
			target:self];
	
	[sender addLibraryFunction:">"
			selector:@selector(COWSfunc_greater:)
			target:self];
	
	[sender addLibraryFunction:"<"
			selector:@selector(COWSfunc_lesser:)
			target:self];
	
	[sender addLibraryFunction:"+"
			selector:@selector(COWSfunc_add:)
			target:self];
	
	[sender addLibraryFunction:"-"
			selector:@selector(COWSfunc_subtract:)
			target:self];
	
	[sender addLibraryFunction:"*"
			selector:@selector(COWSfunc_multiply:)
			target:self];
	
	[sender addLibraryFunction:"/"
			selector:@selector(COWSfunc_divide:)
			target:self];
	
	[sender addLibraryFunction:"print"
			selector:@selector(COWSfunc_print:)
			target:self];
	
	[sender addLibraryFunction:"and"
			selector:@selector(COWSfunc_and:)
			target:self];
	
	[sender addLibraryFunction:"or"
			selector:@selector(COWSfunc_or:)
			target:self];
	
	[sender addLibraryFunction:"not"
			selector:@selector(COWSfunc_not:)
			target:self];
	
	[sender addLibraryFunction:"concatenate"
			selector:@selector(COWSfunc_concatenate:)
			target:self];
	
	[sender addLibraryFunction:"quote"
			selector:@selector(COWSfunc_quote:)
			target:self];
	
	[sender addLibraryFunction:"is"
			selector:@selector(COWSfunc_is:)
			target:self];
	
	[sender addLibraryFunction:"do"
			selector:@selector(COWSfunc_do:)
			target:self];
	
	[sender addLibraryFunction:"do-first"
			selector:@selector(COWSfunc_dofirst:)
			target:self];
	
	[sender addLibraryFunction:"error"
			selector:@selector(COWSfunc_error:)
			target:self];
	
	return returnval;
	}







- COWSfunc_equal:arg_list			// numerically compares the first
									// value against all the other values.
									// if they are equal, returns t.
									// returns f if there are no values,
									// or in any other situation.
	{
	float first;
	BOOL success=YES;
	id return_val=[[COWSStringNode alloc] init];
	id current;
	
	if ([arg_list top]==NULL) 				// no args
		{
		[return_val setString:"f"];
		return return_val;
		}
	else
		{
		current=[arg_list pop];
		first=atof([current string]);
		[current free];
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		if (first!=atof([current string]))
			{
			success=NO;
			[current free];
			break;
			}
		[current free];
		}
	if (success)
		{
		[return_val setString:"t"];
		}
	else
		{
		[return_val setString:"f"];
		}
	return return_val;
	}
	
	
	
	
- COWSfunc_greater:arg_list			// numerically compares the first
									// value against all the other values.
									// if it is greater, returns t.
									// returns f if there are no values,
									// or in any other situation.
	{
	float first;
	BOOL success=YES;
	id return_val=[[COWSStringNode alloc] init];
	id current;
	
	if ([arg_list top]==NULL) 				// no args
		{
		[return_val setString:"f"];
		return return_val;
		}
	else
		{
		current=[arg_list pop];
		first=atof([current string]);
		[current free];
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		if (first<=atof([current string]))
			{
			success=NO;
			[current free];
			break;
			}
		[current free];
		}
	if (success)
		{
		[return_val setString:"t"];
		}
	else
		{
		[return_val setString:"f"];
		}
	return return_val;
	}
	
	
- COWSfunc_lesser:arg_list			// numerically compares the first
									// value against all the other values.
									// if it is smaller, returns t.
									// returns f if there are no values,
									// or in any other situation.
	{
	float first;
	BOOL success=YES;
	id return_val=[[COWSStringNode alloc] init];
	id current;
	
	if ([arg_list top]==NULL) 				// no args
		{
		[return_val setString:"f"];
		return return_val;
		}
	else
		{
		current=[arg_list pop];
		first=atof([current string]);
		[current free];
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		if (first>=atof([current string]))
			{
			success=NO;
			[current free];
			break;
			}
		[current free];
		}
	if (success)
		{
		[return_val setString:"t"];
		}
	else
		{
		[return_val setString:"f"];
		}
	return return_val;
	}
	
	
	
	
- COWSfunc_is:arg_list				// string-compares the first
									// value against all the other values.
									// if it the same, returns t.
									// returns f if there are no values,
									// or in any other situation.
	{
	char* first;
	BOOL success=NO;
	id return_val=[[COWSStringNode alloc] init];
	id current;
	
	if ([arg_list top]==NULL) 				// no args
		{
		[return_val setString:"f"];
		return return_val;
		}
	else
		{
		current=[arg_list pop];
		first=newstr([current string]);
		[current free];
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		if (!strcmp(first,[current string]))
			{
			success=YES;
			[current free];
			break;
			}
		[current free];
		}
	if (success)
		{
		[return_val setString:"t"];
		}
	else
		{
		[return_val setString:"f"];
		}
	free(first);
	return return_val;
	}




	
- COWSfunc_print:arg_list	// prints each argument
							// returns first item
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;
	if ([arg_list top]!=NULL)
		{
		[return_val setString:[[arg_list top] string]];
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		printf("%s\n",[current string]);
		[current free];
		}
	return return_val;
	}
	
	
	
	
- COWSfunc_do:arg_list		// returns last item
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;

	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		[return_val setString:[current string]];		
							// pretty inefficient
		[current free];
		}
	return return_val;
	}
	



- COWSfunc_dofirst:arg_list		// returns first item
	{
	id return_val=[[COWSStringNode alloc] init];
	id current=[arg_list top];
	if (current!=NULL)
		{
		[return_val setString:[current string]];
		}
	return return_val;
	}




- COWSfunc_not:arg_list		// NOTs first item
	{
	id return_val=[[COWSStringNode alloc] init];
	id current=[arg_list top];
	if (current!=NULL)
		{
		if (!strcmp([current string],"t"))		// string is true
			{
			[return_val setString:"f"];
			}
		else
			{
			[return_val setString:"t"];
			}
		}
	return return_val;
	}




- COWSfunc_and:arg_list		// ANDs items
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;
	BOOL result=NO;
	
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=(!strcmp([current string],"t"));
		[current free];
		}
	else
		{
		[return_val setString:"or error: nothing to OR against."];
		[return_val setError:YES];
		return return_val;					
		}
		
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=result&&(!strcmp([current string],"t"));
		[current free];
		}
	else
		{
		[return_val setString:"or error: nothing to OR with."];
		[return_val setError:YES];
		return return_val;
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=result&&(!strcmp([current string],"t"));
		[current free];
		}
	[return_val setString: (result ? "t" : "f")]; 
	return return_val;
	}




- COWSfunc_or:arg_list		// ORs items
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;
	BOOL result=NO;
	
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=(!strcmp([current string],"t"));
		[current free];
		}
	else
		{
		[return_val setString:"or error: nothing to OR against."];
		[return_val setError:YES];
		return return_val;					
		}
		
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=result||(!strcmp([current string],"t"));
		[current free];
		}
	else
		{
		[return_val setString:"or error: nothing to OR with."];
		[return_val setError:YES];
		return return_val;
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=result||(!strcmp([current string],"t"));
		[current free];
		}
	[return_val setString: (result ? "t" : "f")]; 
	return return_val;
	}




- COWSfunc_add:arg_list		// adds items
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;
	float result;
	char pass_val[COWSLARGENUMBER];
	
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=atof([current string]);
		[current free];
		}
	else
		{
		[return_val setString:"+ error: nothing to add against."];
		[return_val setError:YES];
		return return_val;					
		}
		
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result+=atof([current string]);
		[current free];
		}
	else
		{
		[return_val setString:"+ error: nothing to add with."];
		[return_val setError:YES];
		return return_val;
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result+=atof([current string]);
		[current free];
		}
	sprintf(pass_val,"%f",result);
	[return_val setString:pass_val]; 
	return return_val;
	}


- COWSfunc_multiply:arg_list		// Multiplies items
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;
	float result;
	char pass_val[COWSLARGENUMBER];
	
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=atof([current string]);
		[current free];
		}
	else
		{
		[return_val setString:"* error: nothing to multiply against."];
		[return_val setError:YES];
		return return_val;					
		}
		
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result*=atof([current string]);
		[current free];
		}
	else
		{
		[return_val setString:"* error: nothing to multiply with."];
		[return_val setError:YES];
		return return_val;
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result*=atof([current string]);
		[current free];
		}
	sprintf(pass_val,"%f",result);
	[return_val setString:pass_val]; 
	return return_val;
	}




- COWSfunc_subtract:arg_list		// Subtracts items
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;
	float result;
	char pass_val[COWSLARGENUMBER];
	
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=atof([current string]);
		[current free];
		}
	else
		{
		[return_val setString:"- error: nothing to subtract against."];
		[return_val setError:YES];
		return return_val;					
		}
		
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result-=atof([current string]);
		[current free];
		}
	else
		{
		[return_val setString:"- error: nothing to subtract with."];
		[return_val setError:YES];
		return return_val;
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result-=atof([current string]);
		[current free];
		}
	sprintf(pass_val,"%f",result);
	[return_val setString:pass_val]; 
	return return_val;
	}



- COWSfunc_divide:arg_list		// divides items
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;
	float result;
	char pass_val[COWSLARGENUMBER];
	
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		result=atof([current string]);
		[current free];
		}
	else
		{
		[return_val setString:"/ error: nothing to divide against."];
		[return_val setError:YES];
		return return_val;					
		}
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		if (atof([current string])==0)
			{
			[return_val setString:"/ error: zero divide."];
			[return_val setError:YES];
			[current free];
			return return_val;					
			}
		result/=atof([current string]);
		[current free];
		}
	else
		{
		[return_val setString:"/ error: nothing to divide with."];
		[return_val setError:YES];
		return return_val;
		}
		
	while ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		if (atof([current string])==0)
			{
			[return_val setString:"/ error: zero divide."];
			[return_val setError:YES];
			[current free];
			return return_val;					
			}
		result/=atof([current string]);
		[current free];
		}
	sprintf(pass_val,"%f",result);
	[return_val setString:pass_val]; 
	return return_val;
	}




- COWSfunc_concatenate:arg_list
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;
	
	if ([arg_list top]!=NULL)
		{
		current=[arg_list pop];
		[return_val setString:[current string]];
		[current free];
		}
	else
		{
		[return_val setString:"concatenate error: nothing to concatenate against."];
		[return_val setError:YES];
		return return_val;					
		}
		
	if ([arg_list top]!=NULL)
		{
		int length;
		current=[arg_list pop];
		length=strlen([current string])+strlen([return_val string]);
		if (1)		// just something to get a block...
			{
			char buf[length+1];
			strcpy(buf,[return_val string]);
			strcat(buf,[current string]);
			buf[length]='\0';
			[return_val setString:buf];
			}
		[current free];
		}
	else
		{
		[return_val setString:"concatenate error: nothing to concatenate with."];
		[return_val setError:YES];
		return return_val;
		}
		
	while ([arg_list top]!=NULL)
		{
		int length;
		current=[arg_list pop];
		length=strlen([current string])+strlen([return_val string]);
		if (1)		// just something to get a block...
			{
			char buf[length+1];
			strcpy(buf,[return_val string]);
			strcat(buf,[current string]);
			buf[length]='\0';
			[return_val setString:buf];
			}
		[current free];
		}
	return return_val;
	}




- COWSfunc_quote:arg_list		// returns a double-quote
	{
	id return_val=[[COWSStringNode alloc] init];
	[return_val setString: "\""]; 
	return return_val;
	}




- COWSfunc_error:arg_list	// prints each argument
							// returns first item
	{
	id return_val=[[COWSStringNode alloc] init];
	id current;
	if ([arg_list top]==NULL)
		{
		[return_val setString:""];
		}
	else
		{
		current=[arg_list pop];
		[return_val setString:[current string]];
		[current free];
		}
	[return_val setError:YES];
	return return_val;
	}
	
- pauseCancelled:sender
	{
	return self;
	}
	




@end