xref: /inferno-os/appl/math/gr.b (revision 37da2899f40661e3e9631e497da8dc59b971cbd0)

implement GR;

include "sys.m";
	sys: Sys;
	print, sprint: import sys;
include "math.m";
	math: Math;
	ceil, fabs, floor, Infinity, log10, pow10, sqrt: import math;
include "draw.m";
	screen: ref Draw->Screen;
include "tk.m";
	tk: Tk;
	Toplevel: import tk;
include "tkclient.m";
	tkclient: Tkclient;
include "gr.m";

gr_cfg := array[] of {
	"frame .fc",
	"frame .fc.b",
	"label .fc.b.xy -text {0 0} -anchor e",
	"pack .fc.b.xy -fill x",
	"pack .fc.b -fill both -expand 1",
	"canvas .fc.c -relief sunken -bd 2 -width 600 -height 480 -bg white"+
		" -font /fonts/lucidasans/unicode.8.font",
	"pack .fc.c -fill both -expand 1",
	"pack .Wm_t -fill x",
	"pack .fc -fill both -expand 1",
	"pack propagate . 0",
	"bind .fc.c <ButtonPress-1> {send grcmd down1,%x,%y}",
};

TkCmd(t: ref Toplevel, arg: string): string
{
	rv := tk->cmd(t,arg);
	if(rv!=nil && rv[0]=='!')
		print("tk->cmd(%s): %s\n",arg,rv);
	return rv;
}


open(ctxt: ref Draw->Context, title: string): ref Plot
{
	if(sys==nil){
		sys = load Sys Sys->PATH;
		math = load Math Math->PATH;
		tk = load Tk Tk->PATH;
		tkclient = load Tkclient Tkclient->PATH;
		tkclient->init();
	}
	textsize := 8.;	# textsize is in points, if no user transform
	(t, tb) := tkclient->toplevel(ctxt, "", title, Tkclient->Appl);
	cc := chan of string;
	tk->namechan(t, cc, "grcmd");
	p := ref Plot(nil, Infinity,-Infinity,Infinity,-Infinity, textsize, t, tb, cc);
	for (i:=0; i<len gr_cfg; i++)
		tk->cmd(p.t,gr_cfg[i]);
	tkclient->onscreen(p.t, nil);
	tkclient->startinput(p.t, "kbd"::"ptr"::nil);
	return p;
}

Plot.bye(p: self ref Plot)
{
	cmdloop: for(;;) alt {
	s := <-p.t.ctxt.kbd =>
		tk->keyboard(p.t, s);
	s := <-p.t.ctxt.ptr =>
		tk->pointer(p.t, *s);
	s := <-p.t.ctxt.ctl or
	s = <-p.t.wreq or
	s = <-p.titlechan =>
		if(s == "exit")
			break cmdloop;
		tkclient->wmctl(p.t, s);
		case s{
		"size" =>
			canvw := int TkCmd(p.t, ".fc.c cget -width");
			canvh := int TkCmd(p.t, ".fc.c cget -height");
			TkCmd(p.t,".fc.b.xy configure -text {"+sprint("%d %d",canvw,canvh)+"}");
		}
	press := <-p.canvaschan =>
		(nil,cmds) := sys->tokenize(press,",");
		if(cmds==nil) continue;
		case hd cmds {
		"down1" =>
			xpos := real(hd tl cmds);
			ypos := real(hd tl tl cmds);
			x := (xpos-bx)/ax;
			y := -(ypos-tky+by)/ay;
			TkCmd(p.t,".fc.b.xy configure -text {"+sprint("%.3g %.3g",x,y)+"}");
		}
	}
	TkCmd(p.t,"destroy .;update");
	p.t = nil;
}

Plot.equalxy(p: self ref Plot)
{
	r := 0.;
	if( r < p.xmax - p.xmin ) r = p.xmax - p.xmin;
	if( r < p.ymax - p.ymin ) r = p.ymax - p.ymin;
	m := (p.xmax + p.xmin)/2.;
	p.xmax = m + r/2.;
	p.xmin = m - r/2.;
	m = (p.ymax + p.ymin)/2.;
	p.ymax = m + r/2.;
	p.ymin = m - r/2.;
}

Plot.graph(p: self ref Plot, x, y: array of real)
{
	n := len x;
	op := OP(GR->GRAPH, n, array[n] of real, array[n] of real, nil);
	while(n--){
		t := x[n];
		op.x[n] = t;
		if(t < p.xmin)
			p.xmin = t;
		if(t > p.xmax)
			p.xmax = t;
		t = y[n];
		op.y[n] = t;
		if(t < p.ymin)
			p.ymin = t;
		if(t > p.ymax)
			p.ymax = t;
	}
	p.op = op :: p.op;
}

