path: root/appl/spree/clients/cards.b

implement Cards;
include "sys.m";
	sys: Sys;
include "draw.m";
	draw: Draw;
	Point, Rect, Display, Image, Font: import draw;
include "tk.m";
	tk: Tk;
include "tkclient.m";
	tkclient: Tkclient;
include "math.m";
	math: Math;

Cards: module {
	init: fn(ctxt: ref Draw->Context, argv: list of string);
};

# fairly general card clique client.
# inherent restrictions:
#	no dragging of cards visible over the net; it's unclear how
#		to handle the coordinate spaces involved

Object: adt {
	id:				int;
	pick {
	Card =>
		parentid:		int;
		face:			int;			# 1 is face up
		number:		int;
		rear:			int;
	Member =>
		cid:			int;
		name:		string;
	Stack =>
		o:			ref Layobject.Stack;
	Widget =>
		o:			ref Layobject.Widget;
	Menuentry =>
		parentid:		int;
		text:			string;
	Layoutframe =>
		lay:			ref Layout.Frame;
	Layoutobj =>
		lay:			ref Layout.Obj;
	Scoretable =>
		scores:		array of ref Object.Score;
	Score =>
		row:			array of (int, string);
		height:		int;
	Button =>
	Other =>
	}
};

# specify how an object is laid out.
Layout: adt {
	id:			int;
	parentid:		int;
	opts:			string;		# pack options
	orientation:	int;
	pick {
	Frame =>
		lays:		cyclic array of ref Layout;
	Obj =>
		layid:	int;			# reference to layid of laid-out object
	}
};

# an object which can be laid out on the canvas
Layobject: adt {
	id:			int;
	parentid:		int;
	w:			string;
	size:			Point;
	needrepack:	int;
	orientation:	int;
	layid:		int;
	pick {
	Stack =>
		style:		int;
		cards:		array of ref Object.Card;	# fake objects when invisible
		pos:			Point;		# top-left origin of first card in stack
		delta:		Point;		# card offset delta.
		animq:		ref Queue;	# queue of pending animations.
		actions:		int;
		maxcards:	int;
		title:			string;
		visible:		int;
		n:			int;			# for concealed stacks, n cards in stack.
		ownerid:		int;			# owner of selection
		sel:			ref Selection;
		showsize,
		hassize:		int;
	Widget =>
		wtype:		string;
		entries:		array of ref Object.Menuentry;
		cmd:			string;		# only used for entry widgets
		width:		int;
	}
};
	
Animation: adt {
	tag:		string;					# canvas tag common to cards being moved.
	srcpt:	Point;					# where cards are coming from.
	cards:	array of ref Object.Card;		# objects being transferred.
	dstid:	int;
	index:	int;
	waitch:	chan of ref Animation;		# notification comes on this chan when finished.
};

Selection: adt {
	pick {
	XRange =>
		r: Range;
	Indexes =>
		idxl: list of int;
	Empty =>
	}
};

MAXPLAYERS: con 4;

# layout actions
lFRAME, lOBJECT: con iota;

# possible actions on a card on a stack.
aCLICK: con 1<<iota;

# styles of stack display
styDISPLAY, styPILE: con iota;

# orientations
oLEFT, oRIGHT, oUP, oDOWN: con iota;

Range: adt {
	start, end: int;
};

T: type ref Animation;
Queue: adt {
	h, t: list of T; 
	put: fn(q: self ref Queue, s: T);
	get: fn(q: self ref Queue): T;
	isempty: fn(q: self ref Queue): int;
	peek: fn(q: self ref Queue): T;
};

configcmds := array[] of {
"frame .buts",
"frame .cf",
"canvas .c -width 400 -height 450 -bg green",
"label .status -text 0",
"checkbutton .buts.scores -text {Show scores} -command {send cmd scores}",
"button .buts.sizetofit -text {Fit} -command {send cmd sizetofit}",
"checkbutton .buts.debug -text {Debug} -variable debug -command {send cmd debug}",
"pack .buts.sizetofit .buts.debug .status -in .buts -side left",
"pack .buts -side top -fill x",
"pack  .c -in .cf -side top -fill both -expand 1",
"pack .cf -side top -fill both -expand 1",
"bind .c <Button-1> {send cmd b1 %X %Y}",
"bind .c <ButtonRelease-1} {send cmd b1r %X %Y}",
"bind .c <Button-2> {send cmd b2 %X %Y}",
"bind .c <ButtonRelease-2> {send cmd b2r %X %Y}",
"bind .c <ButtonPress-3> {send cmd b3 %X %Y}",
"bind .c <ButtonRelease-3> {send cmd b3r %X %Y}",
"bind . <Configure> {send cmd config}",
"pack propagate .buts 0",
".status configure -text {}",
"pack propagate . 0",
};

objects: 		array of ref Object;
layobjects := array[20] of list of ref Layobject;
members := array[8] of list of ref Object.Member;
win: 			ref Tk->Toplevel;
drawctxt:		ref Draw->Context;
me:			ref Object.Member;
layout:		ref Layout;
scoretable:	ref Object.Scoretable;
showingscores := 0;
debugging := 0;

stderr:		ref Sys->FD;
animfinishedch: chan of (ref Animation, chan of chan of ref Animation);
yieldch:		chan of int;
cardlockch: 	chan of int;
notifych:		chan of string;
tickregisterch, tickunregisterch: chan of chan of int;
starttime :=	0;
cvsfont: 		ref Font;

packwin:		ref Tk->Toplevel;	# invisible; used to steal tk's packing algorithms...
packobjs:		list of ref Layobject;
repackobjs:	list of ref Layobject;
needresize := 0;
needrepack := 0;

animid := 0;
fakeid := -2;		# ids allocated to "fake" cards in private hands; descending
nimages := 0;
Hiddenpos := Point(5000, 5000);

cliquefd: ref Sys->FD;

init(ctxt: ref Draw->Context, nil: list of string)
{
	sys = load Sys Sys->PATH;
	stderr = sys->fildes(2);
	draw = load Draw Draw->PATH;
	tk = load Tk Tk->PATH;
	math = load Math Math->PATH;
	tkclient = load Tkclient Tkclient->PATH;
	if (tkclient == nil) {
		sys->fprint(stderr, "cards: cannot load %s: %r\n", Tkclient->PATH);
		raise "fail:bad module";
	}
	tkclient->init();
	drawctxt = ctxt;
	client1();
}

# maximum number of rears (overridden by actual rear images)
rearcolours := array[] of {
	int 16r0000ccff,
	int 16rff0000ff,
	int 16rffff00ff,
	int 16r008000ff,
	int 16rffffffff,
	int 16rffaa00ff,
	int 16r00ffffff,
	int 16r808080ff,
	int 16r00ff00ff,
	int 16r800000ff,
	int 16r800080ff,
};
Rearborder := 3;
Border := 6;
Selectborder := 3;
cardsize: Point;
carddelta := Point(12, 15);		# offset in order to see card number/suit
Selectcolour := "red";
Textfont := "/fonts/pelm/unicode.8.font";

