shithub: purgatorio

ref: b7af62b250e5dff30320a181ca9d53ab5a7c276d
dir: /appl/ebook/table.b/

implement Table;
include "sys.m";
	sys: Sys;
include "draw.m";
	draw: Draw;
	Point, Rect: import draw;
include "tk.m";
	tk: Tk;
include "table.m";

init()
{
	sys = load Sys Sys->PATH;
	draw = load Draw Draw->PATH;
	tk = load Tk Tk->PATH;
}

newcell(w: string, span: Draw->Point): ref Cell
{
	return ref Cell(w, span, (0, 0));
}

layout(cells: array of array of ref Cell, win: ref Tk->Toplevel, w: string)
{
	if (len cells == 0)
		return;
	dim := Point(len cells, len cells[0]);
	for (y := 0; y < dim.y; y++) {
		for (x := 0; x < dim.x; x++) {
			cell := cells[x][y];
			# XXX should take into account cell padding
			if (cell != nil) {
				cell.sizereq = getsize(win, cell.w);
# sys->print("cell %d %d size %s span %s\n", x, y, p2s(cell.sizereq), p2s(cell.span));
			}
#  else
# sys->print("cell %d %d blank\n", x, y);
		}
	}

	colwidths := array[dim.x] of {* => 0};
	# calculate column widths (ignoring multi-column cells)
	for (x := 0; x < dim.x; x++) {
		for (y = 0; y < dim.y; y++) {
			cell := cells[x][y];
			if (cell != nil && cell.span.x == 1 && cell.sizereq.x > colwidths[x])
				colwidths[x] = cell.sizereq.x;
		}
	}

	# now check that multi-column cells fit in their columns
	colexpand := array[dim.x] of {* => 1};
	for (x = 0; x < dim.x; x++) {
		for (y = 0; y < dim.y; y++) {
			cell := cells[x][y];
			if (cell != nil && cell.span.x > 1)
				expandwidths(x, cell.sizereq.x, cell.span.x, colwidths, colexpand);
		}
	}
	colexpand = nil;

	rowheights := array[dim.y] of {* => 0};
	# calculate row heights (ignoring multi-row cells)
	for (y = 0; y < dim.y; y++) {
		for (x = 0; x < dim.x; x++) {
			cell := cells[x][y];
			if (cell != nil && cell.span.y == 1 && cell.sizereq.y > rowheights[y])
				rowheights[y] = cell.sizereq.y;
		}
	}

# 	for (i := 0; i < len colwidths; i++)
# 		sys->print("colwidth %d -> %d\n", i, colwidths[i]);
# 	for (i = 0; i < len rowheights; i++)
# 		sys->print("rowheight %d -> %d\n", i, rowheights[i]);

	rowexpand := array[dim.y] of {* => 1};
	# now check that multi-row cells fit in their columns
	for (y = 0; y < dim.y; y++) {
		for (x = 0; x < dim.x; x++) {
			cell := cells[x][y];
			if (cell != nil && cell.span.y > 1)
				expandwidths(y, cell.sizereq.y, cell.span.y, rowheights, rowexpand);
		}
	}

#	if (rowequalise)
#		equalise(rowheights, dim.y);

#	if (colequalise)
#		equalise(colwidths, dim.x);

	# calculate total width and height (including cell padding)
	totsize := Point(0, 0);
	for (x = 0; x < dim.x; x++)
		totsize.x += colwidths[x];
	for (y = 0; y < dim.y; y++)
		totsize.y += rowheights[y];

	cmd(win, "canvas " + w + " -width " + string totsize.x + " -bg white -height " + string totsize.y);
	p := Point(0, 0);
	for (y = 0; y < dim.y; y++) {
		p.x = 0;
		for (x = 0; x < dim.x; x++) {
			cell := cells[x][y];
			if (cell != nil) {
				cellsize := Point(0, 0);
				span := cell.span;
				for (xx := 0; xx < span.x; xx++)
					cellsize.x += colwidths[x + xx];
				for (yy := 0; yy < span.y; yy++)
					cellsize.y += rowheights[y + yy];
# sys->print("cell [%d %d] %d %d +[%d %d]\n", x, y, p.x, p.y, cellsize.x, cellsize.y);
				cmd(win, w + " create window " + p2s(p) +
					" -anchor nw -window " + cell.w +
					" -width " + string cellsize.x +
					" -height " + string cellsize.y);
			}
			p.x += colwidths[x];
		}
		p.y += rowheights[y];
	}
}

expandwidths(x: int, cellwidth, xcells: int, widths: array of int, expand: array of int)
{
	# find out total space available for cell
	share := 0;
	tot := 0;
	endx := x + xcells;
	for (xx := x; xx < endx; xx++) {
		tot += widths[xx];
		if (expand[xx])
			share++;
	}
	slack := cellwidth - tot;

	# if enough space, then nothing to do.
	if (slack <= 0)
		return;

	# allocate extra space amongst all cols that
	# want to expand. (if any do, otherwise share it
	# out between all of them)
	if (share == 0)
		share = xcells;
	for (xx = x; xx < endx; xx++) {
		m := slack / share;
		widths[xx] += m;
		slack -= m;
		share--;
	}
}

getsize(win: ref Tk->Toplevel, w: string): Point
{
	bd := 2 * int cmd(win, w + " cget -bd");
	return Point(int cmd(win, w + " cget -width") + bd,
			int cmd(win, w + " cget -height") + bd);
}

p2s(p: Point): string
{
	return string p.x + " " + string p.y;
}

cmd(win: ref Tk->Toplevel, s: string): string
{
#	sys->print("%ux	%s\n", win, s);
	r := tk->cmd(win, s);
	if (len r > 0 && r[0] == '!') {
		sys->fprint(sys->fildes(2), "error executing '%s': %s\n", s, r);
		raise "tk error";
	}
	return r;
}