Plot.text(p: self ref Plot, justify: int, s: string, x, y: real)
{
	op := OP(GR->TEXT, justify, array[1] of real, array[1] of real, s);
	op.x[0] = x;
	op.y[0] = y;
	p.op = op :: p.op;
}

Plot.pen(p: self ref Plot, nib: int)
{
	p.op = OP(GR->PEN, nib, nil, nil, nil) :: p.op;
}


#---------------------------------------------------------
# The rest of this file is concerned with sending the "display list"
# to Tk.  The only interesting parts of the problem are picking axes
# and drawing dashed lines properly.

ax, bx, ay, by: real;			# transform user to pixels
tky: con 630.;				# Tk_y = tky - y
nseg: int;				# how many segments in current stroke path
pendown: int;				# is pen currently drawing?
xoff := array[] of{"w","","e"};	# LJUST, CENTER, RJUST
yoff := array[] of{"n","","s","s"};	# HIGH, MED, BASE, LOW
linewidth: real;
toplevel: ref Toplevel;			# p.t
tkcmd: string;

mv(x, y: real)
{
	tkcmd = sprint(".fc.c create line %.1f %.1f", ax*x+bx, tky-(ay*y+by));
}

stroke()
{
	if(pendown){
		tkcmd += " -width 3";   # -capstyle round -joinstyle round
		TkCmd(toplevel,tkcmd);
		tkcmd = nil;
		pendown = 0;
		nseg = 0;
	}
}

vec(x, y: real)
{
	tkcmd += sprint(" %.1f %.1f", ax*x+bx, tky-(ay*y+by));
	pendown = 1;
	nseg++;
	if(nseg>1000){
		stroke();
		mv(x,y);
	}
}

circle(u, v, radius: real)
{
	x := ax*u+bx;
	y := tky-(ay*v+by);
	r := radius*(ax+ay)/2.;
	tkcmd = sprint(".fc.c create oval %.1f %.1f %.1f %.1f -width 3",
		x-r, y-r, x+r, y+r);
	TkCmd(toplevel,tkcmd);
	tkcmd = nil;
}

text(s: string, x, y: real, xoff, yoff: string)
{
	# rot = rotation in degrees.  90 is used for y-axis
	# x,y are in PostScript coordinate system, not user
	anchor := yoff + xoff;
	if(anchor!="")
		anchor = "-anchor " + anchor + " ";
	tkcmd = sprint(".fc.c create text %.1f %.1f %s-text '%s",
		ax*x+bx,
		tky-(ay*y+by), anchor, s);
	TkCmd(toplevel,tkcmd);
	tkcmd = nil;
}

datarange(xmin, xmax, margin: real): (real,real)
{
	r := 1.e-30;
	if( r < 0.001*fabs(xmin) )
		r = 0.001*fabs(xmin);
	if( r < 0.001*fabs(xmax) )
		r = 0.001*fabs(xmax);
	if( r < xmax-xmin )
		r = xmax-xmin;
	r *= 1.+2.*margin;
	x0 :=(xmin+xmax)/2. - r/2.;
	return ( x0, x0 + r);
}

dashed(ndash: int, x, y: array of real)
{
	cx, cy: real;	# current position
	d: real;	# length undone in p[i],p[i+1]
	t: real;	# length undone in current dash
	n := len x;
	if(n!=len y || n<=0)
		return;

	# choose precise dashlen
	s := 0.;
	for(i := 0; i < n - 1; i += 1){
		u := x[i+1] - x[i];
		v := y[i+1] - y[i];
		s += sqrt(u*u + v*v);
	}
	i = int floor(real ndash * s);
	if(i < 2)
		i = 2;
	dashlen := s / real(2 * i - 1);

	t = dashlen;
	ink := 1;
	mv(x[0], y[0]);
	cx = x[0];
	cy = y[0];
	for(i = 0; i < n - 1; i += 1){
		u := x[i+1] - x[i];
		v := y[i+1] - y[i];
		d = sqrt(u * u + v * v);
		if(d > 0.){
			u /= d;
			v /= d;
			while(t <= d){
				cx += t * u;
				cy += t * v;
				if(ink){
					vec(cx, cy);
					stroke();
				}else{
					mv(cx, cy);
				}
				d -= t;
				t = dashlen;
				ink = 1 - ink;
			}
			cx = x[i+1];
			cy = y[i+1];
			if(ink){
				vec(cx, cy);
			}else{
				mv(cx, cy);
			}
			t -= d;
		}
	}
	stroke();
}