client1()
{
	cliquefd = sys->fildes(0);
	if (readconfig() == -1)
		raise "fail:error";

	winctl: chan of string;
	(win, winctl) = tkclient->toplevel(drawctxt, "-font " + Textfont,
		"Cards", Tkclient->Appl);
	cmd(win, ". unmap");
	bcmd := chan of string;
	tk->namechan(win, bcmd, "cmd");
	srvcmd := chan of string;
	tk->namechan(win, srvcmd, "srv");

	if (readcardimages() == -1)
		raise "fail:error";
	for (i := 0; i < len configcmds; i++)
		cmd(win, configcmds[i]);
	tkclient->onscreen(win, nil);
	tkclient->startinput(win, "kbd"::"ptr"::nil);

	fontname := cmd(win, ".c cget -font");
	cvsfont = Font.open(drawctxt.display, fontname);
	if (cvsfont == nil) {
		sys->fprint(stderr, "cards: cannot open font %s: %r\n", fontname);
		raise "fail:error";
	}
	fontname = nil;

	cardlockch = chan of int;
	spawn lockproc();

	yieldch = chan of int;
	spawn yieldproc();

	notifych = chan of string;
	spawn notifierproc();

	updatech := chan of array of byte;
	spawn readproc(cliquefd, updatech);

	spawn updateproc(updatech);
	b1down := 0;

	tickregisterch = chan of chan of int;
	tickunregisterch = chan of chan of int;
	spawn timeproc();
	spawn eventproc(win);

	for (;;) alt {
	c := <-bcmd =>
		(n, toks) := sys->tokenize(c, " ");
		case hd toks {
		"b3" =>
			curp := Point(int cmd(win, ".c canvasx " + hd tl toks),
				int cmd(win, ".c canvasy " + hd tl tl toks));
			b3raise(bcmd, curp);
		"b2" =>
			curp := Point(int cmd(win, ".c canvasx " + hd tl toks),
				int cmd(win, ".c canvasy " + hd tl tl toks));
			dopan(bcmd, "b2", curp);
		"b1" =>
			if (!b1down) {
				# b1 x y
				# x and y in screen coords
				curp := Point(int cmd(win, ".c canvasx " + hd tl toks),
					int cmd(win, ".c canvasy " + hd tl tl toks));
				b1down = b1action(bcmd, curp);
			}
		"b1r" =>
			b1down = 0;
		"entry" =>
			id := int hd tl toks;
			lock();
			cc := "";
			pick o := objects[id] {
			Widget =>
				cc = o.o.cmd;
			* =>
				sys->print("entry message from unknown obj: id %d\n", id);
			}
			unlock();
			if (cc != nil) {
				w := ".buts." + string id + ".b";
				s := cmd(win, w + " get");
				cardscmd(cc + " " + s);
				cmd(win, w + " selection range 0 end");
				cmd(win, "update");
			}
		"config" =>
			lock();
			needresize = 1;
			updatearena();
			unlock();
			cmd(win, "update");
		"scores" =>
			if (scoretable == nil)
				break;
			if (!showingscores) {
				cmd(win, ".c move score " + string -Hiddenpos.x + " " + string -Hiddenpos.y);
				cmd(win, ".c raise score");
			} else
				cmd(win, ".c move score " + p2s(Hiddenpos));
			cmd(win, "update");
			showingscores = !showingscores;
		"sizetofit" =>
			lock();
			sizetofit();
			unlock();
			cmd(win, "update");
		"debug" =>
			debugging = int cmd(win, "variable debug");
		}
	c := <-srvcmd =>		# from button or menu entry
		cardscmd(c);
	s := <-win.ctxt.ctl or
	s = <-win.wreq or
	s = <-winctl =>
		if (s == "exit")
			sys->write(cliquefd, array[0] of byte, 0);
		tkclient->wmctl(win, s);
	}
}

eventproc(win: ref Tk->Toplevel)
{
	for(;;)alt{
	s := <-win.ctxt.kbd =>
		tk->keyboard(win, s);
	s := <-win.ctxt.ptr =>
		tk->pointer(win, *s);
	}
}

readproc(fd: ref Sys->FD, updatech: chan of array of byte)
{
	buf := rest := array[Sys->ATOMICIO * 2] of byte;
	while ((n := sys->read(fd, rest, Sys->ATOMICIO)) > 0) {
		updatech <-= rest[0:n];
		rest = rest[n:];
		if (len rest < Sys->ATOMICIO)
			buf = rest = array[Sys->ATOMICIO * 2] of byte;
	}
	updatech <-= nil;
}


b1action(bcmd: chan of string, p: Point): int
{
	(hitsomething, id) := hitcard(p);
	if (!hitsomething) {
		dopan(bcmd, "b1", p);
		return 0;
	}
	if (id < 0) {		# either error, or someone else's private card
		sys->print("no card hit (%d)\n", id);
		return 1;
	}
	lock();
	if (objects[id] == nil) {
		notify("it's gone");
		unlock();
		return 1;
	}
	stack: ref Layobject.Stack;
	index := -1;
	pick o := objects[id] {
	Card =>
		card := o;
		parentid := card.parentid;
		stack = stackobj(parentid);
		for (index = 0; index < len stack.cards; index++)
			if (stack.cards[index] == card)
				break;
		if (index == len stack.cards)
			index = -1;
	Stack =>
		stack = o.o;
	* =>
		unlock();
		return 1;
	}
	actions := stack.actions;
	stackid := stack.id;
	unlock();
	# XXX potential problems when object ids get reused.
	# the object id that we saw before the unlock()
	# might now refer to a different object, so the user
	# might be performing a different action to the one intended.
	# this should be changed throughout... hmm.
	if (actions == 0) {
		notify("no way josé");
		sys->print("no way: stack %d, actions %d\n", stackid, actions);
		return 1;
	}
	cardscmd("click " + string stackid + " " + string index);
	return 1;
}

dopan(bcmd: chan of string, b: string, p: Point)
{
	r := b + "r";
	for (;;) {
		(n, toks) := sys->tokenize(<-bcmd, " ");
		if (hd toks == b) {
			pan(p, (int hd tl toks, int hd tl tl toks));
			p = Point(int cmd(win, ".c canvasx " + hd tl toks),
				int cmd(win, ".c canvasy " + hd tl tl toks));
			cmd(win, "update");
		} else if (hd toks == r)
			return;
	}
}

b3raise(bcmd: chan of string, p: Point)
{
	currcard := -1;
	above := "";
loop:	for (;;) {
		(nil, id) := hitcard(p);
		if (id != currcard) {
			if (currcard != -1 && above != nil)
				cmd(win, ".c lower i" + string currcard + " " + above);
			if (id == -1 || tagof(objects[id]) != tagof(Object.Card)) {
				above = nil;
				currcard = -1;
			} else {
				above = cmd(win, ".c find above i" + string id);
				cmd(win, ".c raise i" + string id);
				cmd(win, "update");
				currcard = id;
			}
		}
		(nil, toks) := sys->tokenize(<-bcmd, " ");
		case hd toks {
		"b3" =>
			p = Point(int cmd(win, ".c canvasx " + hd tl toks),
				int cmd(win, ".c canvasy " + hd tl tl toks));
		"b3r" =>
			break loop;
		}
	}
	if (currcard != -1 && above != nil) {
		cmd(win, ".c lower i" + string currcard + " " + above);
		cmd(win, "update");
	}
}

hitcard(p: Point): (int, int)
{
	(nil, hitids) := sys->tokenize(cmd(win, ".c find overlapping " + r2s((p, p))), " ");
	if (hitids == nil)
		return (0, -1);
	ids: list of string;
	for (; hitids != nil; hitids = tl hitids)
		ids = hd hitids :: ids;
	for (; ids != nil; ids = tl ids) {
		(nil, tags) := sys->tokenize(cmd(win, ".c gettags " + hd ids), " ");
		for (; tags != nil; tags = tl tags) {
			tag := hd tags;
			if (tag[0] == 'i' || tag[0] == 'r' || tag[0] == 'n' || tag[0] == 'N')
				return (1, int (hd tags)[1:]);
			if (tag[0] == 's')		# ignore selection
				break;
		}
		if (tags == nil)
			break;
	}
	return (1, -1);
}

cardscmd(s: string): int
{
	if (debugging)
		sys->print("cmd: %s\n", s);
	if (sys->fprint(cliquefd, "%s", s) == -1) {
		err := sys->sprint("%r");
		notify(err);
		sys->print("cmd error on '%s': %s\n", s, err);
		return 0;
	}
	return 1;
}

updateproc(updatech: chan of array of byte)
{
	wfd := sys->open("/prog/" + string sys->pctl(0, nil) + "/wait", Sys->OREAD);
	spawn updateproc1(updatech);
	buf := array[Sys->ATOMICIO] of byte;
	n := sys->read(wfd, buf, len buf);
	sys->print("updateproc process exited: %s\n", string buf[0:n]);
}

updateproc1(updatech: chan of array of byte)
{
	animfinishedch = chan of (ref Animation, chan of chan of ref Animation);
	first := 1;
	for (;;) {
		alt {
		v := <-animfinishedch =>
			lock();
			animterminated(v);
			updatearena();
			cmd(win, "update");
			unlock();
		u := <-updatech =>
			if (u == nil) {
				# XXX notify user that clique has been hung up somehow
				exit;
			}
			moretocome := 0;
			if (len u > 2 && u[len u-1] == byte '*' && u[len u-2] == byte '\n') {
				u = u[0:len u - 2];
				moretocome = 1;
			}
			(nil, lines) := sys->tokenize(string u, "\n");
			lock();
			starttime = sys->millisec();
			for (; lines != nil; lines = tl lines)
				applyupdate(hd lines);
			updatearena();
			if (!moretocome) {
				if (first) {
					sizetofit();
					first = 0;
				}
				cmd(win, "update");
			}
			unlock();
		}
	}
}

updatearena()
{
	if (needrepack)
		repackall();
	if (needresize)
		resizeall();
	for (pstk := repackobjs; pstk != nil; pstk = tl pstk)
		repackobj(hd pstk);
	repackobjs = nil;
}

