implement Clientmod;
include "sys.m";
	sys: Sys;
include "draw.m";
	draw: Draw;
	Point, Rect, Display, Image, Font: import draw;
include "tk.m";
	tk: Tk;
include "wmlib.m";
	wmlib: Wmlib;
include "math.m";
	math: Math;
include "../gameclient.m";

# fairly general card game client.
# inherent restrictions:
#	players are symmetrical; each player has the same set of personal objects.
#
#	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;
	Player =>
		cid:			int;			# *not* playerid
		name:		string;
	Menuentry =>
		parentid:		int;
		text:			string;
	Item =>
		item:			ref Cvsitem;
	Layout =>		# defines the root of the layout hierarchy
		cvsid:		int;
	Button =>
	Other =>
	}
};

Itemhd: adt {
	cvsid:		int;
	w:			string;
	size:			Point;
	needrepack:	int;
	packopts:		string;
	orientation:	int;
	refcount:		int;
};

# an object which can be laid out on the canvas
Cvsitem: adt {
	id:			int;
	parentid:		int;
	h:			Itemhd;
	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.
		maxcards:	int;
		title:			string;
		visible:		int;
		n:			int;			# for concealed stacks, n cards in stack.
		ownerid:		int;			# owner of selection
		sel:			ref Selection;
	Widget =>
		wtype:		string;
		entries:		array of ref Object.Menuentry;
		cmd:			string;		# only used for entry widgets
		width:		int;
	Frame =>
		opts:			string;
		subitems:		cyclic array of ref Cvsitem;
	Ref =>
		# a symbolic reference to another cvsitem
		refid:		int;
	Unknown =>
		# it's referred to, but not yet created.	
	}
};

Blankhd := Itemhd(
	-1,			# cvsid
	"",			# w
	(0, 0),		# size
	0,			# needrepack
	"",			# packopts
	-1,			# orientation
	0			# refcount
);

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;

# 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",
"scrollbar .cf.horiz -orient horizontal -command {.c xview}",
"scrollbar .cf.vert -orient vertical -command {.c yview}",
"canvas .c -width 400 -height 450" +
	" -xscrollcommand {.cf.horiz set} -yscrollcommand {.cf.vert set} -bg green",
"frame .stf",
"label .status -text 0",
"pack .status -in .stf -side top -fill x",
"button .buts.b -text 0",
"pack .buts.b",
"checkbutton .buts.scores -text {Show scores} -command {send cmd scores}",
"pack .buts .stf -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 .stf 0",
"pack propagate .buts 0",
"destroy .buts.b",
".status configure -text {}",
"pack propagate . 0",
};

objects: 		array of ref Object;
cvsitems := array[20] of list of ref Cvsitem;
players := array[8] of list of ref Object.Player;
win: 			ref Tk->Toplevel;
drawctxt:		ref Draw->Context;
me:			ref Object.Player;
layout:		ref Object.Layout;

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;
cvsfont: 		ref Font;

horizscrollbar := 0;
vertscrollbar := 0;
packwin:		ref Tk->Toplevel;	# invisible; used to steal tk's packing algorithms...
packitems:		list of ref Cvsitem;
repackitems:	list of ref Cvsitem;
needresize := 0;
needrepack := 0;

animid := 0;
fakeid := -2;		# ids allocated to "fake" cards in private hands; descending
playerid := -1;
notifypid := -1;
nimages := 0;
cardsize: Point;
carddelta := Point(12, 15);		# offset in order to see card number/suit
b2down := 0;
Hiddenpos := Point(5000, 5000);

gamefd: ref Sys->FD;

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

