BSD 1 development

[unix-history] / tests / t02.p

program graph1(output);
const
	d = 0.0625;
	s = 32;
	h = 34;
	c = 6.28318;
var
	x,y: real;
	i,n: integer;
procedure rdr(var f: text; var x: real);
const
	t48 = 281474976710656;
	limit = 56294995342131;
	z = 27;
	lim1 = 322;
	lim2 = -292;
type
	posint = 0..323;
var
	ch: char;
	y: real;
	a, i, e: integer;
	s, ss: boolean;

function ten(e: posint): real;
var
	i: integer;
	t: real;
begin
	i := 0;
	t := 1.0;
	repeat
		if odd(e) then
		case i of
		0: t := t*1.0e1;
		1: t := t*1.0e2;
		2: t := t*1.0e4;
		3: t := t*1.0e8;
		4: t := t*1.0e16;
		5: t := t*1.0e32;
		6: t := t*1.0e64;
		7: t := t*1.0e128;
		8: t := t*1.0e256
		end ;
		e := e div 2;
		i := i+1;
	until e = 0;
	ten := t
end ;

begin
	if eof(f) then
	begin
		message('**tried to read past eos/eof');
		halt
	end ;
	while (f^ = ' ') and (not eof(f)) do
		get(f);
	if not eof(f) then
	begin
		ch := f^;
		if ch = '-' then
		begin
			s := true;
			get(f);
			ch := f^;
		end else
		begin
			s := false;
			if ch = '+' then
			begin
				get(f);
				ch := f^;
			end
		end ;
		if not (ch in ['0'..'9']) then
		begin
			message('**digit expected');
			halt
		end ;
		a := 0;
		e := 0;
		repeat
			if a < limit then
				a := 10*a + ord(ch)-z else
				e := e+1;
			get(f);
			ch := f^;
		until not (ch in ['0'..'9']);
		if ch = '.' then
		begin
			get(f);
			ch := f^;
			while ch in ['0'..'9'] do
			begin
				if a < limit then
				begin
					a := 10*a+ord(ch)-z;
					e := e-1;
				end ;
				get(f);
				ch := f^;
			end
		end;
		if ch = 'e' then
		begin
			get(f);
			ch := f^;
			i := 0;
			if ch = '-' then
			begin
				ss := true;
				get(f);
				ch := f^;
			end else
			begin
				ss := false;
				if ch = '+' then
				begin
					get(f);
					ch := f^;
				end
			end;
			if ch in ['0'..'9'] then
			begin
				i := ord(ch)-z;
				get(f);
				ch := f^;
				while ch in ['0'..'9'] do
				begin
					if i < limit then
						i := 10*i + ord(ch)-z;
					get(f);
					ch := f^;
				end
			end else
			begin
				message(' digit expected');
				halt
			end ;
			if ss then
				e := e-i else
				e := e+i;
		end;
		if e < lim2 then
		begin
			a := 0;
			e := 0;
		end else
		if e > lim1 then
		begin
			message('**number too large');
			halt
		end;
		if a >= t48 then
			y := ((a+1) div 2) * 2.0 else
			y := a;
		if s then
			y := -y;
		if e < 0 then
			x := y/ten(-e) else
		if e <> 0 then
			x := y*ten(e) else
			x := y;
	end;
end;
begin
	for i := 0 to lim do
	begin
		x := d*i;
		y := exp(-x)*sin(c*x);
		n := round(s*y) + h;
		repeat
			write(blank);
			n := n-1;
		until n=0;
		write(aster)
	end
end.