applyupdate(s: string)
{
	if (debugging) {
		sys->print("update: %s\n", s);
#		showtk = 1;
	}
	(nt, toks) := sys->tokenize(s, " ");
	case hd toks {
	"create" =>
		# create id parentid vis type
		id := int hd tl toks;
		if (id >= len objects)
			objects = (array[len objects + 10] of ref Object)[0:] = objects;
		if (objects[id] != nil)
			panic(sys->sprint("object %d already exists!", id));
		parentid := int hd tl tl toks;
		vis := int hd tl tl tl toks;
		objtype := tl tl tl tl toks;
		case hd objtype {
		"stack" =>
			objects[id] = makestack(id, parentid, vis);
			needrepack = 1;
		"card" =>
			stk := stackobj(parentid);
			completeanim(stk);
			if (!stk.visible) {
				# if creating in a private stack, we assume
				# that the cards were there already, and
				# just make them real again.

				# first find a fake card.
				for (i := 0; i < len stk.cards; i++)
					if (stk.cards[i].id < 0)
						break;
				c: ref Object.Card;
				if (i == len stk.cards) {
					# no fake cards - we'll create one instead.
					# this can happen if we've entered halfway through
					# a clique, so don't know how many cards people
					# are holding.
					c = makecard(id, stk);
					insertcards(stk, array[] of {c}, len stk.cards);
				} else {
					c = stk.cards[i];
					changecardid(c, id);
				}
				objects[id] = c;
			} else {
				objects[id] = c := makecard(id, stk);
				insertcards(stk, array[] of {c}, len stk.cards);
			}
		"widget" =>
			objects[id] = makewidget(id, parentid, hd tl objtype);
		"menuentry" =>
			objects[id] = makemenuentry(id, parentid, tl objtype);
		"member" =>
			objects[id] = ref Object.Member(id, -1, "");
		"layframe" =>
			lay := ref Layout.Frame(id, parentid, "", -1, nil);
			objects[id] = ref Object.Layoutframe(id, lay);
			addlayout(lay);
		"layobj" =>
			lay := ref Layout.Obj(id, parentid, "", -1, -1);
			objects[id] = ref Object.Layoutobj(id, lay);
			addlayout(lay);
		"scoretable" =>
			if (scoretable != nil)
				panic("cannot make two scoretables");
			scoretable = objects[id] = ref Object.Scoretable(id, nil);
		"score" =>
			pick l := objects[parentid] {
			Scoretable =>
				nl := array[len l.scores + 1] of ref Object.Score;
				nl[0:] = l.scores;
				nl[len nl - 1] = objects[id] = ref Object.Score(id, nil, 0);
				l.scores = nl;
				cmd(win, "pack .buts.scores -side left");
			* =>
				panic("score created outside scoretable object");
			}
		"button" =>
			objects[id] = ref Object.Button(id);
			cmd(win, "button .buts." + string id);
			cmd(win, "pack .buts." + string id + " -side left");
		* =>
			if (parentid != -1)
				sys->print("cards: unknown objtype: '%s'\n", hd objtype);
			objects[id] = ref Object.Other(id);
		}

	"tx" =>
		# tx src dst start end dstindex
		src, dst: ref Layobject.Stack;
		index: int;
		r: Range;
		(src, toks) = (stackobj(int hd tl toks), tl tl toks);
		(dst, toks) = (stackobj(int hd toks), tl toks);
		(r.start, toks) =  (int hd toks, tl toks);
		(r.end, toks) =  (int hd toks, tl toks);
		(index, toks) = (int hd toks, tl toks);
		transfer(src, r, dst, index);

	"del" =>
		# del parent start end objs...
		oo := objects[int hd tl toks];	# parent
		r := Range(int hd tl tl toks, int hd tl tl tl toks);
		pick o := oo {
		Stack =>			# deleting cards from a stack.
			stk := o.o;
			completeanim(stk);
			if (!stk.visible) {
				# if deleting from a private area, we assume the cards aren't
				# actually being deleted at all, but merely becoming
				# invisible, so turn them into fakes.
				for (i := r.start; i < r.end; i++) {
					card := stk.cards[i];
					objects[card.id] = nil;
					changecardid(card, --fakeid);
					cardsetattr(card, "face", "0" :: nil);
				}
			} else {
				cards := extractcards(stk, r);
				for (i := 0; i < len cards; i++)
					destroy(cards[i]);
			}
		Layoutframe =>		# deleting the layout specification.
			lay := o.lay;
			if (r.start != 0 || r.end != len lay.lays)
				panic("cannot partially delete layouts");
			for (i := r.start; i < r.end; i++)
				destroy(objects[lay.lays[i].id]);
			lay.lays = nil;
			needrepack = 1;
		Widget =>
			# must be a menu widget
			cmd(win, ".buts." + string o.id + ".m delete " +
				string r.start + " " + string r.end);
		* =>
			for (objs := tl tl tl tl toks; objs != nil; objs = tl objs)
				destroy(objects[int hd objs]);
		}

	"set" =>
		# set obj attr val
		id := int hd tl toks;
		(attr, val) := (hd tl tl toks, tl tl tl toks);
		pick o := objects[id] {
		Card =>
			cardsetattr(o, attr, val);
		Widget =>
			widgetsetattr(o.o, attr, val);
		Stack =>
			stacksetattr(o.o, attr, val);
		Member =>
			membersetattr(o, attr, val);
		Layoutframe =>
			laysetattr(o.lay, attr, val);
		Layoutobj =>
			laysetattr(o.lay, attr, val);
		Score =>
			scoresetattr(o, attr, val);
		Button =>
			buttonsetattr(o, attr, val);
		Menuentry =>
			menuentrysetattr(o, attr, val);
		* =>
			sys->fprint(stderr, "unknown attr set on object(tag %d), %s\n", tagof(objects[id]), s);
		}

	"say" or
	"remark" =>
		notify(join(tl toks));
	* =>
		sys->fprint(stderr, "cards: unknown update message '%s'\n", s);
	}
}

addlayout(lay: ref Layout)
{
	pick lo := objects[lay.parentid] {
	Layoutframe =>
		l := lo.lay;
		nl := array[len l.lays + 1] of ref Layout;
		nl[0:] = l.lays;
		nl[len nl - 1] = lay;
		l.lays = nl;
	* =>
		if (layout == nil)
			layout = lay;
		else
			panic("cannot make two layout objects");
	}
}

makestack(id, parentid: int, vis: int): ref Object.Stack
{
	o := ref Object.Stack(
		id,
		ref Layobject.Stack(
			id,
			parentid,
			"",			# pack widget name
			(0, 0),		# size
			0,			# needrepack
			-1,			# orientation
			-1,			# layid
			-1,			# style
			nil,			# cards
			Hiddenpos,	# pos
			(0, 0),		# delta
			ref Queue,
			0,			# actions
			0,			# maxcards
			"",			# title
			vis,			# visible
			0,			# n
			-1,			# ownerid
			ref Selection.Empty,		# sel
			1,			# showsize
			0			# hassize
		)
	);
	cmd(win, ".c create rectangle -10 -10 -10 -10 -width 3 -tags r" + string id);
	return o;
}

makewidget(id, parentid: int, wtype: string): ref Object.Widget
{
	wctype := wtype;
	if (wtype == "menu")
		wctype = "menubutton";
	# XXX the widget is put in a frame 'cos of bugs in the canvas
	# to do with size propagation.
	w := cmd(win, "frame .buts." + string id + " -bg transparent");
	cmd(win, wctype + " " + w + ".b");
	cmd(win, "pack " + w + ".b -fill both -expand 1");
	case wtype {
	"menu" =>
		cmd(win, "menu " + w + ".m");
		cmd(win, w + ".b configure -menu " + w + ".m" +
			" -relief raised");
	"entry" =>
		cmd(win, "bind " + w + ".b <Key-\n> {send cmd entry " + string id + "}");
	}
	cmd(win, ".c create window -1000 -1000 -tags r" + string id +
		" -window " + w + " -anchor nw");
	o := ref Object.Widget(
		id,
		ref Layobject.Widget(
			id,
			parentid,
			nil,		# w
			(0, 0),	# size
			0,		# needrepack
			-1,		# orientation
			-1,		# style

			wtype,
			nil,		# entries
			"",		# cmd
			0		# width
		)
	);
	return o;
}

menutitleid := 0;		# hack to identify menu entries
makemenuentry(id, parentid: int, nil: list of string): ref Object.Menuentry
{
	m := ".buts." + string parentid + ".m";
	t := "@" + string menutitleid++;
	cmd(win, m + " add command -text " + t);
	return ref Object.Menuentry(id, parentid, t);
}

