ports//science/euler/work/euler-1.61.0/src/output.c

/*
 *	Euler - a numerical laboratory
 *
 *	file : output.c -- output and formatting stuff for outputs
 *
 *	version 1.60.4 changes : formatting features have been put in this file.
 */

#include <stdio.h>
#include <string.h>
#include <stdarg.h>
#include <math.h>
#include <float.h>

#include "sysdep.h"
#include "stack.h"
#include "output.h"
#include "mainloop.h"
#include "command.h"

static int fieldw=16,linew=5,ilinew=1,precission=5,iprecission=15;
static double maxexpo=1.0e6,minexpo=1.0e-5;
static int outputlength=14,ioutputlength=42;
static char expoformat[16]="%0.6g";
static char fixedformat[16]="%0.6g";
static int iformat=42;
static double fraceps=0;

static char *outputbuffer=0,*outputbufferend;
static int outputbuffererror=0;

/*
 *	output format definition
 */
void mformat (header *hd)
{	header *st=hd,*result;
	static int l=10,d=5;
	int oldl=l,oldd=d;
	hd=getvalue(hd); if (error) return;
	if (hd->type!=s_matrix || dimsof(hd)->r!=1 || dimsof(hd)->c!=2)
		wrong_arg_in("format");
	l=(int)*matrixof(hd); d=(int)*(matrixof(hd)+1);
	if (l<2 || l>80 || d<0 || d>(DBL_DIG+4))
		wrong_arg_in("format");
	if (d>l-3) d=l-3;
	outputlength=l;
	if (outputlength>64) outputlength=64;
	if (outputlength<1) outputlength=1;
	sprintf(fixedformat,"%%0.%df",d);
	sprintf(expoformat,"%%0.%de",d);
	minexpo=pow(10,-d);
	maxexpo=pow(10,l-d-3);
	fieldw=l+1;
	linew=linelength/fieldw;
	if (linew<=0) linew=1;
	if (iformat==0)
	{	ioutputlength=2*outputlength;
		ilinew=linelength/ioutputlength;
		if (ilinew<=0) ilinew=1;
	}
	result=new_matrix(1,2,""); if (error) return;
	*matrixof(result)=oldl;
	*(matrixof(result)+1)=oldd;
	moveresult(st,result);
}

void mgformat (header *hd)
{	header *st=hd,*result;
	static int l=10,d=5;
	int oldl=l,oldd=d;
	hd=getvalue(hd); if (error) return;
	if (hd->type!=s_matrix || dimsof(hd)->r!=1 || dimsof(hd)->c!=2)
		wrong_arg_in("goodformat");
	l=(int)*matrixof(hd); d=(int)*(matrixof(hd)+1);
	if (l<2 || l>80 || d<0 || d>(DBL_DIG+4))
		wrong_arg_in("goodformat");
	if (d>l-3) d=l-3;
	outputlength=l;
	precission=d;
	if (outputlength>64) outputlength=64;
	if (outputlength<1) outputlength=1;
	sprintf(fixedformat,"%%0.%dg",d+1);
	sprintf(expoformat,"%%0.%dg",d+1);
	minexpo=pow(10,-d);
	maxexpo=pow(10,l-d-3);
	fieldw=l+1;
	linew=linelength/fieldw;
	if (linew<=0) linew=1;
	if (iformat==0)
	{	ioutputlength=2*outputlength;
		ilinew=linelength/ioutputlength;
		if (ilinew<=0) ilinew=1;
	}
	result=new_matrix(1,2,""); if (error) return;
	*matrixof(result)=oldl;
	*(matrixof(result)+1)=oldd;
	moveresult(st,result);
	fraceps=0;
}

void meformat (header *hd)
{	header *st=hd,*result;
	static int l=10,d=5;
	int oldl=l,oldd=d;
	hd=getvalue(hd); if (error) return;
	if (hd->type!=s_matrix || dimsof(hd)->r!=1 || dimsof(hd)->c!=2)
		wrong_arg_in("expformat");
	l=(int)*matrixof(hd); d=(int)*(matrixof(hd)+1);
	if (l<2 || l>80 || d<0 || d>(DBL_DIG+4))
		wrong_arg_in("expformat");
	if (d>l-3) d=l-3;
	outputlength=l;
	precission=d;
	if (outputlength>64) outputlength=64;
	if (outputlength<1) outputlength=1;
	sprintf(fixedformat,"%%0.%de",d);
	sprintf(expoformat,"%%0.%de",d);
	minexpo=pow(10,-d);
	maxexpo=pow(10,l-d-3);
	fieldw=l+1;
	linew=linelength/fieldw;
	if (linew<=0) linew=1;
	if (iformat==0)
	{	ioutputlength=2*outputlength;
		ilinew=linelength/ioutputlength;
		if (ilinew<=0) ilinew=1;
	}
	result=new_matrix(1,2,""); if (error) return;
	*matrixof(result)=oldl;
	*(matrixof(result)+1)=oldd;
	moveresult(st,result);
	fraceps=0;
}