labfmt(x:real): string
{
	lab := sprint("%.6g",x);
	if(len lab>2){
		if(lab[0]=='0' && lab[1]=='.')
			lab = lab[1:];
		else if(lab[0]=='-' && len lab>3 && lab[1]=='0' && lab[2]=='.')
			lab = "-"+lab[2:];
	}
	return lab;
}

Plot.paint(p: self ref Plot, xlabel, xunit, ylabel, yunit: string)
{
	oplist: list of OP;

	# tunable parameters for dimensions of graph (fraction of box side)
	margin: con 0.075;		# separation of data from box boundary
	ticksize := 0.02;
	sep := ticksize;		# separation of text from box boundary

	# derived coordinates of various feature points...
	x0, x1, y0, y1: real;		# box corners, in original coord
	# radius := 0.2*p.textsize;	# radius for circle marker
	radius := 0.8*p.textsize;	# radius for circle marker

	Pen := SOLID;
	width := SOLID;
	linewidth = 2.;
	nseg = 0;
	pendown = 0;

	if(xunit=="") xunit = nil;
	if(yunit=="") yunit = nil;

	(x0,x1) = datarange(p.xmin,p.xmax,margin);
	ax = (400.-2.*p.textsize)/((x1-x0)*(1.+2.*sep));
	bx = 506.-ax*x1;
	(y0,y1) = datarange(p.ymin,p.ymax,margin);
	ay = (400.-2.*p.textsize)/((y1-y0)*(1.+2.*sep));
	by = 596.-ay*y1;
	# PostScript version
	# magic numbers here come from BoundingBox: 106 196 506 596
	# (x0,x1) = datarange(p.xmin,p.xmax,margin);
	# ax = (400.-2.*p.textsize)/((x1-x0)*(1.+2.*sep));
	# bx = 506.-ax*x1;
	# (y0,y1) = datarange(p.ymin,p.ymax,margin);
	# ay = (400.-2.*p.textsize)/((y1-y0)*(1.+2.*sep));
	# by = 596.-ay*y1;

	# convert from fraction of box to PostScript units
	ticksize *= ax*(x1-x0);
	sep *= ax*(x1-x0);

	# revert to original drawing order
	log := p.op;
	oplist = nil;
	while(log!=nil){
		oplist = hd log :: oplist;
		log = tl log;
	}
	p.op = oplist;

	toplevel = p.t;
	#------------send display list to Tk-----------------
	while(oplist!=nil){
		op := hd oplist;
		n := op.n;
		case op.code{
		GRAPH =>
			if(Pen == DASHED){
				dashed(17, op.x, op.y);
			}else if(Pen == DOTTED){
				dashed(85, op.x, op.y);
			}else{
				for(i:=0; i<n; i++){
					xx := op.x[i];
					yy := op.y[i];
					if(Pen == CIRCLE){
						circle(xx, yy, radius/(ax+ay));
					}else if(Pen == CROSS){
						mv(xx-radius/ax, yy);
						vec(xx+radius/ax, yy);
						stroke();
						mv(xx, yy-radius/ay);
						vec(xx, yy+radius/ay);
						stroke();
					}else if(Pen == INVIS){
					}else{
						if(i==0){
							mv(xx, yy);
						}else{
							vec(xx, yy);
						}
					}
				}
				stroke();
			}
		TEXT =>
			angle := 0.;
			if(op.n&UP) angle = 90.;
			text(op.t,op.x[0],op.y[0],xoff[n&7],yoff[(n>>3)&7]);
		PEN =>
			Pen = n;
			if( Pen==SOLID && width!=SOLID ){
				linewidth = 2.;
				width=SOLID;
			}else if( Pen==REFERENCE && width!=REFERENCE ){
				linewidth = 0.8;
				width=REFERENCE;
			}
		}
		oplist = tl oplist;
	}

	#--------------------now add axes-----------------------
	mv(x0,y0);
	vec(x1,y0);
	vec(x1,y1);
	vec(x0,y1);
	vec(x0,y0);
	stroke();

	# x ticks
	(lab1,labn,labinc,k,u,s) := mytic(x0,x1);
	for (i := lab1; i <= labn; i += labinc){
		r := real i*s*u;
		mv(r,y0);
		vec(r,y0+ticksize/ay);
		stroke();
		mv(r,y1);
		vec(r,y1-ticksize/ay);
		stroke();
		text(labfmt(real i*s),r,y0-sep/ay,"","n");
	}
	yy := y0-(2.*sep+p.textsize)/ay;
	labelstr := "";
	if(xlabel!=nil)
		labelstr = xlabel;
	if(k!=0||xunit!=nil)
		labelstr += " /";
	if(k!=0)
		labelstr += " ₁₀"+ string k;
	if(xunit!=nil)
		labelstr += " " + xunit;
	text(labelstr,(x0+x1)/2.,yy,"","n");

	# y ticks
	(lab1,labn,labinc,k,u,s) = mytic(y0,y1);
	for (i = lab1; i <= labn; i += labinc){
		r := real i*s*u;
		mv(x0,r);
		vec(x0+ticksize/ax,r);
		stroke();
		mv(x1,r);
		vec(x1-ticksize/ax,r);
		stroke();
		text(labfmt(real i*s),x0-sep/ax,r,"e","");
	}
	xx := x0-(4.*sep+p.textsize)/ax;
	labelstr = "";
	if(ylabel!=nil)
		labelstr = ylabel;
	if(k!=0||yunit!=nil)
		labelstr += " /";
	if(k!=0)
		labelstr += " ₁₀"+ string k;
	if(yunit!=nil)
		labelstr += " " + yunit;
	text(labelstr,xx,(y0+y1)/2.,"e","");

	TkCmd(p.t, "update");
}