makecard(id: int, stack: ref Layobject.Stack): ref Object.Card
{
	cmd(win, ".c create image 5000 5000 -anchor nw -tags i" + string id);
	return ref Object.Card(id, stack.id, -1, -1, 0);
}

buttonsetattr(b: ref Object.Button, attr: string, val: list of string)
{
	w := ".buts." + string b.id;
	case attr {
	"text" =>
		cmd(win, w + " configure -text '" + join(val));
	"command" =>
		cmd(win, w + " configure -command 'send srv " + join(val));
	* =>
		sys->print("unknown attribute on button: %s\n", attr);
	}
}

widgetsetattr(b: ref Layobject.Widget, attr: string, val: list of string)
{
	w := ".buts." + string b.id + ".b";
	case attr {
	"text" =>
		t := join(val);
		if (b.wtype == "entry") {
			cmd(win, w + " delete 0 end");
			cmd(win, w + " insert 0 '" + t);
			cmd(win, w + " select 0 end");		# XXX ??
		} else {
			cmd(win, w + " configure -text '" + t);
			needresize = 1;
		}
	"command" =>
		case b.wtype {
		"button" =>
			cmd(win, w + " configure -command 'send srv " + join(val));
		"entry" =>
			b.cmd = join(val);
		}
	"width" =>		# width in characters
		b.width = int hd val;
		sys->print("configuring %s for width %s\n", w, hd val);
		cmd(win, w + " configure -width " + hd val + "w");
		needresize = 1;
	"layid" =>
		setlayid(b, int hd val);
	* =>
		sys->print("unknown attribute on button: %s\n", attr);
	}
}

findmenuentry(m: string, title: string): int
{
	end := int cmd(win, m + " index end");
	for (i := 0; i <= end; i++) {
		t := cmd(win, m + " entrycget " + string i + " -text");
		if (t == title)
			return i;
	}
	return -1;
}

menuentrysetattr(e: ref Object.Menuentry, attr: string, val: list of string)
{
	m := ".buts." + string e.parentid + ".m";
	idx := findmenuentry(m, e.text);
	if (idx == -1) {
		sys->print("couldn't find menu entry '%s'\n", e.text);
		return;
	}
	case attr {
	"text" =>
		t := join(val);
		cmd(win, m + " entryconfigure " + string idx +" -text '" + t);
		e.text = t;
	"command" =>
		cmd(win, m + " entryconfigure " + string idx +
				" -command 'send srv " + join(val));
	* =>
		sys->print("unknown attribute on menu entry: %s\n", attr);
	}
}

stacksetattr(stack: ref Layobject.Stack, attr: string, val: list of string)
{
	id := string stack.id;
	case attr {
	"maxcards" =>
		stack.maxcards = int hd val;
		needresize = 1;
	"layid" =>
		setlayid(stack, int hd val);
	"showsize" =>
		stack.showsize = int hd val;
		showsize(stack);
	"title" =>
		title := join(val);
		if (title != stack.title) {
			if (stack.title == nil) {
				cmd(win, ".c create text 5000 6000 -anchor n -tags t" + string id +
					" -fill #ffffaa");
				needresize = 1;
			} else if (title == nil) {
				cmd(win, ".c delete t" + string id);
				needresize = 1;
			}
			if (title != nil)
				cmd(win, ".c itemconfigure t" + string id + " -text '" + title);
			stack.title = title;
		}
	"n" =>
		# there are "n" cards in this stack, honest guv.
		n := int hd val;
		if (!stack.visible) {
			if (n > len stack.cards) {
				a := array[n - len stack.cards] of ref Object.Card;
				for (i := 0; i < len a; i++) {
					a[i] = makecard(--fakeid, stack);
					cardsetattr(a[i], "face", "0" :: nil);
				}
				insertcards(stack, a, len stack.cards);
			} else if (n < len stack.cards) {
				for (i := len stack.cards - 1; i >= n; i--)
					if (stack.cards[i].id >= 0)
						break;
				cards := extractcards(stack, (i + 1, len stack.cards));
				for (i = 0; i < len cards; i++)
					destroy(cards[i]);
			}
		}
		stack.n = n;
	"style" =>
		case hd val {
		"pile" =>
			stack.style = styPILE;
		"display" =>
			stack.style = styDISPLAY;
		* =>
			sys->print("unknown stack style '%s'\n", hd val);
		}
		needresize = 1;
	"owner" =>
		if (val != nil)
			stack.ownerid = int hd val;
		else
			stack.ownerid = -1;
		changesel(stack, stack.sel);
	"sel" =>
		sel: ref Selection;
		if (val == nil)
			sel = ref Selection.Empty;
		else if (tl val != nil && hd tl val == "-")
			sel = ref Selection.XRange((int hd val, int hd tl tl val));
		else {
			idxl: list of int;
			for (; val != nil; val = tl val)
				idxl = int hd val :: idxl;
			sel = ref Selection.Indexes(idxl);
		}
		changesel(stack, sel);
	* =>
		if (len attr >= len "actions" && attr[0:len "actions"] == "actions") {
			oldactions := stack.actions;
			act := 0;
			for (; val != nil; val = tl val) {
				case hd val {
				"click" =>
					act |= aCLICK;
				* =>
					sys->print("unknown action '%s'\n", hd val);
				}
			}
			stack.actions = act;
		} else
			sys->fprint(stderr, "bad stack attr '%s'\n", attr);
	}
}

showsize(stack: ref Layobject.Stack)
{
	id := string stack.id;
	needsize := stack.showsize && len stack.cards > 0 && stack.style == styPILE;
	if (needsize != stack.hassize) {
		if (stack.hassize)
			cmd(win, ".c delete n" + id + " N" + id);
		else {
			cmd(win, ".c create rectangle -5000 0 0 0  -fill #ffffaa -tags n" + id);
			cmd(win, ".c create text -5000 0 -anchor sw -fill red -tags N" + id);
		}
		stack.hassize = needsize;
	}
	if (needsize) {
		cmd(win, ".c itemconfigure N" + id + " -text " + string len stack.cards);
		sr := cardrect(stack, (len stack.cards - 1, len stack.cards));
		cmd(win, ".c coords N" + id + " " + p2s((sr.min.x, sr.max.y)));
		bbox := cmd(win, ".c bbox N" + id);
		cmd(win, ".c coords n" + id + " " + bbox);
		cmd(win, ".c raise n" + id + "; .c raise N" + id);
	}
}		

changesel(stack: ref Layobject.Stack, newsel: ref Selection)
{
	sid := "s" + string stack.id;
	cmd(win, ".c delete " + sid);

	if (me != nil && stack.ownerid == me.cid) {
		pick sel := newsel {
		Indexes =>
			for (l := sel.idxl; l != nil; l = tl l) {
				s := cmd(win, ".c create rectangle " +
					r2s(cardrect(stack, (hd l, hd l + 1)).inset(-1)) +
					" -width " + string Selectborder +
					" -outline " + Selectcolour +
					" -tags {" + sid + " " + sid + "." + string hd l + "}");
				cmd(win, ".c lower " + s + " i" + string stack.cards[hd l].id);
			}
		XRange =>
			cmd(win, ".c create rectangle " +
					r2s(cardrect(stack, sel.r).inset(-1)) +
					" -outline " + Selectcolour +
					" -width " + string Selectborder +
					" -tags " + sid);
		}
	}
	stack.sel = newsel;
}

cardsetattr(card: ref Object.Card, attr: string, val: list of string)
{
	id := string card.id;
	case attr {
	"face" =>
		card.face = int hd val;
		if (card.face) {
			if (card.number != -1)
				cmd(win, ".c itemconfigure i" + id + " -image c" + string card.number );
		} else
			cmd(win, ".c itemconfigure i" + id + " -image rear" + string card.rear);
	"number" =>
		card.number = int hd val;
		if (card.face)
			cmd(win, ".c itemconfigure i" + id + " -image c" + string card.number );
	"rear" =>
		card.rear = int hd val;
		if (card.face == 0)
			cmd(win, ".c itemconfigure i" + id + " -image rear" + string card.rear);
	* =>
		sys->print("unknown attribute on card: %s\n", attr);
	}
}

setlayid(layobj: ref Layobject, layid: int)
{
	if (layobj.layid != -1)
		panic("obj already has a layout id (" + string layobj.layid + ")");
	layobj.layid = layid;
	x := layobj.layid % len layobjects;
	layobjects[x] = layobj :: layobjects[x];
	needrepack = 1;
}

