blib_func.c

smallbasic for linux

/*
*	SmallBasic LIBRARY - STANDARD FUNCTIONS
*
*	2000-05-27, Nicholas Christopoulos
*
*	This program is distributed under the terms of the GPL v2.0 or later
*	Download the GNU Public License (GPL) from www.gnu.org
*/

#include "sys.h"
#include "str.h"
#include "kw.h"
#include "panic.h"
#include "var.h"
#include "blib.h"
#include "pproc.h"
#include "device.h"
#if defined(_UnixOS)
#include <sys/sysinfo.h>
#include <unistd.h>
#endif

void	cmd_pen()
{
	byte	code;
	
	if	( prog_error )	return;

	code = code_getnext();		
	if	( prog_error )	return;
	if	( code == kwOFF )
		dev_setpenmode(0);
	else if ( code == kwON )	
		dev_setpenmode(1);
	else
		err_syntax();
}

//
//	f <- FUNC (f|i)
//
double	cmd_math1(byte funcCode, var_t *arg)
{
	double	r = 0.0, x;

	if	( prog_error )	return 0;
	x = v_getval(arg);
					
	switch ( funcCode )	{
	case kwPEN:
		r = dev_getpen(x);
		break;
	case kwCOS:
		r = cos(x);
		break;
	case kwSIN:
		r = sin(x);
		break;
	case kwTAN:
		r = tan(x);
		break;
	case kwACOS:
		r = acos(x);
		break;
	case kwASIN:
		r = asin(x);
		break;
	case kwATAN:
		r = atan(x);
		break;
	case kwCOSH:
		r = cosh(x);
		break;
	case kwSINH:
		r = sinh(x);
		break;
	case kwTANH:
		r = tanh(x);
		break;
	case kwACOSH:
		#if defined(_Win32)
		r = log(x+sqrt(x*x-1));
		#else
		r = acosh(x);
		#endif
		break;
	case kwASINH:
		#if defined(_Win32)
		r = log(x + sqrt(x * x + 1));
		#else
		r = asinh(x);
		#endif
		break;
	case kwATANH:
		#if defined(_Win32)
		r = log((1+x)/(1-x))/2;
		#else
		r = atanh(x);
		#endif
		break;
	case kwSQR:
		r = sqrt(x);
		break;
	case kwABS:
		r = (x > 0.0) ? x : -x;
		break;
	case kwEXP:
		r = exp(x);
		break;
	case kwLOG:
		r = log(x);
		break;
	case kwLOG10:
		r = log10(x);
		break;
	case kwINT:
		r = floor(x);
		break;
	case kwDEG:
		r = x * 180.0 / PI;
		break;
	case kwRAD:
		r = x * PI / 180.0;
		break;
	case kwCDBL:
		r = x;
		break;
	case kwFIX:
		r = ceil(x);
		break;
	case kwRND:
		#if defined(_PalmOS)
		r = ((double) SysRandom(0)) / ((double) sysRandomMax + 1.0);
		#else
		r = ((double) rand()) / (RAND_MAX+1.0);
		#endif
		break;
		};

	return r;
}

//
//	i <- FUNC (f|i)
//
long	cmd_imath1(byte funcCode, var_t *arg)
{
	long	r = 0, x;

	if	( prog_error )	return 0;
	x = v_getint(arg);
					
	switch ( funcCode )	{
	case kwTIMER:
		//
		//	int <- TIMER	// seconds from 00:00
		//
		{
		#if defined(_PalmOS)
		DateTimeType cur_date;

		x = TimGetSeconds();
		TimSecondsToDateTime(x, &cur_date);
		r = cur_date.hour * 3600L + cur_date.minute * 60L + cur_date.second;
		#else
		struct tm tms;
		time_t	  now;

		time(&now);
		tms = *localtime(&now);
		r = tms.tm_hour * 3600L + tms.tm_min * 60L + tms.tm_sec;
		#endif
		}
		break;
	case kwTICKS:
		//
		//	int <- TICKS	// clock()
		//
		#if defined(_PalmOS)
		r = TimGetTicks();
		#else
		r = clock();
		#endif
		break;
	case kwTICKSPERSEC:
		//
		//	int <- TICKSPERSEC
		//
		#if defined(_PalmOS)
		r = SysTicksPerSecond();
		#else
		r = CLOCKS_PER_SEC;
		#endif
		break;
	case kwCINT:
		//
		//	int <- CINT(float)
		//
		r = x;
		break;
	case kwEOF:
		//
		//	int <- EOF(file-handle)
		//
		r = dev_feof(x);
		break;
	case kwSEEK:
		//
		//	int <- SEEK(file-handle)
		//
		r = dev_ftell(x);
		break;
	case kwLOF:
		//
		//	int <- LOF(file-handle)
		//
		r = dev_flength(x);
		break;
	case kwSGN:
		//
		//	int <- SGN(n)
		//
		r = v_sign(arg);
		break;
	case kwFRE:
		//
		//	int	<- FRE(0)	// free memory
		//	int <- FRE(-1)	// largest block of integers
		//	int <- FRE(-2)	// free stack
		//	int <- FRE(-3)	// largest free block
		//	Linux:
		//	int <- FRE(-10)	// total ram
		//
		{
		#if defined(_PalmOS)
		dword	dwfre, dwmax;
		Ptr		sts, ste;

		MemHeapFreeBytes(0, &dwfre, &dwmax);

		if	( x == -1 )
			r = (dwmax / (4 + sizeof(var_t))) - sizeof(var_t);
		else if ( x == -2 )	{
			SysGetStackInfo(&sts, &ste);
			r = (((sts <= ste) ? ste - sts : sts - ste)) + 1;
			// this is the total stack, I dont know 68000 assembly to get the SP
			}
		else if ( x == -3 )
			r = dwmax;
		else
			r = dwfre;
		#elif defined(_Win32)
		r = 0x7ffffff;		// linux has limits ? 0x7ffffff = 128MB -1
		#else
//		struct rlimit lim;
//		getrlimit(RLIMIT_MEMLOCK, &lim);
//		r = lim.rlim_cur;

		struct sysinfo	si;
		sysinfo(&si);
		
		switch ( x )	{
		case 0:
			r = si.freeram; /* / si.mem_unit */		// mem_unit used by Linux kernel 2.3.??+
			break;
		case -1:
			r = si.freeram / 4;
			break;
		case -2:
			r = si.freeram;
			break;
		case -3:
			r = si.freeram;
			break;
		case -10:
			r = si.totalram;
			break;
		default:
			r = 0;
			};
		#endif
		}
		break;
		};

	return r;
}