# automatic tic choice                      Eric Grosse  9 Dec 84
# Input: low and high endpoints of expanded data range
# Output: lab1, labn, labinc, k, u, s   where the tics are
#   (lab1*s, (lab1+labinc)*s, ..., labn*s) * 10^k
# and u = 10^k.  k is metric, i.e. k=0 mod 3.

max3(a, b, c: real): real
{
	if(a<b) a=b;
	if(a<c) a=c;
	return(a);
}

my_mod(i, n: int): int
{
	while(i< 0) i+=n;
	while(i>=n) i-=n;
	return(i);
}

mytic(l, h: real): (int,int,int,int,real,real)
{
	lab1, labn, labinc, k, nlab, j, ndig, t1, tn: int;
	u, s: real;
	eps := .0001;
	k = int floor( log10((h-l)/(3.+eps)) );
	u = pow10(k);
	t1 = int ceil(l/u-eps);
	tn = int floor(h/u+eps);
	lab1 = t1;
	labn = tn;
	labinc = 1;
	nlab = labn - lab1 + 1;
	if( nlab>5 ){
		lab1 = t1 + my_mod(-t1,2);
		labn = tn - my_mod( tn,2);
		labinc = 2;
		nlab = (labn-lab1)/labinc + 1;
		if( nlab>5 ){
			lab1 = t1 + my_mod(-t1,5);
			labn = tn - my_mod( tn,5);
			labinc = 5;
			nlab = (labn-lab1)/labinc + 1;
			if( nlab>5 ){
				u *= 10.;
				k++;
				lab1 = int ceil(l/u-eps);
				labn = int floor(h/u+eps);
				nlab = labn - lab1 + 1;
				labinc = 1;
			} else if( nlab<3 ){
				lab1 = t1 + my_mod(-t1,4);
				labn = tn - my_mod( tn,4);
				labinc = 4;
				nlab = (labn-lab1)/labinc + 1;
			}
		}
	}
	ndig = int(1.+floor(log10(max3(fabs(real lab1),fabs(real labn),1.e-30))));
	if( ((k<=0)&&(k>=-ndig))   # no zeros have to be added
	    || ((k<0)&&(k>=-3))
	    || ((k>0)&&(ndig+k<=4)) ){   # even with zeros, label is small
		s = u;
		k = 0;
		u = 1.;
	}else if(k>0){
		s = 1.;
		j = ndig;
		while(k%3!=0){
			k--;
			u/=10.;
			s*=10.;
			j++;
		}
		if(j-3>0){
			k+=3;
			u*=1000.;
			s/=1000.;
		}
	}else{ # k<0
		s = 1.;
		j = ndig;
		while(k%3!=0){
			k++;
			u*=10.;
			s/=10.;
			j--;
		}
		if(j<0){
			k-=3;
			u/=1000.;
			s*=1000.;
		}
	}
	return (lab1, labn, labinc, k, u, s);
}