membersetattr(p: ref Object.Member, attr: string, val: list of string)
{
	case attr {
	"you" =>
		me = p;
		p.cid = int hd val;
		for (i := 0; i < len objects; i++) {
			if (objects[i] != nil) {
				pick o := objects[i] {
				Stack =>
					if (o.o.ownerid == p.cid)
						objneedsrepack(o.o);
				}
			}
		}
	"name" =>
		p.name = hd val;
	"id" =>
		p.cid = int hd val;
	"status" =>
		if (p == me)
			cmd(win, ".status configure -text '" + join(val));
	"cliquetitle" =>
		if (p == me)
			tkclient->settitle(win, join(val));
	* =>
		sys->print("unknown attribute on member: %s\n", attr);
	}
}

laysetattr(lay: ref Layout, attr: string, val: list of string)
{
	case attr {
	"opts" =>
		# orientation opts
		case hd val {
		"up" =>
			lay.orientation = oUP;
		"down" =>
			lay.orientation = oDOWN;
		"left" =>
			lay.orientation = oLEFT;
		"right" =>
			lay.orientation = oRIGHT;
		* =>
			sys->print("unknown orientation '%s'\n", hd val);
		}
		lay.opts = join(tl val);
	"layid" =>
#		sys->print("layout obj %d => layid %s\n", lay.id, hd val);
		pick l := lay {
		Obj =>
			l.layid = int hd val;
			needrepack = 1;
		* =>
			sys->print("cannot set layid on Layout.Frame!\n");
		}
	* =>
		sys->print("unknown attribute on lay: %s\n", attr);
	}
	needrepack = 1;
}

scoresetattr(score: ref Object.Score, attr: string, val: list of string)
{
	if (attr != "score")
		return;
	cmd(win, ".c delete score");

	Padx: con 10;		# padding to the right of each item
	Pady: con 6;		# padding below each item.

	n := len val;
	row := score.row = array[n] of (int, string);
	height := 0;

	# calculate values for this row
	for ((col, vl) := (0, val); vl != nil; (col, vl) = (col + 1, tl vl)) {
		v := hd vl;
		size := textsize(v);
		size.y += Pady;
		if (size.y > height)
			height = size.y;
		row[col] = (size.x + Padx, v);
	}
	score.height = height;
	totheight := 0;
	scores := scoretable.scores;

	# calculate number of columns
	ncols := 0;
	for (i := 0; i < len scores; i++)
		if (len scores[i].row > ncols)
			ncols = len scores[i].row;

	# calculate column widths
	colwidths := array[ncols] of {* => 0};
	for (i = 0; i < len scores; i++) {
		r := scores[i].row;
		for (j := 0; j < len r; j++) {
			(w, nil) := r[j];
			if (w > colwidths[j])
				colwidths[j] = w;
		}
		totheight += scores[i].height;
	}
	# create all table items
	p := Hiddenpos;
	for (i = 0; i < len scores; i++) {
		p.x = Hiddenpos.x;
		r := scores[i].row;
		for (j := 0; j < len r; j++) {
			(w, text) := r[j];
			cmd(win, ".c create text " + p2s(p) + " -anchor nw -tags {score scoreent}-text '" + text);
			p.x += colwidths[j];
		}
		p.y += scores[i].height;
	}
	r := Rect(Hiddenpos, p);
	r.min.x -= Padx;
	r.max.y -= Pady / 2;

	cmd(win, ".c create rectangle " + r2s(r) + " -fill #ffffaa -tags score");

	# horizontal lines
	y := 0;
	for (i = 0; i < len scores - 1; i++) {
		ly := y + scores[i].height - Pady / 2;
		cmd(win, ".c create line " + r2s(((r.min.x, ly), (r.max.x, ly))) + " -fill gray -tags score");
		y += scores[i].height;
	}

	cmd(win, ".c raise scoreent");
	cmd(win, ".c move score " + p2s(Hiddenpos.sub(r.min)));
}

textsize(s: string): Point
{
	return (cvsfont.width(s), cvsfont.height);
}

changecardid(c: ref Object.Card, newid: int)
{
	(nil, tags) := sys->tokenize(cmd(win, ".c gettags i" + string c.id), " ");
	for (; tags != nil; tags = tl tags) {
		tag := hd tags;
		if (tag[0] >= '0' && tag[0] <= '9')
			break;
	}
	cvsid := hd tags;
	cmd(win, ".c dtag " + cvsid + " i" + string c.id);
	c.id = newid;
	cmd(win, ".c addtag i" + string c.id + " withtag " + cvsid);
}

stackobj(id: int): ref Layobject.Stack
{
	obj := objects[id];
	if (obj == nil)
		panic("nil stack object");
	pick o := obj {
	Stack =>
		return o.o;
	* =>
		panic("expected obj " + string id + " to be a stack");
	}
	return nil;
}

# if there are updates pending on the stack,
# then wait for them all to finish before we can do
# any operations on the stack (e.g. insert, delete, create, etc)
completeanim(stk: ref Layobject.Stack)
{
	while (!stk.animq.isempty())
		animterminated(<-animfinishedch);
}

transfer(src: ref Layobject.Stack, r: Range, dst: ref Layobject.Stack, index: int)
{
	# we don't bother animating movement within a stack; maybe later?
	if (src == dst) {
		transfercards(src, r, dst, index);
		return;
	}
	completeanim(src);

	if (!src.visible) {
		# cards being transferred out of private area should
		# have already been created, but check anyway.
		if (r.start != 0)
			panic("bad transfer out of private");
		for (i := 0; i < r.end; i++)
			if (src.cards[i].id < 0)
				panic("cannot transfer fake card");
	}

	startanimating(newanimation(src, r), dst, index);
}

objneedsrepack(obj: ref Layobject)
{
	if (!obj.needrepack) {
		obj.needrepack = 1;
		repackobjs = obj :: repackobjs;
	}
}

repackobj(obj: ref Layobject)
{
	pick o := obj {
	Stack =>
		cards := o.cards;
		pos := o.pos;
		delta := o.delta;
		for (i := 0; i < len cards; i++) {
			p := pos.add(delta.mul(i));
			id := string cards[i].id;
			cmd(win, ".c coords i" + id + " " + p2s(p));
			cmd(win, ".c raise i" + id);		# XXX could be more efficient.
			cmd(win, ".c lower s" + string o.id + "." + string i + " i" + id);
		}
		changesel(o, o.sel);
		showsize(o);
	}
	obj.needrepack = 0;
}

cardrect(stack: ref Layobject.Stack, r: Range): Rect
{
	if (r.start == r.end)
		return ((-10, -10), (-10, -10));
	cr := Rect((0, 0), cardsize).addpt(stack.pos);
	delta := stack.delta;
	return union(cr.addpt(delta.mul(r.start)), cr.addpt(delta.mul(r.end - 1)));
}

repackall()
{
	sys->print("repackall()\n");
	needrepack = 0;
	if (layout == nil) {
		sys->print("no layout\n");
		return;
	}
	if (packwin == nil) {
		# use an unmapped tk window to do our packing arrangements
		packwin = tk->toplevel(drawctxt.display, "-bd 0");
		packwin.wreq = nil;			# stop window requests piling up.
	}
	cmd(packwin, "destroy " + cmd(packwin, "pack slaves ."));
	packobjs = nil;
	packit(layout, ".0");
	sys->print("%d packobjs\n", len packobjs);
	needresize = 1;
}

# make the frames for the objects to be laid out, in the
# offscreen window.
packit(lay: ref Layout, f: string)
{
	cmd(packwin, "frame " + f);
	cmd(packwin, "pack " + f + " " + lay.opts);
	pick l := lay {
	Frame =>
		for (i := 0; i < len l.lays; i++)
			packit(l.lays[i], f + "." + string i);
	Obj =>
		if ((obj := findlayobject(l.layid)) != nil) {
			obj.w = f;
			obj.orientation = l.orientation;
			packobjs = obj :: packobjs;
		} else
			sys->print("cannot find layobject %d\n", l.layid);
	}
}