client1()
{
	gamefd = sys->fildes(0);

	sys->pctl(Sys->NEWPGRP, nil);

	winctl: chan of string;
	(win, winctl) = wmlib->titlebar(drawctxt.screen, nil,
		"Cards", Wmlib->Appl);
	cmd(win, ". unmap");
	bcmd := chan of string;
	tk->namechan(win, bcmd, "cmd");
	srvcmd := chan of string;
	tk->namechan(win, srvcmd, "srv");

	(nimages, cardsize) = readimages("/icons/cards");
 	if (nimages == 0) {
		sys->fprint(stderr, "cards: no images found\n");
		sys->raise("fail:error");
	}

	cr := Rect((0, 0), cardsize);
	for (i := 0; i < 10; i++) {
		cmd(win, "image create bitmap rear" + string i);
		img := drawctxt.display.newimage(cr, 3, 0, Draw->Black);
		img.draw(cr.inset(3),
			drawctxt.display.color((Draw->Red + i * 7) % 256), drawctxt.display.ones, (0, 0));
		tk->imageput(win, "rear" + string i, img, nil);
	}
	sys->print("%d images read\n", nimages);

	for (i = 0; i < len configcmds; i++)
		cmd(win, configcmds[i]);
	cmd(win, ". map");
	cmd(win, "update");

	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);
		sys->raise("fail:error");
	}
	fontname = nil;

	cardlockch = chan of int;
	spawn lockproc();

	yieldch = chan of int;
	spawn yieldproc();

	notifych = chan of string;
	spawn notifierproc();

	spawn updateproc();

	for (;;) alt {
	c := <-bcmd =>
		(n, toks) := sys->tokenize(c, " ");
		case hd toks {
		"b2" =>
			b2down = 1;
		"b2r" =>
			b2down = 0;
		"b3" =>
			curp := Point(int cmd(win, ".c canvasx " + hd tl toks),
				int cmd(win, ".c canvasy " + hd tl tl toks));
			b3raise(bcmd, curp);
		"b1r" =>
			# b1r 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));
			b1action(bcmd, curp);
		"entry" =>
			id := int hd tl toks;
			lock();
			c := "";
			pick o := objects[id] {
			Item =>
				pick item := o.item {
				Widget =>
					c = item.cmd;
				}
			}
			unlock();
			if (c != nil) {
				w := ".buts." + string id + ".b";
				s := cmd(win, w + " get");
				cardscmd(c + " " + s);
				cmd(win, w + " selection range 0 end");
				cmd(win, "update");
			}
		"config" =>
			lock();
			needresize = 1;
			updatearena();
			unlock();
			cmd(win, "update");
		}
	c := <-srvcmd =>		# from button or menu entry
		cardscmd(c);
	c := <-winctl =>
		if (c == "exit")
			sys->write(gamefd, array[0] of byte, 0);
		wmlib->titlectl(win, c);
	}
}

b1action(bcmd: chan of string, p: Point)
{
	id := hitcard(p);
	if (id < 0)		# either error, or someone else's private card
		return;
	lock();
	if (objects[id] == nil) {
		notify("it's gone");
		unlock();
		return;
	}
	stackid := -1;
	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;
		stackid = stack.id;
	Item =>
		if (tagof(o.item) == tagof(Cvsitem.Stack))
			stackid = o.id;
	* =>
		unlock();
		return;
	}
	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.
	cardscmd("click " + string stackid + " " + string index);
}

b3raise(bcmd: chan of string, p: Point)
{
	currcard := -1;
	above := "";
#	cmd(win, "grab set .c");
loop:	for (;;) {
		if ((id := hitcard(p)) != 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");
	}
#	cmd(win, "grab release .c");
}

hitcard(p: Point): int
{
	(nil, hitids) := sys->tokenize(cmd(win, ".c find overlapping " + r2s((p, p))), " ");
	if (hitids == nil)
		return -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')
				return int (hd tags)[1:];
			if (tag[0] == 's')		# ignore selection
				break;
		}
		if (tags == nil)
			break;
	}
	return -1;
}

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

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

readupdatesproc(updatech: chan of list of string)
{
	buf := array[Sys->ATOMICIO] of byte;
	while ((n := sys->read(gamefd, buf, len buf)) > 0) {
		(nil, lines) := sys->tokenize(string buf[0:n], "\n");
		if (lines != nil)
			updatech <-= lines;
	}
	if (n < 0)
		sys->fprint(stderr, "cards: error reading updates: %r\n");
	updatech <-= nil;
	sys->print("cards: updateproc exiting\n");
}

updateproc1()
{
	updatech := chan of list of string;
	animfinishedch = chan of (ref Animation, chan of chan of ref Animation);
	spawn readupdatesproc(updatech);
	for (;;) {
		alt {
		v := <-animfinishedch =>
			lock();
			animterminated(v);
			updatearena();
			cmd(win, "update");
			unlock();
		u := <-updatech =>
			if (u == nil)
				exit;
			lock();
			for (; u != nil; u = tl u)
				applyupdate(hd u);
			updatearena();
			cmd(win, "update");
			unlock();
		}
	}
}

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