//
//	i|f <- FUNC (str)
//
void	cmd_ns1(byte funcCode, var_t *arg, var_t *r)
{
	if	( prog_error )	return;
	if	( arg->type != V_STR )	{
		v_tostr(arg);
		if	( prog_error )	return;
		}

	switch ( funcCode )	{
	case kwASC:
		//
		//	int <- ASC(s)
		//
		r->type = V_INT;
		r->i = *((byte*) arg->ptr);
		break;
	case kwLEN:
		//
		//	int <- LEN(s)
		//
		r->type = V_INT;
		r->i = strlen(arg->ptr);
		break;
	case kwVAL:
		//
		//	float <- VAL(s)
		//
		r->type = V_NUM;
		r->n = numexpr_strtof(arg->ptr);
		break;
	case kwTEXTWIDTH:
		//
		//	int <- TXTW(s)
		//
		r->type = V_INT;
		r->i = dev_textwidth(arg->ptr);
		break;
	case kwTEXTHEIGHT:
		//
		//	int <- TXTH(s)
		//
		r->type = V_INT;
		r->i = dev_textheight(arg->ptr);
		break;
	case kwEXIST:
		//
		//	int <- EXIST(s)
		//
		r->type = V_INT;
		r->i = dev_fexists(arg->ptr);
		break;
		};
}