sizetofit()
{
	if (packobjs == nil)
		return;
	cmd(packwin, "pack propagate . 1");
	cmd(packwin, ". configure -width 0 -height 0");	# make sure propagation works.
	csz := actsize(packwin, ".");
	cmd(win, "bind . <Configure> {}");
	cmd(win, "pack propagate . 1");
	cmd(win, ". configure -width 0 -height 0");

	cmd(win, ".c configure -width " + string csz.x + " -height " + string csz.y
			+ " -scrollregion {0 0 " + p2s(csz) + "}");
	winr := actrect(win, ".");
	screenr := win.image.screen.image.r;
	if (!winr.inrect(screenr)) {
		if (winr.dx() > screenr.dx())
			(winr.min.x, winr.max.x) = (screenr.min.x, screenr.max.x);
		if (winr.dy() > screenr.dy())
			(winr.min.y, winr.max.y) = (screenr.min.y, screenr.max.y);
		if (winr.max.x > screenr.max.x)
			(winr.min.x, winr.max.x) = (screenr.max.x - winr.dx(), screenr.max.x);
		if (winr.max.y > screenr.max.y)
			(winr.min.y, winr.max.y) = (screenr.max.y - winr.dy(), screenr.max.y);
	}
	cmd(win, "pack propagate . 0");
	cmd(win, ". configure " +
			" -x " + string winr.min.x +
			" -y " + string winr.min.y +
			" -width " + string winr.dx() +
			" -height " + string winr.dy());
	needresize = 1;
	updatearena();
	cmd(win, "bind . <Configure> {send cmd config}");
}

setorigin(r: Rect, p: Point): Rect
{
	sz := Point(r.max.x - r.min.x, r.max.y - r.min.y);
	return (p, p.add(sz));
}

resizeall()
{
	needresize = 0;
	if (packobjs == nil)
		return;
	cmd(packwin, "pack propagate . 1");
	cmd(packwin, ". configure -width 0 -height 0");	# make sure propagation works.
	for (sl := packobjs; sl != nil; sl = tl sl) {
		obj := hd sl;
		sizeobj(obj);
		cmd(packwin, obj.w + " configure -width " + string obj.size.x +
			" -height " + string obj.size.y);
	}
	csz := actsize(packwin, ".");
	sz := actsize(win, ".cf");
	if (sz.x > csz.x || sz.y > csz.y) {
		cmd(packwin, "pack propagate . 0");
		if (sz.x > csz.x) {
			cmd(packwin, ". configure -width " + string sz.x);
			cmd(win, ".c xview moveto 0");
			csz.x = sz.x;
		}
		if (sz.y > csz.y) {
			cmd(packwin, ". configure -height " + string sz.y);
			cmd(win, ".c yview moveto 0");
			csz.y = sz.y;
		}
	}
	cmd(win, ".c configure -width " + string csz.x + " -height " + string csz.y
			+ " -scrollregion {0 0 " + p2s(csz) + "}");
	onscreen();
	for (sl = packobjs; sl != nil; sl = tl sl) {
		obj := hd sl;
		r := actrect(packwin, obj.w);
		positionobj(obj, r);
	}
}

# make sure that there aren't any unnecessary blank
# bits in the scroll area.
onscreen()
{
	(n, toks) := sys->tokenize(cmd(win, ".c xview"), " ");
	cmd(win, ".c xview moveto " + hd toks);
	(n, toks) = sys->tokenize(cmd(win, ".c yview"), " ");
	cmd(win, ".c yview moveto " + hd toks);
}

# work out the size of an object to be laid out.
sizeobj(obj: ref Layobject)
{
	pick o := obj {
	Stack =>
		delta := Point(0, 0);
		case o.style {
		styDISPLAY =>
			case o.orientation {
			oRIGHT =>	delta.x = carddelta.x;
			oLEFT =>		delta.x = -carddelta.x;
			oDOWN =>	delta.y = carddelta.y;
			oUP =>		delta.y = -carddelta.y;
			}
		styPILE =>
			;	# no offset
		}
		o.delta = delta;
		r := Rect((0, 0), size(cardrect(o, (0, max(len o.cards, o.maxcards)))));
		if (o.title != nil) {
			p := Point(r.min.x + r.dx() / 2, r.min.y);
			tr := s2r(cmd(win, ".c bbox t" + string o.id));
			tbox := Rect((p.x - tr.dx() / 2, p.y - tr.dy()), (p.x + tr.dx() / 2, p.y));
			r = union(r, tbox);
		}
		o.size = r.max.sub(r.min).add((Border * 2, Border * 2));
#		sys->print("sized stack %d => %s\n", o.id, p2s(o.size));
	Widget =>
		w := ".buts." + string o.id;
		o.size.x = int cmd(win, w + " cget -width");
		o.size.y = int cmd(win, w + " cget -height");
#		sys->print("sized widget %d (%s) => %s\n", o.id,
#			cmd(win, "winfo class " + w + ".b"), p2s(o.size));
	}
}

# set a laid-out object's position on the canvas, given
# its allocated rectangle, r.
positionobj(obj: ref Layobject, r: Rect)
{
	pick o := obj {
	Stack =>
#		sys->print("positioning stack %d, r %s\n", o.id, r2s(r));
		delta := o.delta;
		sz := o.size.sub((Border * 2, Border * 2));
		r.min.x += (r.dx() - sz.x) / 2;
		r.min.y += (r.dy() - sz.y) / 2;
		r.max = r.min.add(sz);
		if (o.title != nil) {
			cmd(win, ".c coords t" +string o.id + " " +
				string (r.min.x + r.dx() / 2) + " " + string r.min.y);
			tr := s2r(cmd(win, ".c bbox t" + string o.id));
			r.min.y = tr.max.y;
			sz = size(cardrect(o, (0, max(len o.cards, o.maxcards))));
			r.min.x += (r.dx() - sz.x) / 2;
			r.min.y += (r.dy() - sz.y) / 2;
			r.max = r.min.add(sz);
		}
		o.pos = r.min;
		if (delta.x < 0)
			o.pos.x = r.max.x - cardsize.x;
		if (delta.y < 0)
			o.pos.y = r.max.y - cardsize.y;
		cmd(win, ".c coords r" + string o.id + " " + r2s(r.inset(-(Border / 2))));
		objneedsrepack(o);
	Widget =>
#		sys->print("positioning widget %d, r %s\n", o.id, r2s(r));
		cmd(win, ".c coords r" + string o.id + " " + p2s(r.min));
		bd := int cmd(win, ".buts." + string o.id + " cget -bd");
		cmd(win, ".c itemconfigure r" + string o.id +
			" -width " + string (r.dx() - bd * 2) +
			" -height " + string (r.dy() - bd * 2));
	}
}

size(r: Rect): Point
{
	return r.max.sub(r.min);
}

transfercards(src: ref Layobject.Stack, r: Range, dst: ref Layobject.Stack, index: int)
{
	cards := extractcards(src, r);
	n := r.end - r.start;
	# if we've just removed some cards from the destination,
	# then adjust the destination index accordingly.
	if (src == dst && index > r.start) {
		if (index < r.end)
			index = r.start;
		else
			index -= n;
	}
	insertcards(dst, cards, index);
}

extractcards(src: ref Layobject.Stack, r: Range): array of ref Object.Card
{
	if (len src.cards > src.maxcards)
		needresize = 1;
	deltag(src.cards[r.start:r.end], "c" + string src.id);
	n := r.end - r.start;
	cards := src.cards[r.start:r.end];
	newcards := array[len src.cards - n] of ref Object.Card;
	newcards[0:] = src.cards[0:r.start];
	newcards[r.start:] = src.cards[r.end:];
	src.cards = newcards;
	objneedsrepack(src);		# XXX not necessary if moving from top?
	return cards;
}

insertcards(dst: ref Layobject.Stack, cards: array of ref Object.Card, index: int)
{
	n := len cards;
	newcards := array[len dst.cards + n] of ref Object.Card;
	newcards[0:] = dst.cards[0:index];
	newcards[index + n:] = dst.cards[index:];
	newcards[index:] = cards;
	dst.cards = newcards;

	for (i := 0; i < len cards; i++)
		cards[i].parentid = dst.id;
	addtag(dst.cards[index:index + n], "c" + string dst.id);
	objneedsrepack(dst);		# XXX not necessary if adding to top?
	if (len dst.cards > dst.maxcards)
		needresize = 1;
}

destroy(obj: ref Object)
{
	if (obj.id >= 0)
		objects[obj.id] = nil;
	id := string obj.id;
	pick o := obj {
	Card =>
		cmd(win, ".c delete i" + id);	# XXX crashed here once...
	Widget =>
		cmd(win, ".c delete r" + id);
		w := ".buts." + id;
		cmd(win, "destroy " + w);
		dellayobject(o.o);
	Stack =>
		completeanim(o.o);
		cmd(win, ".c delete r" + id + " s" + id + " n" + id + " N" + id);
		if (o.o.title != nil)
			cmd(win, ".c delete t" + id);
		cmd(win, ".c delete c" + id);		# any remaining "fake" cards
		needrepack = 1;
		dellayobject(o.o);
	Button =>
		cmd(win, "destroy .buts." + string o.id);
	Member =>
		if (o.cid != -1) {
			# XXX remove member from members hash.
		}
	Layoutobj =>
		if ((l := findlayobject(o.lay.layid)) != nil) {
			# XXX are we sure they're not off-screen anyway?
			cmd(win, ".c move r" + string l.id + " 5000 5000");
			cmd(win, ".c move c" + string l.id + " 5000 5000");
			cmd(win, ".c move N" + string l.id + " 5000 5000");
			cmd(win, ".c move n" + string l.id + " 5000 5000");
			cmd(win, ".c move s" + string l.id + " 5000 5000");
		}
		if (layout == o.lay)
			layout = nil;
	Layoutframe =>
		if (layout == o.lay)
			layout = nil;
	}
}