applyupdate(s: string)
{
#	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) {
			newobjects := array[len objects + 10] of ref Object;
			newobjects[0:] = objects;
			objects = newobjects;
		}
		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 {
		"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 game, 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);
			}
		"menuentry" =>
			objects[id] = makemenuentry(id, parentid, tl objtype);
		"player" =>
			objects[id] = ref Object.Player(id, -1, "");
		"layoutroot" =>
			objects[id] = ref Object.Layout(id, -1);	
		"stack" =>
			o := objects[id] = makestack(id, parentid, vis);
			addcvsitem(o.item);
		"widget" =>
			o := objects[id] = makewidget(id, parentid, hd tl objtype);
			addcvsitem(o.item);
		"frame" =>
			item := ref Cvsitem.Frame(
				id,
				parentid,
				Blankhd,
				"",			# opts
				nil			# subitems
			);
			objects[id] = ref Object.Item(id, item);
			addcvsitem(item);
		"ref" =>
			item := ref Cvsitem.Ref(id, parentid, Blankhd, -1);
			objects[id] = ref Object.Item(id, item);
			addcvsitem(item);
		"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 Cvsitem.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);
		deleted := 1;
		pick o := oo {
		Item =>
			pick item := o.item {
			Stack =>			# deleting cards from a stack.
				stk := item;
				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]);
				}
			Frame =>		# deleting from an item container.
				items := item.subitems;
				if (r.start != 0 || r.end != len items)
					panic("cannot partially delete layouts");
				for (i := r.start; i < r.end; i++)
					destroy(objects[items[i].id]);
				item.subitems =  nil;
				needrepack = 1;
			Widget =>
				# must be a menu widget
				cmd(win, ".buts." + string o.id + ".m delete " +
					string r.start + " " + string r.end);
			* =>
				deleted = 0;
			}
			
		* =>
			deleted = 0;
		}
		if (!deleted)
			for (objs := tl tl tl tl toks; objs != nil; objs = tl objs)
				destroy(objects[int hd objs]);

	"playerid" =>
		# playerid clientid playerid
		playerid = int hd tl tl toks;

	"set" =>
		# set obj attr val
		id := int hd tl toks;
		card := objects[id];
		(attr, val) := (hd tl tl toks, tl tl tl toks);
		pick o := objects[id] {
		Card =>
			cardsetattr(o, attr, val);
		Player =>
			playersetattr(o, attr, val);
		Button =>
			buttonsetattr(o, attr, val);
		Menuentry =>
			menuentrysetattr(o, attr, val);
		Item =>
			itemsetattr(o.item, attr, val);
		Layout =>
			layoutsetattr(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));
	"joingame" =>
		# joingame gameid clientid playerid name
		if (int hd tl tl tl toks != playerid)
			notify(hd tl tl tl tl toks + " has arrived");
	"leavegame" =>
		# leavegame gameid playerid name
		notify(hd tl tl tl toks + " has left");
	* =>
		sys->fprint(stderr, "cards: unknown update message '%s'\n", s);
	}
}

addcvsitem(item: ref Cvsitem)
{
	pick parent := objects[item.parentid] {
	Item =>
		pick p := parent.item {
		Frame =>
			p.subitems = (array[len p.subitems + 1] of ref Cvsitem)[0:] = p.subitems;
			p.subitems[len p.subitems - 1] = item;
		}
	}
}

makestack(id, parentid: int, vis: int): ref Object.Item
{
	o := ref Object.Item(
		id,
		ref Cvsitem.Stack(
			id,
			parentid,
			Blankhd,
			-1,			# style
			nil,			# cards
			Hiddenpos,	# pos
			(0, 0),		# delta
			ref Queue,
			0,			# maxcards
			"",			# title
			(vis & (1<<playerid)) != 0,
			0,			# n
			-1,			# ownerid
			ref Selection.Empty
		)
	);
	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.Item
{
	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);
	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.Item(
		id,
		ref Cvsitem.Widget(
			id,
			parentid,
			Blankhd,
			wtype,
			nil,		# entries
			"",		# cmd
			0		# width
		)
	);
	return o;
}

menutitleid := 0;		# hack to identify menu entries
makemenuentry(id, parentid: int, mtype: 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 Cvsitem.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);
	}
}

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 Cvsitem.Stack, attr: string, val: list of string)
{
	id := string stack.id;
	case attr {
	"maxcards" =>
		stack.maxcards = int hd val;
		needresize = 1;
	"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);
	* =>
		sys->fprint(stderr, "bad stack attr '%s'\n", attr);
	}
}