void mfformat (header *hd)
{	header *st=hd,*result;
	static int l=10,d=5;
	int oldl=l,oldd=d;
	hd=getvalue(hd); if (error) return;
	if (hd->type!=s_matrix || dimsof(hd)->r!=1 || dimsof(hd)->c!=2)
		wrong_arg_in("fixedformat");
	l=(int)*matrixof(hd); d=(int)*(matrixof(hd)+1);
	if (l<2 || l>80 || d<0 || d>(DBL_DIG+4))
		wrong_arg_in("fixedformat");
	if (d>l-3) d=l-3;
	outputlength=l;
	precission=d;
	if (outputlength>64) outputlength=64;
	if (outputlength<1) outputlength=1;
	sprintf(fixedformat,"%%0.%df",d);
	sprintf(expoformat,"%%0.%df",d);
	minexpo=pow(10,-d);
	maxexpo=pow(10,l-d-3);
	fieldw=l+2;
	linew=linelength/fieldw;
	if (linew<=0) linew=1;
	if (iformat==0)
	{	ioutputlength=2*outputlength;
		ilinew=linelength/ioutputlength;
		if (ilinew<=0) ilinew=1;
	}
	result=new_matrix(1,2,""); if (error) return;
	*matrixof(result)=oldl;
	*(matrixof(result)+1)=oldd;
	moveresult(st,result);
	fraceps=0;
}

void miformat (header *hd)
{	header *st=hd,*result;
	int oldi=iformat,k;
	hd=getvalue(hd); if (error) return;
	if (hd->type!=s_real) wrong_arg_in("iformat");
	k=(int)(*realof(hd));
	if (k>0)
	{   iformat=k;
		if (k>80) k=80;
		if (k<21) k=21;
		iprecission=(k-3)/2-7;
		ioutputlength=k;
		ilinew=1;
		if (ilinew<=0) ilinew=1;
	}
	else
	{   iformat=0;
		ilinew=linew/2;
		if (ilinew<=0) ilinew=1;
		ioutputlength=outputlength*2;
	}
	result=new_real(oldi,""); if (error) return;
	moveresult(st,result);
	fraceps=0;
}

void mfracformat (header *hd)
{	header *st=hd,*result;
	int oldl=outputlength,l;
	double oldeps=fraceps,eps;
	hd=getvalue(hd); if (error) return;
	if (hd->type!=s_matrix || dimsof(hd)->r!=1 || dimsof(hd)->c!=2)
		wrong_arg_in("fracformat");
	l=(int)*matrixof(hd);
	eps=*(matrixof(hd)+1);
	if (l<2 || l>80 || eps<=0 || eps>1)
		wrong_arg_in("fracformat");
	outputlength=l;
	fieldw=l+1;
	linew=linelength/fieldw;
	if (linew<=0) linew=1;
	result=new_matrix(1,2,""); if (error) return;
	*matrixof(result)=oldl;
	*(matrixof(result)+1)=oldeps;
	moveresult(st,result);
    fraceps=eps;
}

/*
 *	high level output functions for real, matrix, fraction
 */

#define MAX 1e+10
#define MIN 1e-10

static double frac (double v, long *n, long *d, double error)
{
	long D, N, t;
	double epsilon, r=0, m;
	int count=0;


	if (v < MIN || v > MAX || error < 0.0)
		return(-1.0);
	*d = D = 1;
	*n = (int)v;
	N = (*n) + 1;
	goto three;

one:	count++;
	if (r > 1.0)
		goto two;
	r = 1.0/r;
two:	N += (*n)*(long)r;
	D += (*d)*(long)r;
	(*n) += N;
	(*d) += D;
three:
	if (v*(*d) == (double)(*n))
		goto four;
	r = (N - v*D)/(v*(*d) - (*n));
	if (r > 1.0)
		goto four;
	t = N;
	N = (*n);
	*n = t;
	t = D;
	D = (*d);
	*d = t;
four:
	epsilon = fabs(1.0 - (*n)/(v*(*d)));
	if (epsilon <= error)
		goto six;
	m = 1.0;
	do {
		m *= 10.0;
	} while (m*epsilon < 1.0);
	epsilon = 1.0/m * ((int)(0.5 + m*epsilon));
	six : if (epsilon <= error)
		return 0;
	if (r != 0.0 && count<1000)
		goto one;
	return -1;
}

#undef MIN
#undef MAX