dellayobject(lay: ref Layobject)
{
	if (lay.layid == -1)
		return;
	x := lay.layid % len layobjects;
	nl: list of ref Layobject;
	for (ll := layobjects[x]; ll != nil; ll = tl ll)
		if ((hd ll).layid != lay.layid)
			nl = hd ll :: nl;
	layobjects[x] = nl;
}

findlayobject(layid: int): ref Layobject
{
	if (layid == -1)
		return nil;
	for (ll := layobjects[layid % len layobjects]; ll != nil; ll = tl ll)
		if ((hd ll).layid == layid)
			return hd ll;
	return nil;
}

deltag(cards: array of ref Object.Card, tag: string)
{
	for (i := 0; i < len cards; i++)
		cmd(win, ".c dtag i" + string cards[i].id + " " + tag);
}

addtag(cards: array of ref Object.Card, tag: string)
{
	for (i := 0; i < len cards; i++)
		cmd(win, ".c addtag " + tag + " withtag i" + string cards[i].id);
}

join(v: list of string): string
{
	if (v == nil)
		return nil;
	s := hd v;
	for (v = tl v; v != nil; v = tl v)
		s += " " + hd v;
	return s;
}

notify(s: string)
{
	notifych <-= s;
}

notifierproc()
{
	notifypid := -1;
	sync := chan of int;
	for (;;) {
		s := <-notifych;
		kill(notifypid);
		spawn notifyproc(s, sync);
		notifypid = <-sync;
	}
}

notifyproc(s: string, sync: chan of int)
{
	sync <-= sys->pctl(0, nil);
	cmd(win, ".c delete notify");
	id := cmd(win, ".c create text " + p2s(visibleorigin()) + " -anchor nw -fill red -tags notify -text '" + s);
	bbox := cmd(win, ".c bbox " + id);
	cmd(win, ".c create rectangle " + bbox + " -fill #ffffaa -tags notify");
	cmd(win, ".c raise " + id);
	cmd(win, "update");
	sys->sleep(1500);
	cmd(win, ".c delete notify");
	cmd(win, "update");
}

# move canvas so that canvas point canvp lies under
# screen point scrp.
pan(canvp, scrp: Point)
{
	o := Point(int cmd(win, ".c cget -actx"), int cmd(win, ".c cget -acty"));
	co := canvp.sub(scrp.sub(o));
	sz := Point(int cmd(win, ".c cget -width"), int cmd(win, ".c cget -height"));

	cmd(win, ".c xview moveto " + string (real co.x / real sz.x));
	cmd(win, ".c yview moveto " + string (real co.y / real sz.y));
}

# return the top left point that's currently visible
# in the canvas, taking into account scrolling.
visibleorigin(): Point
{
	(scrx, scry) := (cmd(win, ".c cget -actx"), cmd(win, ".c cget -acty"));
	return Point (int cmd(win, ".c canvasx " + scrx),
		int cmd(win, ".c canvasy " + scry));
}

s2r(s: string): Rect
{
	r: Rect;
	(n, toks) := sys->tokenize(s, " ");
	if (n < 4)
		panic("malformed rectangle " + s);
	(r.min.x, toks) = (int hd toks, tl toks);
	(r.min.y, toks) = (int hd toks, tl toks);
	(r.max.x, toks) = (int hd toks, tl toks);
	(r.max.y, toks) = (int hd toks, tl toks);
	return r;
}

r2s(r: Rect): string
{
	return sys->sprint("%d %d %d %d", r.min.x, r.min.y, r.max.x, r.max.y);
}

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

union(r1, r2: Rect): Rect
{
	if (r1.min.x > r2.min.x)
		r1.min.x = r2.min.x;
	if (r1.min.y > r2.min.y)
		r1.min.y = r2.min.y;

	if (r1.max.x < r2.max.x)
		r1.max.x = r2.max.x;
	if (r1.max.y < r2.max.y)
		r1.max.y = r2.max.y;
	return r1;
}
 
kill(pid: int)
{
	if ((fd := sys->open("/prog/"+string pid+"/ctl", Sys->OWRITE)) != nil)
		sys->write(fd, array of byte "kill", 4);
}

lockproc()
{
	for (;;) {
		<-cardlockch;
		cardlockch <-=1;
	}
}

lock()
{
	cardlockch <-= 1;
}

unlock()
{
	<-cardlockch;
}

openimage(file: string, id: string): Point
{
	if (tk->cmd(win, "image create bitmap " + id + " -file " + file)[0] == '!')
		return (0, 0);
	return (int tk->cmd(win, "image width " + id),
				int tk->cmd(win, "image height " + id));
}

# read images into tk.
readimages(dir: string, prefix: string): (int, Point)
{
	displ := drawctxt.display;
	if (cardsize.x > 0 && cardsize.y > 0 &&
			(img := displ.open(dir + "/" + prefix + ".all.bit")) != nil) {
		if (img.r.dx() % cardsize.x != 0 || img.r.dy() != cardsize.y)
			sys->fprint(stderr, "cards: inconsistent complete image, ignoring\n");
		else {
			n := img.r.dx() / cardsize.x;
			x := img.r.min.x;
			sys->print("found %d cards in complete image\n", n);
			for (i := 0; i < n; i++) {
				c := displ.newimage(((0, 0), cardsize), img.chans, 0, 0);
				c.draw(c.r, img, nil, (x, 0));
				id := prefix + string i;
				cmd(win, "image create bitmap " + id);
				tk->putimage(win, id, c, nil);
				x += cardsize.x;
			}
			return (n, cardsize);
		}
	}
				
	size := openimage("@" + dir + "/" + prefix + "0.bit", prefix + "0");
	if (size.x == 0) {
		sys->print("no first image (filename: '%s')\n", dir + "/" + prefix + "0.bit");
		return (0, (0, 0));
	}
	i := 1;
	for (;;) {
		nsize := openimage("@" + dir + "/" + prefix + string i + ".bit", prefix + string i);
		if (nsize.x == 0)
			break;
		if (!nsize.eq(size))
			sys->fprint(stderr, "warning: inconsistent image size in %s/%s%d.bit, " +
				"[%d %d] vs [%d %d]\n", dir, prefix, i, size.x, size.y, nsize.x, nsize.y);
		i++;
	}
	return (i, size);
}

newanimation(src: ref Layobject.Stack, r: Range): ref Animation
{
	a := ref Animation;
	a.srcpt = src.pos.add(src.delta.mul(r.start));
	cards := extractcards(src, r);
	a.cards = cards;
	a.waitch = chan of ref Animation;
	return a;
}

startanimating(a: ref Animation, dst: ref Layobject.Stack, index: int)
{
	q := dst.animq;
	if (q.isempty())
		spawn animqueueproc(a.waitch);

	a.tag = "a" + string animid++;
	addtag(a.cards, a.tag);
	q.put(a);
	a.dstid = dst.id;
	a.index = index;
	spawn animproc(a);
}

SPEED: con 1.5;			# animation speed in pixels/millisec

animproc(a: ref Animation)
{
	tick := chan of int;
	dst := stackobj(a.dstid);
	if (dst == nil)
		panic("animation destination has gone!");
	dstpt := dst.pos.add(dst.delta.mul(a.index));
	srcpt := a.srcpt;
	d := dstpt.sub(srcpt);
	# don't bother animating if moving to or from a hidden stack.
	if (!srcpt.eq(Hiddenpos) && !dst.pos.eq(Hiddenpos) && !d.eq((0, 0))) {
		mag := math->sqrt(real(d.x * d.x + d.y * d.y));
		(vx, vy) := (real d.x / mag, real d.y / mag);
		currpt := a.srcpt;		# current position of cards
		t0 := starttime;
		dt := int (mag / SPEED);
		t := 0;
		tickregister(tick);
		cmd(win, ".c raise " + a.tag);
		while (t < dt) {
			s := real t * SPEED;
			p := Point(srcpt.x + int (s * vx), srcpt.y + int (s * vy));
			dp := p.sub(currpt);
			cmd(win, ".c move " + a.tag + " " + string dp.x + " " + string dp.y);
			currpt = p;
			t = <-tick - t0;
		}
		tickunregister(tick);
		cmd(win, "update");
	}
	a.waitch <-= a;
}