//
//	str <- FUNC (any)
//
void	cmd_str1(byte funcCode, var_t *arg, var_t *r)
{
	char	*p, *wp;
	#if defined(_PalmOS)
	char	*tb;
	#endif
	int		l, i;

	switch ( funcCode )	{
	case kwCHR:
		//
		//	str <- CHR$(n)
		//
		wp = r->ptr = tmp_alloc(2);
		wp[0] = v_getint(arg);
		wp[1] = '\0';
		r->size = 2;
		break;
	case kwSTR:
		//
		//	str <- STR$(n)
		//
		r->ptr = tmp_alloc(64);
		if	( arg->type == V_INT )
			ltostr(arg->i, r->ptr);
		else
			ftostr(arg->n, r->ptr);
		r->size = strlen(r->ptr)+1;
		break;
	case kwOCT:
		//
		//	str <- OCT$(n)
		//
		#if defined(_PalmOS)
		// GAC - PalmOS does not support %lo in StrPrintF :(
		tb = tmp_alloc(64);
		p = tb;
		l=0;
		// Skip leading zeros
		for(i=33; l==0 && i>0; i-=3) {
			l = (v_getint(arg)>>i) & 0x7;
			}
		if(l==0) {
			wp = r->ptr = tmp_alloc(2);
			wp[0] = '0';
			wp[1] = '\0';
			}
		else	{
			// Add chars as needed
			for(i+=3; i>=0; i-=3) {
				*(p++) = ((v_getint(arg)>>i) & 0x7) + '0';
				}
			*p = '\0';
			r->ptr = tmp_alloc(strlen(tb) + 1);
			strcpy(r->ptr, tb);
			}
		tmp_free(tb);
		#else
		r->ptr = tmp_alloc(64);
		sprintf(r->ptr, "%lo", (unsigned long) v_getint(arg));
		#endif
		r->size = strlen(r->ptr)+1;
		break;
	case kwHEX:
		//
		//	str <- HEX$(n)
		//
		#if defined(_PalmOS)
		tb = tmp_alloc(64);
		StrPrintF(tb, "%lX", (unsigned long) v_getint(arg));
		p = tb;
		while ( *p == '0' )		p ++;

		if	( *p == '\0' )	{
			wp = r->ptr = tmp_alloc(2);
			wp[0] = '0';
			wp[1] = '\0';
			}
		else	{
			r->ptr = tmp_alloc(strlen(p) + 1);
			strcpy(r->ptr, p);
			}
		tmp_free(tb);

		#else
		r->ptr = tmp_alloc(64);
		sprintf(r->ptr, "%lX", (unsigned long) v_getint(arg));
		#endif
		r->size = strlen(r->ptr)+1;
		break;
	case	kwLCASE:
		//
		//	str <- LCASE$(s)
		//
		v_tostr(arg);
		if	( prog_error )	return;
		r->ptr = tmp_alloc(strlen(arg->ptr)+1);
		strcpy(r->ptr, arg->ptr);
		p = r->ptr;
		while ( *p )	{
			*p = to_lower(*p);
			p ++;
			}
		r->size = arg->size;
		break;
	case	kwUCASE:
		//
		//	str <- UCASE$(s)
		//
		v_tostr(arg);
		if	( prog_error )	return;
		r->ptr = tmp_alloc(strlen(arg->ptr)+1);
		strcpy(r->ptr, arg->ptr);
		p = r->ptr;
		while ( *p )	{
			*p = to_upper(*p);
			p ++;
			}
		r->size = arg->size;
		break;
	case	kwLTRIM:
		//
		//	str <- LTRIM$(s)
		//
		v_tostr(arg);
		if	( prog_error )	return;
		p = arg->ptr;
		while ( *p == ' ' || *p == '\t' )	p ++;
		r->ptr = tmp_alloc(strlen(p)+1);
		strcpy(r->ptr, p);
		r->size = strlen(r->ptr)+1;
		break;
	case	kwRTRIM:
		//
		//	str <- RTRIM$(s)
		//
		v_tostr(arg);
		if	( prog_error )	return;
		p = arg->ptr;
		if	( *p != '\0' )	{	// ndc: 20/2/2001
			while ( *p )	p ++;
			p--;
			while ( p >= (char *) arg->ptr && (*p == ' ' || *p == '\t') )	p --;
			p++;
			*p = '\0';
			}
		r->ptr = tmp_alloc(strlen(arg->ptr)+1);
		strcpy(r->ptr, arg->ptr);
		r->size = strlen(r->ptr)+1;
		break;
	case	kwCAT:
		// we can add color codes
		r->ptr = tmp_alloc(8);
		strcpy(r->ptr, "");
		l = v_getint(arg);
		switch ( l )	{
		case	0:	// reset
			strcpy(r->ptr, "\033[0m");
			break;
		case	1:	// bold on
			strcpy(r->ptr, "\033[1m");
			break;
		case	2:	// underline on
			strcpy(r->ptr, "\033[4m");
			break;
		case	3:	// reverse on
			strcpy(r->ptr, "\033[7m");
			break;
		case	80:	// select system font
		case	81:	case 82: case 83:
		case	84:	case 85: case 86:
		case	87:	case 88: case 89:
			#if defined(_PalmOS)
			StrPrintF(r->ptr, "\033[8%dm", l-80);
			#else
			sprintf(r->ptr, "\033[8%dm", l-80);
			#endif
			break;
		case	90:	// select custom font
		case	91:	case 92: case 93:
		case	94:	case 95: case 96:
		case	97:	case 98: case 99:
			if	( os_charset == enc_utf8 )	
			#if defined(_PalmOS)
				StrPrintF(r->ptr, "\033[9%dm", l-90);
			#else
				sprintf(r->ptr, "\033[9%dm", l-90);
			#endif
			break;
			}
		r->size = strlen(r->ptr)+1;
		break;
	case	kwTAB:
		l = v_igetval(arg);
		dev_setxy(l * 8, dev_gety());
		#if defined(_PalmOS)
		r->ptr = tmp_alloc(4);
		strcpy(r->ptr, " ");
		#else
		if	( os_graphics == 0 )	{
			r->ptr = tmp_alloc(l+1);
			memset(r->ptr, ' ', l);
			r->ptr[l] = '\0';
			}
		else	{
			r->ptr = tmp_alloc(4);
			strcpy(r->ptr, " ");
			}
		#endif
		r->size = l+1;
		break;
	case	kwSPACE:
		//
		//	str <- SPACE$(n)
		//
		l = v_getint(arg);
		wp = r->ptr = tmp_alloc(l+1);
		for ( i = 0; i < l; i ++ )
			wp[i] = ' ';
		wp[l] = '\0';
		r->size = strlen(r->ptr)+1;
		break;
		};

}

//
//	str <- FUNC (void)
//
void	cmd_str0(byte funcCode, var_t *r)
{
	word	ch;
	char	tmp[3];
	#if defined(_PalmOS)
	ULong	dts;
	DateTimeType cur_date;
	#else
	struct tm 	tms;
	time_t	  	now;
	#endif

	if	( prog_error )	return;
	switch ( funcCode )	{