changesel(stack: ref Cvsitem.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 3 -outline red" +
					" -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 red -width 3 -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);
	}
}

widgetsetattr(b: ref Cvsitem.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;
	* =>
		sys->print("unknown attribute on button: %s\n", attr);
	}
}

layoutsetattr(o: ref Object.Layout, attr: string, val: list of string)
{
	case attr {
	"itemid" =>
		if (layout != nil)
			panic("cannot make two layout objects");
		o.cvsid = int hd val;
		layout = o;
		needrepack = 1;
	* =>
		sys->fprint(stderr, "unknown layout attr set (%s)\n", attr);
	}
}

setcvsid(item: ref Cvsitem, cvsid: int)
{
	if (item.h.cvsid != -1)
		panic("obj already has an item id");
	oitem := findcvsid(cvsid);
	if (oitem != nil) {
		if (tagof(oitem) != tagof(Cvsitem.Unknown))
			panic("duplicate item id");
		deletecvsid(oitem.h.cvsid);
	}
	item.h.cvsid = cvsid;
	if (oitem != nil) {
		# propagate values from referrer
		item.h.refcount = oitem.h.refcount;
		item.h.orientation = oitem.h.orientation;
	}
	addcvsid(cvsid, item);
	if (item.h.refcount > 0)
		needrepack = 1;
}

addcvsid(cvsid: int, item: ref Cvsitem)
{
	item.h.cvsid = cvsid;
	if (cvsid == -1)
		return;
	x := cvsid % len cvsitems;
	cvsitems[x] = item :: cvsitems[x];
}

# delete a canvas item from the id table
deletecvsid(cvsid: int)
{
	if (cvsid == -1)
		return;
	x := cvsid % len cvsitems;
	nl: list of ref Cvsitem;
	for (ll := cvsitems[x]; ll != nil; ll = tl ll)
		if ((hd ll).h.cvsid != cvsid)
			nl = hd ll :: nl;
	cvsitems[x] = nl;
}

findcvsid(cvsid: int): ref Cvsitem
{
	if (cvsid == -1)
		return nil;
	for (ll := cvsitems[cvsid % len cvsitems]; ll != nil; ll = tl ll)
		if ((hd ll).h.cvsid == cvsid)
			return hd ll;
	return nil;
}

playersetattr(p: ref Object.Player, 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] {
				Item =>
					pick item := o.item {
					Stack =>
						if (item.ownerid == p.cid)
							changesel(item, item.sel);
					}
				}
			}
		}
	"name" =>
		p.name = hd val;
	"id" =>
		p.cid = int hd val;
	"status" =>
		if (p == me)
			cmd(win, ".status configure -text '" + join(val));
	* =>
		sys->print("unknown attribute on player: %s\n", attr);
	}
}

itemsetattr(item: ref Cvsitem, attr: string, val: list of string)
{
	case attr {
	"opts" =>
		# orientation opts
		case hd val {
		"up" =>
			item.h.orientation = oUP;
		"down" =>
			item.h.orientation = oDOWN;
		"left" =>
			item.h.orientation = oLEFT;
		"right" =>
			item.h.orientation = oRIGHT;
		* =>
			sys->print("unknown orientation '%s'\n", hd val);
		}
		item.h.packopts = join(tl val);
		return;
	"cvsid" =>
		setcvsid(item, int hd val);
		return;
	}

	pick it := item {
	Widget =>
		widgetsetattr(it, attr, val);
	Stack =>
		stacksetattr(it, attr, val);
	Frame =>
		framesetattr(it, attr, val);
	Ref =>
		refsetattr(it, attr, val);
	* =>
		sys->fprint(stderr, "unknown item type (tag %d)\n", tagof(item));
	}
}

refsetattr(refitem: ref Cvsitem.Ref, attr: string, val: list of string)
{
	case attr {
	"cvsid" =>
		if (refitem.refid != -1)
			findcvsid(refitem.refid).h.refcount--;
		refid := int hd val;
		item := findcvsid(refid);
		if (item == nil) {
			addcvsid(refid, ref Cvsitem.Unknown(-1, -1, Blankhd));
		} else {
			if (item.h.refcount > 0)
				panic(sys->sprint(
					"more than one reference to id %d (refid %d, tag %d)",
					item.id, refid, tagof(item)));
			needrepack = 1;
		}
		item.h.refcount++;
	* =>
		sys->fprint(stderr, "unknown attribute set on cvsitem.ref (%s)\n", attr);
	}
}