tickregister(tick: chan of int)
{
	tickregisterch <-= tick;
}

tickunregister(tick: chan of int)
{
	tickunregisterch <-= tick;
}

tickproc(tick: chan of int)
{
	for (;;)
		tick <-= 1;
}

timeproc()
{
	reg: list of chan of int;
	dummytick := chan of int;
	realtick := chan of int;
	tick := dummytick;
	spawn tickproc(realtick);
	for (;;) {
		alt {
		c := <-tickregisterch =>
			if (reg == nil)
				tick = realtick;
			reg = c :: reg;
		c := <-tickunregisterch =>
			r: list of chan of int;
			for (; reg != nil; reg = tl reg)
				if (hd reg != c)
					r = hd reg :: r;
			reg = r;
			if (reg == nil)
				tick = dummytick;
		<-tick =>
			t := sys->millisec();
			for (r := reg; r != nil; r = tl r) {
				alt {
				hd r <-= t =>
					;
				* =>
					;
				}
			}
			cmd(win, "update");
		}
	}
}

yield()
{
	yieldch <-= 1;
}

yieldproc()
{
	for (;;)
		<-yieldch;
}


# send completed animations down animfinishedch;
# wait for a reply, which is either a new animation to wait
# for (the next in the queue) or nil, telling us to exit
animqueueproc(waitch: chan of ref Animation)
{
	rc := chan of chan of ref Animation;
	while (waitch != nil) {
		animfinishedch <-= (<-waitch, rc);
		waitch = <-rc;
	}
}

# an animation has finished.
# move the cards into their final place in the stack,
# remove the animation from the queue it's on,
# and inform the mediating process of the next animation process in the queue.
animterminated(v: (ref Animation, chan of chan of ref Animation))
{
	(a, rc) := v;
	deltag(a.cards, a.tag);
	dst := stackobj(a.dstid);
	insertcards(dst, a.cards, a.index);
	repackobj(dst);
	cmd(win, "update");
	q := dst.animq;
	q.get();
	if (q.isempty())
		rc <-= nil;
	else {
		a = q.peek();
		rc <-= a.waitch;
	}
}

actrect(win: ref Tk->Toplevel, w: string): Rect
{
	r: Rect;
	r.min.x = int cmd(win, w + " cget -actx") + int cmd(win, w + " cget -bd");
	r.min.y = int cmd(win, w + " cget -acty") + int cmd(win, w + " cget -bd");
	r.max.x = r.min.x + int cmd(win, w + " cget -actwidth");
	r.max.y = r.min.y + int cmd(win, w + " cget -actheight");
	return r;
}

actsize(win: ref Tk->Toplevel, w: string): Point
{
	return (int cmd(win, w + " cget -actwidth"), int cmd(win, w + " cget -actheight"));
}

Queue.put(q: self ref Queue, s: T)
{
	q.t = s :: q.t;
}

Queue.get(q: self ref Queue): T
{
	s: T;
	if(q.h == nil){
		q.h = revlist(q.t);
		q.t = nil;
	}
	if(q.h != nil){
		s = hd q.h;
		q.h = tl q.h;
	}
	return s;
}

Queue.peek(q: self ref Queue): T
{
	s: T;
	if (q.isempty())
		return s;
	s = q.get();
	q.h = s :: q.h;
	return s;
}

Queue.isempty(q: self ref Queue): int
{
	return q.h == nil && q.t == nil;
}

revlist(ls: list of T) : list of T
{
	rs: list of T;
	for (; ls != nil; ls = tl ls)
		rs = hd ls :: rs;
	return rs;
}

readconfig(): int
{
	for (lines := readconfigfile("/icons/cards/config"); lines != nil; lines = tl lines) {
		t := hd lines;
		case hd t {
		"rearborder" =>
			Rearborder = int hd tl t;
		"border" =>
			Border = int hd tl t;
		"selectborder" =>
			Selectborder = int hd tl t;
		"xdelta" =>
			carddelta.x = int hd tl t;
		"ydelta" =>
			carddelta.y = int hd tl t;
		"font" =>
			Textfont = hd tl t;
		"selectcolour" =>
			Selectcolour = hd tl t;
		"cardsize" =>
			if (len t != 3)
				sys->fprint(stderr, "cards: invalid value for cardsize attribute\n");
			else
				cardsize = (int hd tl t, int hd tl tl t);
		* =>
			sys->fprint(stderr, "cards: unknown config attribute: %s\n", hd t);
		}
	}
	return 0;
}

readcardimages(): int
{
	(nimages, cardsize) = readimages("/icons/cards", "c");
 	if (nimages == 0) {
		sys->fprint(stderr, "cards: no card images found\n");
		return -1;
	}
	sys->print("%d card images found\n", nimages);

	(nrears, rearsize) := readimages("/icons/cardrears", "rear");
	if (nrears > 0 && !rearsize.eq(cardsize)) {
		sys->fprint(stderr, "cards: card rear sizes don't match card sizes (%s vs %s)\n", p2s(rearsize), p2s(cardsize));
		return -1;
	}
	sys->print("%d card rear images found\n", nrears);
	cr := Rect((0, 0), cardsize);
	for (i := nrears; i < len rearcolours; i++) {
		cmd(win, "image create bitmap rear" + string i);
		img := drawctxt.display.newimage(cr, Draw->XRGB32, 0, Draw->Black);
		img.draw(cr.inset(Rearborder),
			drawctxt.display.color(rearcolours[i] - nrears), nil, (0, 0));
		tk->putimage(win, "rear" + string i, img, nil);
	}
	return 0;
}

readconfigfile(f: string): list of list of string
{
	sys->print("opening config file '%s'\n", f);
	fd := sys->open(f, Sys->OREAD);
	if (fd == nil)
		return nil;
	buf := array[Sys->ATOMICIO] of byte;
	nb := sys->read(fd, buf, len buf);
	if (nb <= 0)
		return nil;
	(nil, lines) := sys->tokenize(string buf[0:nb], "\r\n");
	r: list of list of string;
	for (; lines != nil; lines = tl lines) {
		(n, toks) := sys->tokenize(hd lines, " \t");
		if (n == 0)
			continue;
		if (n < 2)
			sys->fprint(stderr, "cards: invalid config line: %s\n", hd lines);
		else
			r = toks :: r;
	}
	return r;
}

fittoscreen(win: ref Tk->Toplevel)
{
	Point: import draw;
	if (win.image == nil || win.image.screen == nil)
		return;
	r := win.image.screen.image.r;
	scrsize := Point((r.max.x - r.min.x), (r.max.y - r.min.y));
	bd := int cmd(win, ". cget -bd");
	winsize := Point(int cmd(win, ". cget -actwidth") + bd * 2, int cmd(win, ". cget -actheight") + bd * 2);
	if (winsize.x > scrsize.x)
		cmd(win, ". configure -width " + string (scrsize.x - bd * 2));
	if (winsize.y > scrsize.y)
		cmd(win, ". configure -height " + string (scrsize.y - bd * 2));
	actr: Rect;
	actr.min = Point(int cmd(win, ". cget -actx"), int cmd(win, ". cget -acty"));
	actr.max = actr.min.add((int cmd(win, ". cget -actwidth") + bd*2,
				int cmd(win, ". cget -actheight") + bd*2));
	(dx, dy) := (actr.dx(), actr.dy());
	if (actr.max.x > r.max.x)
		(actr.min.x, actr.max.x) = (r.min.x - dx, r.max.x - dx);
	if (actr.max.y > r.max.y)
		(actr.min.y, actr.max.y) = (r.min.y - dy, r.max.y - dy);
	if (actr.min.x < r.min.x)
		(actr.min.x, actr.max.x) = (r.min.x, r.min.x + dx);
	if (actr.min.y < r.min.y)
		(actr.min.y, actr.max.y) = (r.min.y, r.min.y + dy);
	cmd(win, ". configure -x " + string actr.min.x + " -y " + string actr.min.y);
}

panic(s: string)
{
	sys->fprint(stderr, "cards: panic: %s\n", s);
	raise "panic";
}

showtk := 0;
cmd(top: ref Tk->Toplevel, s: string): string
{
	if (showtk)
		sys->print("tk: %s\n", s);
	e := tk->cmd(top, s);
	if (e != nil && e[0] == '!') {
		sys->fprint(stderr, "tk error %s on '%s'\n", e, s);
		raise "panic";
	}
	return e;
}

max(a, b: int): int
{
	if (a > b)
		return a;
	return b;
}