static int frac_out (double x)
{   long n,d;
	if (x==0.0) output1hold(0,"0");
	else
	{	if (frac(fabs(x),&n,&d,fraceps)<0) return 0;
		if (x<0) output1hold(0,"-");
		else output1hold(0,"");
		if (d>1) output1hold(-1,"%ld/%ld",n,d);
		else output1hold(-1,"%ld",n);
	}
	return 1;
}

static int frac_out0 (double x)
{   long n,d;
	if (x==0.0) output1hold(-1,"0");
	else
	{	if (frac(fabs(x),&n,&d,fraceps)<0) return 0;
		if (x<0) output1hold(-1,"-");
		else output1hold(-1,"");
		if (d>1) output1hold(-1,"%ld/%ld",n,d);
		else output1hold(-1,"%ld",n);
	}
	return 1;
}

static void double_out (double x)
/***** double_out
	print a double number.
*****/
{   if (fraceps>0)
	{	if (!frac_out(x)) goto one;
	}
	else
	{   one :
		if ((fabs(x)>maxexpo || fabs(x)<minexpo) && x!=0.0)
			output1hold(0,expoformat,x);
		else if (x==0.0) output1hold(0,fixedformat,0.0); /* take care of -0 */
		else output1hold(0,fixedformat,x);
	}
	output1hold(outputlength," ");
}

static void out_matrix (header *hd)
/***** out_matrix
   print a matrix.
*****/
{	int c,r,i,j,c0,cend;
	double *m,*x;

	linew=linelength/fieldw;
	if (linew<=0) linew=1;

	getmatrix(hd,&r,&c,&m);
	for (c0=0; c0<c; c0+=linew)
	{	cend=c0+linew-1;
		if (cend>=c) cend=c-1;
		if (c>linew) output2("Column %d to %d:\n",c0+1,cend+1);
		for (i=0; i<r; i++)
		{	x=mat(m,c,i,c0);
			for (j=c0; j<=cend; j++) double_out(*x++);
			output("\n");
			if (test_key()==escape) return;
		}
	}
}

static void complex_out (double x, double y)
/***** complex_out
	print a complex number.
*****/
{	if (fraceps>0)
	{   if (!frac_out(x)) goto one;
		if (y!=0.0)
		{	if (y>0) output1hold(-1,"+");
			else if (y<0) output1hold(-1,"-");
			if (!frac_out0(fabs(y))) goto two;
		}
	}
	else
	{   one :
		if ((fabs(x)>maxexpo || fabs(x)<minexpo) && x!=0.0)
		output1hold(0,expoformat,x);
		else output1hold(0,fixedformat,x);
		if (y>=0) output1hold(-1,"+");
		else output1hold(-1,"-");
		y=fabs(y);
		two :
		if ((y>maxexpo || y<minexpo) && y!=0.0)
		output1hold(-1,expoformat,y);
		else output1hold(-1,fixedformat,y);
	}
	output1hold(outputlength*2,"i ");
}

static void out_cmatrix (header *hd)
/***** out_matrix
   print a complex matrix.
*****/
{	int c,r,i,j,c0,cend;
	double *m,*x;

	linew=linelength/fieldw;
	if (linew<=0) linew=1;

	getmatrix(hd,&r,&c,&m);
	for (c0=0; c0<c; c0+=linew/2)
	{	cend=c0+linew/2-1;
		if (cend>=c) cend=c-1;
		if (c>linew/2) output2("Column %d to %d:\n",c0+1,cend+1);
		for (i=0; i<r; i++)
		{	x=cmat(m,c,i,c0);
			for (j=c0; j<=cend; j++) { complex_out(*x,*(x+1));
				x+=2; }
			output("\n");
			if (test_key()==escape) return;
		}
	}
}

static void interval_out (double x, double y)
/***** double_out
	print a complex number.
*****/
{   int d1,d2,l;
	char form[16];
	if (iformat>0 && (x>0 || y<0) && x!=y)
	{   if (x>0)
		{	d1=(int)log10(y); d2=(int)log10(y-x);
		}
		else
		{	d1=(int)log10(-x); d2=(int)log10(-x+y);
		}
		l=d1-d2+2;
		if (l>DBL_DIG+3) l=DBL_DIG+3;
		sprintf(form,"%%0.%dg",l);
		if (y!=floor(y))
		    y+=pow(10.0,floor(log10(fabs(y)))-l+1)/2.00000001;
		if (x!=floor(x))
			x-=pow(10.0,floor(log10(fabs(x)))-l+1)/2.00000001;
		output1hold(0,"~");
		output1hold(-1,form,x);
		output1hold(-1,",");
		output1hold(-1,form,y);
		output1hold(ioutputlength,"~ ");
		return;
	}
	output1hold(0,"~");
	output1hold(-1,"%0.2g",x);
	output1hold(-1,",");
	output1hold(-1,"%0.2g",y);
	output1hold(ioutputlength,"~ ");
}