framesetattr(frame: ref Cvsitem.Frame, attr: string, val: list of string)
{
	sys->fprint(stderr, "unknown attr on frame: %s\n", attr);
}

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 Cvsitem.Stack
{
	obj := objects[id];
	if (obj == nil)
		panic("nil stack object");
	pick o := obj {
	Item =>
		pick item := o.item {
		Stack =>
			return item;
		}
	}
	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 Cvsitem.Stack)
{
	while (!stk.animq.isempty())
		animterminated(<-animfinishedch);
}

transfer(src: ref Cvsitem.Stack, r: Range, dst: ref Cvsitem.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);
}

itemneedsrepack(obj: ref Cvsitem)
{
	if (!obj.h.needrepack) {
		obj.h.needrepack = 1;
		repackitems = obj :: repackitems;
	}
}

repackobj(obj: ref Cvsitem)
{
	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);
		}
		if (tagof(o.sel) == tagof(Selection.XRange))
			cmd(win, ".c raise s" + string o.id);
	}
	obj.h.needrepack = 0;
}

cardrect(stack: ref Cvsitem.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()
{
	needrepack = 0;
	if (layout == nil)
		return;
	if (packwin == nil) {
		# use an unmapped tk window to do our packing arrangements
		packwin = tk->toplevel(drawctxt.screen, "-bd 0");
		cmd(packwin, ". unmap");
		cmd(packwin, ". configure -x 0 -y 0");
	}
	cmd(packwin, "destroy " + cmd(packwin, "pack slaves ."));
	packitems = nil;
	if ((item := findcvsid(layout.cvsid)) != nil)
		packit(item, ".0");
	needresize = 1;
}

# make the frames for the objects to be laid out, in the offscreen window.
packit(item: ref Cvsitem, f: string)
{
	cmd(packwin, "frame " + f);
	cmd(packwin, "pack " + f + " " + item.h.packopts);
	pick it := item {
	Ref =>
		item = findcvsid(it.refid);
	}
	pick it := item {
	Frame =>
		for (i := 0; i < len it.subitems; i++)
			packit(it.subitems[i], f + "." + string i);
	Ref =>
		panic("cannot have a ref to a ref");
	}
	packitems = item :: packitems;
	item.h.w = f;
}

resizeall()
{
	needresize = 0;
	if (packitems == nil)
		return;
	cmd(packwin, "pack propagate . 1");
	cmd(packwin, ". configure -width 0 -height 0");	# make sure propagation works.
	for (sl := packitems; sl != nil; sl = tl sl)
		sizeitem(hd sl);

	csz := actsize(packwin, ".");
	sz := actsize(win, ".cf");
	scrollwidth := int cmd(win, ".cf.vert cget -width") + int cmd(win, ".cf.vert cget -bd") * 2;
	needhoriz := needvert := 0;
	if (csz.x > sz.x || csz.y > sz.y) {
		if (csz.x > sz.x) {
			sz.y -= scrollwidth;
			needhoriz = 1;
		}
		if (csz.y > sz.y) {
			sz.x -= scrollwidth;
			needvert = 1;
		}
		if (csz.x > sz.x && !needhoriz) {
			sz.y -= scrollwidth;
			needhoriz = 1;
		}
	}
	if (needhoriz != horizscrollbar || needvert != vertscrollbar) {
		cmd(win, "pack forget .cf.horiz .cf.vert .c");
		if (needhoriz)
			cmd(win, "pack .cf.horiz -side bottom -fill x");
		if (needvert)
			cmd(win, "pack .cf.vert -side left -fill y");
		cmd(win, "pack .c -in .cf -side top -fill both -expand 1");
		if (needhoriz != horizscrollbar)
			cmd(win, ".c xview moveto 0");
		if (needvert != vertscrollbar)
			cmd(win, ".c yview moveto 0");
		(horizscrollbar, vertscrollbar) = (needhoriz, needvert);
	}
	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);
			csz.x = sz.x;
		}
		if (sz.y > csz.y) {
			cmd(packwin, ". configure -height " + string sz.y);
			csz.y = sz.y;
		}
	}
	cmd(win, ".c configure -width " + string csz.x + " -height " + string csz.y);
	for (sl = packitems; sl != nil; sl = tl sl) {
		obj := hd sl;
		r := actrect(packwin, obj.h.w);
		positionitem(obj, r);
	}
}

BORDER: con 6;

# work out the size of an object to be laid out.
sizeitem(item: ref Cvsitem)
{
	w := item.h.w;
	pick o := item {
	Stack =>
		delta := Point(0, 0);
		case o.style {
		styDISPLAY =>
			case o.h.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, 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.h.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.h.size.x = int cmd(win, w + " cget -width");
		o.h.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.h.size));
	Frame =>
		w = nil;		# let size propagate outwards
	}
	if (w != nil)
		cmd(packwin, w + " configure -width " + string item.h.size.x +
			" -height " + string item.h.size.y);
}

# set a laid-out object's position on the canvas, given
# its allocated rectangle, r.
positionitem(item: ref Cvsitem, r: Rect)
{
	pick o := item {
	Stack =>
#		sys->print("positioning stack %d, r %s\n", o.id, r2s(r));
		delta := o.delta;
		sz := o.h.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, 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))));
		itemneedsrepack(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 Cvsitem.Stack, r: Range, dst: ref Cvsitem.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 Cvsitem.Stack, r: Range): array of ref Object.Card
{
	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;
	itemneedsrepack(src);		# XXX not necessary if moving from top?
	return cards;
}

insertcards(dst: ref Cvsitem.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);
	itemneedsrepack(dst);		# XXX not necessary if adding to top?
}

destroy(obj: ref Object)
{
	if (obj.id >= 0)
		objects[obj.id] = nil;
	id := string obj.id;
	pick o := obj {
	Item =>
		if (o.item.h.refcount > 0) {
			needrepack = 1;
			deletecvsid(o.item.h.cvsid);
			addcvsid(o.item.h.cvsid, ref Cvsitem.Unknown(-1, -1, Blankhd));
		}
		pick item := o.item {
		Widget =>
			cmd(win, ".c delete r" + id);
			w := ".buts." + id;
			cmd(win, "destroy " + w);
		Stack =>
			completeanim(item);
			cmd(win, ".c delete r" + id + " s" + id);
			if (item.title != nil)
				cmd(win, ".c delete t" + id);
			cmd(win, ".c delete c" + id);		# any remaining "fake" cards
		Frame =>
			cmd(win, ".c delete r" + id);
		Ref =>
			if ((refitem := findcvsid(item.refid)) != nil)
				positionitem(refitem,
					Rect((0, 0), refitem.h.size).addpt(Hiddenpos));
		}
	Card =>
		cmd(win, ".c delete i" + id);
	Button =>
		cmd(win, "destroy .buts." + string o.id);
	Player =>
		if (o.cid != -1) {
			# XXX remove player from players hash.
		}
	}
}

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;
	}
}

# 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));
}

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");
	notifypid = -1;
}

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): (int, Point)
{
	size := openimage("@" + dir + "/0.bit", "c0");
	if (size.x == 0)
		return (0, (0, 0));
	i := 1;
	for (;;) {
		nsize := openimage("@" + dir + "/" + string i + ".bit", "c" + string i);
		if (nsize.x == 0)
			break;
		if (!nsize.eq(size))
			sys->fprint(stderr, "warning: inconsistent image size in %s/%d.bit, " +
				"[%d %d] vs [%d %d]\n", dir, i, size.x, size.y, nsize.x, nsize.y);
		i++;
	}
	return (i, size);
}

panic(s: string)
{
	sys->fprint(stderr, "cards: panic: %s\n", s);
	sys->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);
		sys->raise("panic");
	}
	return e;
}

newanimation(src: ref Cvsitem.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 Cvsitem.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)
{
	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 := sys->millisec();
		dt := int (mag / SPEED);
		t := 0;
		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);
			cmd(win, "update");
			currpt = p;
			yield();
			t = sys->millisec() - t0;
		}
	}
	a.waitch <-= a;
}

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;
	bd := int cmd(win, w + " cget -bd");
	r.min.x = int cmd(win, w + " cget -actx");
	r.min.y = int cmd(win, w + " cget -acty");
	r.max.x = r.min.x + int cmd(win, w + " cget -actwidth") + 2 * bd;
	r.max.y = r.min.y + int cmd(win, w + " cget -actheight") + 2 * bd;
	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;
}