static void out_imatrix (header *hd)
/***** out_matrix
   print a complex matrix.
*****/
{	int c,r,i,j,c0,cend;
	double *m,*x;

	ilinew=linelength/ioutputlength;
	if (ilinew<=0) ilinew=1;

	getmatrix(hd,&r,&c,&m);
	for (c0=0; c0<c; c0+=ilinew)
	{	cend=c0+ilinew-1;
		if (cend>=c) cend=c-1;
		if (c>ilinew) output2("Column %d to %d:\n",c0+1,cend+1);
		for (i=0; i<r; i++)
		{	x=imat(m,c,i,c0);
			for (j=c0; j<=cend; j++) { interval_out(*x,*(x+1));
				x+=2; }
			output("\n");
			if (test_key()==escape) return;
		}
	}
}

void give_out (header *hd)
/***** give_out
	print a value.
*****/
{	switch(hd->type)
	{	case s_real : double_out(*realof(hd)); output("\n"); break;
		case s_complex : complex_out(*realof(hd),*imagof(hd));
			output("\n"); break;
		case s_matrix : out_matrix(hd); break;
		case s_cmatrix : out_cmatrix(hd); break;
		case s_imatrix : out_imatrix(hd); break;
		case s_string : output(stringof(hd)); output("\n"); break;
		case s_interval : interval_out(*aof(hd),*bof(hd));
			output("\n"); break;
		default : output("?\n");
	}
}


/* Output to the text window via gprint in sysdep*.c */

int preventoutput=0;

void output (char *s)
{	if (preventoutput) return;
	if (outputbuffer)
	{   if (outputbuffererror) return;
		if (outputbuffer+strlen(s)>=outputbufferend)
		{	outputbuffererror=1; return;
		}
		strcpy(outputbuffer,s);
		outputbuffer+=strlen(s);
		return;
	}
	text_mode();
	if (outputing || error) gprint(s);
	if (outfile)
	{	fprintf(outfile,"%s",s);
		if (ferror(outfile))
		{	output("Error on dump file (disk full?).\n");
			error=200;
			fclose(outfile); outfile=0;
		}
	}
}

void output1 (char *s, ...)
{	char text [1024];
	va_list v;
	if (preventoutput) return;
	text_mode();
	va_start(v,s);
	vsprintf(text,s,v);
	if (outputbuffer)
	{	output(text); return;
	}
	if (outputing || error) gprint(text);
	if (outfile)
	{   fprintf(outfile,text);
		if (ferror(outfile))
		{	output("Error on dump file (disk full?).\n");
			error=200;
			fclose(outfile); outfile=0;
		}
	}
}

void output1hold (int f, char *s, ...)
{	static char text [1024];
	unsigned long si;
	va_list v;
	if (f==0) text[0]=0;
	text_mode();
	va_start(v,s);
	vsprintf(text+strlen(text),s,v);
	if (f<=0) return;
	si=strlen(text);
	if (si<f)
	{	memmove(text+(f-si),text,si+1);
		memset(text,' ',f-si);
	}
	if (outputbuffer)
	{	output(text); return;
	}
	if (outputing || error) gprint(text);
	if (outfile)
	{   fprintf(outfile,text);
		if (ferror(outfile))
		{	output("Error on dump file (disk full?).\n");
			error=200;
			fclose(outfile); outfile=0;
		}
	}
}

/* Print an error message */

void print_error (char *p)
{	int i;
	char *q,outline[1024];
	double x;
	int comn;
	if (errorout) return;
	if (input_line<=p && input_line+1024>p)
	{	output1("error in:\n%s\n",input_line);
		if ((int)(p-input_line)<linelength-2)
			for (i=0; i<(int)(p-input_line); i++) output(" ");
		output("^\n");
	}
	else if (udfon)
	{	q=outline; p=udfline;
		while (*p)
		{	if (*p==2)
			{	p++; memmove((char *)(&x),p,sizeof(double));
				p+=sizeof(double);
				sprintf(q,"%g",x);
				q+=strlen(q);
			}
			else if (*p==3)
			{	p++;
				memmove((char *)(&comn),p,sizeof(int));
				p+=sizeof(int);
				sprintf(q,"%s",command_list[comn].name);
				q+=strlen(q);
			}
			else *q++=*p++;
			if (q>outline+1022)
			{	q=outline+1023;
				break;
			}
		}
		*q=0;
		output1("Error in :\n%s\n",outline); output("\n");
	}
	errorout=1;
}
syntax highlighted by Code2HTML, v. 0.9.1