20060303a

13 files changed, 1904 insertions, 0 deletions

diff --git a/appl/spree/lib/allow.b b/appl/spree/lib/allow.b
new file mode 100644
index 00000000..ef088b08
--- /dev/null
+++ b/appl/spree/lib/allow.b
@@ -0,0 +1,194 @@
+implement Allow;
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "sets.m";
+	sets: Sets;
+	Set, set, None: import sets;
+include "../spree.m";
+	spree: Spree;
+	Attributes, Range, Object, Clique, Member, rand: import spree;
+include "allow.m";
+
+Action: adt {
+	tag:		int;
+	member:	ref Member;
+	action:	string;
+};
+
+actions: list of Action;
+clique: ref Clique;
+
+init(srvmod: Spree, g: ref Clique)
+{
+	sys = load Sys Sys->PATH;
+	sets = load Sets Sets->PATH;
+	(clique, spree) = (g, srvmod);
+}
+
+ILLEGALNAME: con "/";	# illegal char in member names, ahem.
+archive(archiveobj: ref Object)
+{
+	i := 0;
+	for (al := actions; al != nil; al = tl al) {
+		a := hd al;
+		pname: string;
+		if (a.member != nil)
+			pname = a.member.name;
+		else
+			pname = ILLEGALNAME;
+		archiveobj.setattr(
+			"allow" + string i++,
+			sys->sprint("%d %s %s", a.tag, pname, a.action),
+			None
+		);
+	}
+}
+
+unarchive(archiveobj: ref Object)
+{
+	for (i := 0; (s := archiveobj.getattr("allow" + string i)) != nil; i++) {
+		(n, toks) := sys->tokenize(s, " ");
+		p: ref Member = nil;
+		if (hd tl toks != ILLEGALNAME) {
+			# if the member is no longer around, ignore the action. XXX do we still need to do this?
+			if ((p = clique.membernamed(hd tl toks)) == nil)
+				continue;
+		}
+		sys->print("allow: adding action %d, %ux, %s\n", int hd toks, p, concat(tl tl toks));
+		actions = Action(int hd toks, p, concat(tl tl toks)) :: actions;
+	}
+}
+
+add(tag: int, member: ref Member, action: string)
+{
+#	sys->print("allow: add %d, member %ux, action: %s\n", tag, member, action);
+	actions = (tag, member, action) :: actions;
+}
+
+del(tag: int, member: ref Member)
+{
+#	sys->print("allow: del %d\n", tag);
+	na: list of Action;
+	for (a := actions; a != nil; a = tl a) {
+		action := hd a;
+		if (action.tag == tag && (member == nil || action.member == member))
+			continue;
+		na = action :: na;
+	}
+	actions = na;
+}
+
+action(member: ref Member, cmd: string): (string, int, list of string)
+{
+	for (al := actions; al != nil; al = tl al) {
+		a := hd al;
+		if (a.member == nil || a.member == member) {
+			(e, v) := match(member, a.action, cmd);
+			if (e != nil || v != nil)
+				return (e, a.tag, v);
+		}
+	}
+	return ("you can't do that", -1, nil);
+}
+
+match(member: ref Member, pat, action: string): (string, list of string)
+{
+#	sys->print("allow: matching pat: '%s' against action '%s'\n", pat, action);
+	toks: list of string;
+	na := len action;
+	if (na > 0 && action[na - 1] == '\n')
+		na--;
+
+	(i, j) := (0, 0);
+	for (;;) {
+		for (; i < len pat; i++)
+			if (pat[i] != ' ')
+				break;
+		for (; j < na; j++)
+			if (action[j] != ' ')
+				break;
+		for (i1 := i; i1 < len pat; i1++)
+			if (pat[i1] == ' ')
+				break;
+		for (j1 := j; j1 < na; j1++)
+			if (action[j1] == ' ')
+				break;
+		if (i == i1) {
+			if (j == j1)
+				break;
+			return (nil, nil);
+		}
+		if (j == j1) {
+			if (pat == "&")
+				break;
+			return (nil, nil);
+		}
+		pw := pat[i : i1];
+		w := action[j : j1];
+		case pw[0] {
+		'*' =>
+			toks = w :: toks;
+		'&' =>
+			toks = w :: toks;
+			pat = "&";
+			i1 = 0;
+		'%' =>
+			(ok, nw) := checkformat(member, pw[1], w);
+			if (!ok)
+				return ("invalid field value", nil);
+			toks = nw :: toks;
+		* =>
+			if (w != pw)
+				return (nil, nil);
+			toks = w :: toks;
+		}
+		(i, j) = (i1, j1);
+	}
+	return (nil, revs(toks));
+}
+
+revs(l: list of string): list of string
+{
+	m: list of string;
+	for (; l != nil; l = tl l)
+		m = hd l :: m;
+	return m;
+}
+
+checkformat(p: ref Member, fmt: int, w: string): (int, string)
+{
+	case fmt {
+	'o' =>
+		# object id
+		if (isnum(w) && (o := p.obj(int w)) != nil)
+			return (1, string o.id);
+	'd' =>
+		# integer
+		if (isnum(w))
+			return (1, w);
+	'p' =>
+		# member id
+		if (isnum(w) && (member := clique.member(int w)) != nil)
+			return (1, w);
+	}
+	return (0, nil);
+}
+
+isnum(w: string): int
+{
+	# XXX lazy for the time being...
+	if (w != nil && ((w[0] >= '0' && w[0] <= '9') || w[0] == '-'))
+		return 1;
+	return 0;
+}
+
+concat(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;
+}
diff --git a/appl/spree/lib/allow.m b/appl/spree/lib/allow.m
new file mode 100644
index 00000000..98882091
--- /dev/null
+++ b/appl/spree/lib/allow.m
@@ -0,0 +1,9 @@
+Allow: module {
+	PATH:	con "/dis/spree/lib/allow.dis";
+	init:		fn(srvmod: Spree, g: ref Spree->Clique);
+	add:		fn(tag: int, member: ref Spree->Member, action: string);
+	del:		fn(tag: int, member: ref Spree->Member);
+	action:	fn(member: ref Spree->Member, cmd: string): (string, int, list of string);
+	archive:	fn(archiveobj: ref Object);
+	unarchive: fn(archiveobj: ref Object);
+};
diff --git a/appl/spree/lib/base64.b b/appl/spree/lib/base64.b
new file mode 100644
index 00000000..c8381467
--- /dev/null
+++ b/appl/spree/lib/base64.b
@@ -0,0 +1,72 @@
+implement Base64;
+include "base64.m";
+
+PADCH: con '=';
+encode(b: array of byte): string
+{
+	chmap := "ABCDEFGHIJKLMNOPQRSTUVWXYZ" +
+			"abcdefghijklmnopqrstuvwxyz0123456789+/";
+	r := "";
+	blen := len b;
+	full := (blen + 2)/ 3;
+	rplen := (4*blen + 2) / 3;
+	ip := 0;
+	rp := 0;
+	for (i:=0; i<full; i++) {
+		word := 0;
+		for (j:=2; j>=0; j--)
+			if (ip < blen)
+				word = word | int b[ip++] << 8*j;
+		for (l:=3; l>=0; l--)
+			if (rp < rplen)
+				r[rp++] = chmap[(word >> (6*l)) & 16r3f];
+			else
+				r[rp++] = PADCH;
+	}
+	return r;
+}
+
+# Decode a base 64 string to a byte stream
+# Must be a multiple of 4 characters in length
+decode(s: string): array of byte
+{
+
+	tch: int;
+	slen := len s;
+	rlen := (3*slen+3)/4;
+	if (slen >= 4 && s[slen-1] == PADCH)
+		rlen--;
+	if (slen >= 4 && s[slen-2] == PADCH)
+		rlen--;
+	r := array[rlen] of byte;
+	full := slen / 4;
+	sp := 0;
+	rp := 0;
+	for (i:=0; i<full; i++) {
+		word := 0; 
+		for (j:=0; j<4; j++) {
+			ch := s[sp++];
+			case ch {
+			'A' to 'Z' =>
+				tch = ch - 'A';
+			'a' to 'z' =>
+				tch = ch - 'a' + 26;
+			'0' to '9' =>
+				tch = ch - '0' + 52;
+			'+' =>
+				tch = 62;
+			'/' =>
+				tch = 63;
+			* =>
+				tch = 0;
+			}
+			word = (word << 6) | tch;
+		}
+		for (l:=2; l>=0; l--)
+			if (rp < rlen)
+				r[rp++] = byte( (word >> 8*l) & 16rff);
+
+	}
+	return r;
+}
+
diff --git a/appl/spree/lib/base64.m b/appl/spree/lib/base64.m
new file mode 100644
index 00000000..1325cae2
--- /dev/null
+++ b/appl/spree/lib/base64.m
@@ -0,0 +1,5 @@
+Base64: module {
+	PATH : con "/dis/spree/lib/base64.dis";
+	encode : fn(b : array of byte) : string;
+	decode : fn(s : string) : array of byte;
+};
diff --git a/appl/spree/lib/cardlib.b b/appl/spree/lib/cardlib.b
new file mode 100644
index 00000000..67c4918b
--- /dev/null
+++ b/appl/spree/lib/cardlib.b
@@ -0,0 +1,917 @@
+implement Cardlib;
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "sets.m";
+	sets: Sets;
+	Set, set, A, B, All, None: import sets;
+include "../spree.m";
+	spree: Spree;
+	Attributes, Range, Object, Clique, Member, rand: import spree;
+include "objstore.m";
+	objstore: Objstore;
+include "cardlib.m";
+
+MAXPLAYERS: con 4;
+
+Layobject: adt {
+	lay:		ref Object;
+	name:	string;
+	packopts:		int;
+	pick {
+	Obj =>
+		obj:		ref Object;		# nil if it's a frame
+	Frame =>
+		facing:	int;				# only valid if for frames
+	}
+};
+
+clique:	ref Clique;
+cmembers: array of ref Cmember;
+cpids := array[8] of list of ref Cmember;
+
+# XXX first string is unnecessary as it's held in the Layobject anyway?
+layouts := array[17] of list of (string, ref Layout, ref Layobject);
+maxlayid := 1;
+cmemberid := 1;
+
+archiveobjs: array of list of (string, ref Object);
+
+defaultrank := array[13] of {12, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11};
+defaultsuitrank := array[] of {CLUBS => 0, DIAMONDS => 1, HEARTS => 2, SPADES => 3};
+
+table := array[] of {
+	0 =>	array[] of {
+		(-1, dTOP|EXPAND, dBOTTOM, dTOP),
+	},
+	1 => array [] of {
+		(0, dBOTTOM|FILLX, dBOTTOM, dTOP),
+		(-1, dTOP|EXPAND, dBOTTOM, dTOP),
+	},
+	2 => array[] of {
+		(0, dBOTTOM|FILLX, dBOTTOM, dTOP),
+		(1, dTOP|FILLX, dTOP, dBOTTOM),
+		(-1, dTOP|EXPAND, dBOTTOM, dTOP)
+	},
+	3 => array[] of {
+		(2, dRIGHT|FILLY, dRIGHT, dLEFT),
+		(0, dBOTTOM|FILLX, dBOTTOM, dTOP),
+		(1, dTOP|FILLX, dTOP, dBOTTOM),
+		(-1, dRIGHT|EXPAND, dBOTTOM, dTOP)
+	},
+	4 => array[] of {
+		(1, dLEFT|FILLY, dLEFT, dRIGHT),
+		(3, dRIGHT|FILLY, dRIGHT, dLEFT),
+		(0, dBOTTOM|FILLX, dBOTTOM, dTOP),
+		(2, dTOP|FILLX, dTOP, dBOTTOM),
+		(-1, dRIGHT|EXPAND, dBOTTOM, dTOP)
+	},
+};
+
+
+init(mod: Spree, g: ref Clique)
+{
+	sys = load Sys Sys->PATH;
+	sets = load Sets Sets->PATH;
+	if (sets == nil)
+		panic(sys->sprint("cannot load %s: %r", Sets->PATH));
+	objstore = load Objstore Objstore->PATH;
+	if (objstore == nil)
+		panic(sys->sprint("cannot load %s: %r", Objstore->PATH));
+	objstore->init(mod, g);
+	clique = g;
+	spree = mod;
+}
+
+archive(): ref Object
+{
+	for (i := 0; i < len cmembers; i++) {
+		cp := cmembers[i];
+		setarchivename(cp.obj, "member" + string i);
+		setarchivename(cp.layout.lay, "layout" + string i);
+		sel := cp.sel;
+		if (sel.stack != nil)
+			setarchivename(sel.stack, "sel" + string i);
+	}
+	for (i = 0; i < len layouts; i++) {
+		for (ll := layouts[i]; ll != nil; ll = tl ll) {
+			(name, lay, layobj) := hd ll;
+			if (name != nil)
+				layobj.lay.setattr("layname", name, None);
+			pick l := layobj {
+			Frame =>
+				l.lay.setattr("facing", sides[l.facing], None);
+			Obj =>
+				setarchivename(l.obj, "layid" + l.obj.getattr("layid"));
+			}
+		}
+	}
+	# XXX should archive layouts that aren't particular to a member.
+	archiveobj := clique.newobject(nil, None, "archive");
+	setarchivename(archiveobj, "archive");
+	archiveobj.setattr("maxlayid", string maxlayid, None);
+	archiveobj.setattr("cmemberid", string cmemberid, None);
+	return archiveobj;
+}
+
+setarchivename(o: ref Object, name: string)
+{
+	objstore->setname(o, name);
+}
+
+getarchiveobj(name: string): ref Object
+{
+	return objstore->get(name);
+}
+
+archivearray(a: array of ref Object, name: string)
+{
+	for (i := 0; i < len a; i++)
+		objstore->setname(a[i], name + string i);
+}
+
+getarchivearray(name: string): array of ref Object
+{
+	l: list of ref Object;
+	for (i := 0; ; i++) {
+		o := objstore->get(name + string i);
+		if (o == nil)
+			break;
+		l = o :: l;
+	}
+	a := array[i] of ref Object;
+	for (; l != nil; l = tl l)
+		a[--i] = hd l;
+	return a;
+}
+
+unarchive(): ref Object
+{
+	objstore->unarchive();
+	archiveobj := getarchiveobj("archive");
+	cpl: list of ref Cmember;
+	for (i := 0; (o := getarchiveobj("member" + string i)) != nil; i++) {
+		cp := ref Cmember(
+			i,
+			int o.getattr("id"),
+			clique.membernamed(o.getattr("name")),
+			o,
+			ref Layout(getarchiveobj("layout" + string i)),
+			ref Selection(getarchiveobj("sel" + string i), -1, 1, (0, 0), nil)
+		);
+		cp.sel.ownerid = cp.id;
+		sel := cp.sel;
+		if (sel.stack != nil && (selstr := sel.stack.getattr("sel")) != nil) {
+			(n, val) := sys->tokenize(selstr, " ");
+			if (tl val != nil && hd tl val == "-")
+				(sel.r.start, sel.r.end) = (int hd val, int hd tl tl val);
+			else {
+				idxl: list of int;
+				sel.isrange = 0;
+				for (; val != nil; val = tl val)
+					idxl = int hd val :: idxl;
+				sel.idxl = idxl;
+			}
+		}
+		lay := cp.layout.lay;
+		# there should be exactly one child, of type "layframe"
+		if (len lay.children != 1 || lay.children[0].objtype != "layframe")
+			panic("invalid layout");
+		x := strhash(nil, len layouts);
+		layouts[x] = (nil, cp.layout, obj2layobj(lay.children[0])) :: layouts[x];
+		unarchivelayoutobj(cp.layout, lay.children[0]);
+		cpl = cp :: cpl;
+	}
+	cmembers = array[len cpl] of ref Cmember;
+	for (; cpl != nil; cpl = tl cpl) {
+		cp := hd cpl;
+		cmembers[cp.ord] = cp;
+		idx := cp.id % len cpids;
+		cpids[idx] = cp :: cpids[idx];
+	}
+		
+	maxlayid = int archiveobj.getattr("maxlayid");
+	cmemberid = int archiveobj.getattr("cmemberid");
+	return archiveobj;
+}
+
+unarchivelayoutobj(layout: ref Layout, o: ref Object)
+{
+	for (i := 0; i < len o.children; i++) {
+		child := o.children[i];
+		layobj := obj2layobj(child);
+		if (layobj.name != nil) {
+			x := strhash(layobj.name, len layouts);
+			layouts[x] = (layobj.name, layout, layobj) :: layouts[x];
+		}
+		if (tagof(layobj) == tagof(Layobject.Frame))
+			unarchivelayoutobj(layout, child);
+	}
+}
+
+obj2layobj(o: ref Object): ref Layobject
+{
+	case o.objtype {
+	"layframe" =>
+		return ref Layobject.Frame(
+			o,
+			o.getattr("layname"),
+			s2packopts(o.getattr("opts")),
+			searchopt(sides, o.getattr("facing"))
+		);
+	"layobj" =>
+		return ref Layobject.Obj(
+			o,
+			o.getattr("layname"),
+			s2packopts(o.getattr("opts")),
+			getarchiveobj("layid" + o.getattr("layid"))
+		);
+	* =>
+		panic("invalid layobject found, of type '" + o.objtype + "'");
+		return nil;
+	}
+}
+
+Cmember.join(member: ref Member, ord: int): ref Cmember
+{
+	cmembers = (array[len cmembers + 1] of ref Cmember)[0:] = cmembers;
+	if (ord == -1)
+		ord = len cmembers - 1;
+	else {
+		cmembers[ord + 1:] = cmembers[ord:len cmembers - 1];
+		for (i := ord + 1; i < len cmembers; i++)
+			cmembers[i].ord = i;
+	}
+	cp := cmembers[ord] = ref Cmember(ord, cmemberid++, member, nil, nil, nil);
+	cp.obj = clique.newobject(nil, All, "member");
+	cp.obj.setattr("id", string cp.id, All);
+	cp.obj.setattr("name", member.name, All);
+	cp.obj.setattr("you", string cp.id, None.add(member.id));
+	cp.obj.setattr("cliquetitle", clique.fname, All);
+	cp.layout = newlayout(cp.obj, None.add(member.id));
+	cp.sel = ref Selection(nil, cp.id, 1, (0, 0), nil);
+
+	idx := cp.id % len cpids;
+	cpids[idx] = cp :: cpids[idx];
+	return cp;
+}
+
+Cmember.find(p: ref Member): ref Cmember
+{
+	id := p.id;
+	for (i := 0; i < len cmembers; i++)
+		if (cmembers[i].p.id == id)
+			return cmembers[i];
+	return nil;
+}
+
+Cmember.index(ord: int): ref Cmember
+{
+	if (ord < 0 || ord >= len cmembers)
+		return nil;
+	return cmembers[ord];
+}
+
+Cmember.next(cp: self ref Cmember, fwd: int): ref Cmember
+{
+	if (!fwd)
+		return cp.prev(1);
+	x := cp.ord + 1;
+	if (x >= len cmembers)
+		x = 0;
+	return cmembers[x];
+}
+
+Cmember.prev(cp: self ref Cmember, fwd: int): ref Cmember
+{
+	if (!fwd)
+		return cp.next(1);
+	x := cp.ord - 1;
+	if (x < 0)
+		x = len cmembers - 1;
+	return cmembers[x];
+}
+	
+Cmember.leave(cp: self ref Cmember)
+{
+	ord := cp.ord;
+	cmembers[ord] = nil;
+	cmembers[ord:] = cmembers[ord + 1:];
+	cmembers[len cmembers - 1] = nil;
+	cmembers = cmembers[0:len cmembers - 1];
+	for (i := ord; i < len cmembers; i++)
+		cmembers[i].ord = i;
+	cp.obj.delete();
+	dellayout(cp.layout);
+	cp.layout = nil;
+	idx := cp.id % len cpids;
+	l: list of ref Cmember;
+	ll := cpids[idx];
+	for (; ll != nil; ll = tl ll)
+		if (hd ll != cp)
+			l = hd ll :: l;
+	cpids[idx] = l;
+	cp.ord = -1;
+}
+
+Cmember.findid(id: int): ref Cmember
+{
+	for (l := cpids[id % len cpids]; l != nil; l = tl l)
+		if ((hd l).id == id)
+			return hd l;
+	return nil;
+}
+
+newstack(parent: ref Object, owner: ref Member, spec: Stackspec): ref Object
+{
+	vis := All;
+	if (spec.conceal) {
+		vis = None;
+		if (owner != nil)
+			vis = vis.add(owner.id);
+	}
+	o := clique.newobject(parent, vis, "stack");
+	o.setattr("maxcards", string spec.maxcards, All);
+	o.setattr("style", spec.style, All);
+
+	# XXX provide some means for this to contain the member's name?
+	o.setattr("title", spec.title, All);
+	return o;
+}
+
+makecard(deck: ref Object, c: Card, rear: string): ref Object
+{
+	card := clique.newobject(deck, None, "card");
+	card.setattr("face", string c.face, All);
+	vis := None;
+	if(c.face)
+		vis = All;
+	card.setattr("number", string (c.number * 4 + c.suit), vis);
+	if (rear != nil)
+		card.setattr("rear", rear, All);
+	return card;
+}
+
+makecards(deck: ref Object, r: Range, rear: string)
+{
+	for (i := r.start; i < r.end; i++)
+		for(suit := 0; suit < 4; suit++)
+			makecard(deck, (suit, i, 0), rear);
+}
+
+# deal n cards to each member, if possible.
+# deal in chunks for efficiency.
+# if accuracy is required (e.g. dealing from an unshuffled
+# deck containing known cards) then this'll have to change.
+deal(deck: ref Object, n: int, stacks: array of ref Object, first: int)
+{
+	ncards := len deck.children;
+	ord := 0;
+	permember := n;
+	leftover := 0;
+	if (n * len stacks > ncards) {
+		# if trying to deal more cards than we've got,
+		# deal all that we've got, distributing the remainder fairly.
+		permember = ncards / len stacks;
+		leftover = ncards % len stacks;
+	}
+	for (i := 0; i < len stacks; i++) {
+		n = permember;
+		if (leftover > 0) {
+			n++;
+			leftover--;
+		}
+		priv := stacks[(first + i) % len stacks];
+		deck.transfer((ncards - n, ncards), priv, len priv.children);
+		priv.setattr("n", string (int priv.getattr("n") + n), All);
+		# make cards visible to member
+		for (j := len priv.children - n; j < len priv.children; j++)
+			setface(priv.children[j], 1);
+
+		ncards -= n;
+	}
+}
+
+setface(card: ref Object, face: int)
+{
+	# XXX check parent stack style and if it's a pile,
+	# only expose a face up card at the top.
+
+	card.setattr("face", string face, All);
+	if (face)
+		card.setattrvisibility("number", All);
+	else
+		card.setattrvisibility("number", None);
+}
+
+nmembers(): int
+{
+	return len cmembers;
+}
+
+getcard(card: ref Object): Card
+{
+	n := int card.getattr("number");
+	(suit, num) := (n % 4, n / 4);
+	return Card(suit, num, int card.getattr("face"));
+}
+
+getcards(stack: ref Object): array of Card
+{
+	a := array[len stack.children] of Card;
+	for (i := 0; i < len a; i++)
+		a[i] = getcard(stack.children[i]);
+	return a;
+}
+
+discard(stk, pile: ref Object, facedown: int)
+{
+	n := len stk.children;
+	if (facedown)
+		for (i := 0; i < n; i++)
+			setface(stk.children[i], 0);
+	stk.transfer((0, n), pile, len pile.children);
+}
+
+# shuffle children into a random order.  first we make all the children
+# invisible (which will cause them to be deleted in the clients) then
+# shuffle to our heart's content, and make visible again...
+shuffle(o: ref Object)
+{
+	ovis := o.visibility;
+	o.setvisibility(None);
+	a := o.children;
+	n := len a;
+	for (i := 0; i < n; i++) {
+		j := i + rand(n - i);
+		(a[i], a[j]) = (a[j], a[i]);
+	}
+	o.setvisibility(ovis);
+}
+
+sort(o: ref Object, rank, suitrank: array of int)
+{
+	if (rank == nil)
+		rank = defaultrank;
+	if (suitrank == nil)
+		suitrank = defaultsuitrank;
+	ovis := o.visibility;
+	o.setvisibility(None);
+	cardmergesort(o.children, array[len o.children] of ref Object, rank, suitrank);
+	o.setvisibility(ovis);
+}
+
+cardcmp(a, b: ref Object, rank, suitrank: array of int): int
+{
+	c1 := getcard(a);
+	c2 := getcard(b);
+	if (suitrank[c1.suit] != suitrank[c2.suit])
+		return suitrank[c1.suit] - suitrank[c2.suit];
+	return rank[c1.number] - rank[c2.number];
+}
+
+cardmergesort(a, b: array of ref Object, rank, suitrank: array of int)
+{
+	r := len a;
+	if (r > 1) {
+		m := (r-1)/2 + 1;
+		cardmergesort(a[0:m], b[0:m], rank, suitrank);
+		cardmergesort(a[m:], b[m:], rank, suitrank);
+		b[0:] = a;
+		for ((i, j, k) := (0, m, 0); i < m && j < r; k++) {
+			if (cardcmp(b[i], b[j], rank, suitrank) > 0)
+				a[k] = b[j++];
+			else
+				a[k] = b[i++];
+		}
+		if (i < m)
+			a[k:] = b[i:m];
+		else if (j < r)
+			a[k:] = b[j:r];
+	}
+}
+
+# reverse and flip all cards in stack.
+flip(stack: ref Object)
+{
+	ovis := stack.visibility;
+	stack.setvisibility(None);
+	a := stack.children;
+	(n, m) := (len a, len a / 2);
+	for (i := 0; i < m; i++) {
+		j := n - i - 1;
+		(a[i], a[j]) = (a[j], a[i]);
+	}
+	for (i = 0; i < n; i++)
+		setface(a[i], !int a[i].getattr("face"));
+	stack.setvisibility(ovis);
+}
+
+selection(stack: ref Object): ref Selection
+{
+	if ((owner := stack.getattr("owner")) != nil &&
+			(cp := Cmember.findid(int owner)) != nil)
+		return cp.sel;
+	return nil;
+}
+
+Selection.set(sel: self ref Selection, stack: ref Object)
+{
+	if (stack == sel.stack)
+		return;
+	if (stack != nil) {
+		oldowner := stack.getattr("owner");
+		if (oldowner != nil) {
+			oldcp := Cmember.findid(int oldowner);
+			if (oldcp != nil)
+				oldcp.sel.set(nil);
+		}
+	}
+	if (sel.stack != nil)
+		sel.stack.setattr("owner", nil, All);
+	sel.stack = stack;
+	sel.isrange = 1;
+	sel.r = (0, 0);
+	sel.idxl = nil;
+	setsel(sel);
+}
+
+Selection.setexcl(sel: self ref Selection, stack: ref Object): int
+{
+	if (stack != nil && (oldowner := stack.getattr("owner")) != nil)
+		if ((cp := Cmember.findid(int oldowner)) != nil && !cp.sel.isempty())
+			return 0;
+	sel.set(stack);
+	return 1;
+}
+
+Selection.owner(sel: self ref Selection): ref Cmember
+{
+	return Cmember.findid(sel.ownerid);
+}
+
+Selection.setrange(sel: self ref Selection, r: Range)
+{
+	if (!sel.isrange) {
+		sel.idxl = nil;
+		sel.isrange = 1;
+	}
+	sel.r = r;
+	setsel(sel);
+}
+
+Selection.addindex(sel: self ref Selection, i: int)
+{
+	if (sel.isrange) {
+		sel.r = (0, 0);
+		sel.isrange = 0;
+	}
+	ll: list of int;
+	for (l := sel.idxl; l != nil; l = tl l) {
+		if (hd l >= i)
+			break;
+		ll = hd l :: ll;
+	}
+	if (l != nil && hd l == i)
+		return;
+	l = i :: l;
+	for (; ll != nil; ll = tl ll)
+		l = hd ll :: l;
+	sel.idxl = l;
+	setsel(sel);
+}
+
+Selection.delindex(sel: self ref Selection, i: int)
+{
+	if (sel.isrange) {
+		sys->print("cardlib: delindex from range-type selection\n");
+		return;
+	}
+	ll: list of int;
+	for (l := sel.idxl; l != nil; l = tl l) {
+		if (hd l == i) {
+			l = tl l;
+			break;
+		}
+		ll = hd l :: ll;
+	}
+	for (; ll != nil; ll = tl ll)
+		l = hd ll :: l;
+	sel.idxl = l;
+	setsel(sel);
+}
+
+Selection.isempty(sel: self ref Selection): int
+{
+	if (sel.stack == nil)
+		return 1;
+	if (sel.isrange)
+		return sel.r.start == sel.r.end;
+	return sel.idxl == nil;
+}
+
+Selection.isset(sel: self ref Selection, index: int): int
+{
+	if (sel.isrange)
+		return index >= sel.r.start && index < sel.r.end;
+	for (l := sel.idxl; l != nil; l = tl l)
+		if (hd l == index)
+			return 1;
+	return 0;
+}
+
+Selection.transfer(sel: self ref Selection, dst: ref Object, index: int)
+{
+	if (sel.isempty())
+		return;
+	src := sel.stack;
+	if (sel.isrange) {
+		r := sel.r;
+		sel.set(nil);
+		src.transfer(r, dst, index);
+	} else {
+		if (sel.stack == dst) {
+			sys->print("cardlib: cannot move multisel to same stack\n");
+			return;
+		}
+		xl := l := sel.idxl;
+		sel.set(nil);
+		rl: list of Range;
+		for (; l != nil; l = tl l) {
+			r := Range(hd l, hd l);
+			last := l;
+			# concatenate adjacent items, for efficiency.
+			for (l = tl l; l != nil; (last, l) = (l, tl l)) {
+				if (hd l != r.end + 1)
+					break;
+				r.end = hd l;
+			}
+			rl = (r.start, r.end + 1) :: rl;
+			l = last;
+		}
+		# do ranges in reverse, so that later ranges
+		# aren't affected by earlier ones.
+		if (index == -1)
+			index = len dst.children;
+		for (; rl != nil; rl = tl rl)
+			src.transfer(hd rl, dst, index);
+	}
+}
+
+setsel(sel: ref Selection)
+{
+	if (sel.stack == nil)
+		return;
+	s := "";
+	if (sel.isrange) {
+		if (sel.r.end > sel.r.start)
+			s = string sel.r.start + " - " + string sel.r.end;
+	} else {
+		if (sel.idxl != nil) {
+			s = string hd sel.idxl;
+			for (l := tl sel.idxl; l != nil; l = tl l)
+				s += " " + string hd l;
+		}
+	}
+	if (s != nil)
+		sel.stack.setattr("owner", string sel.owner().id, All);
+	else
+		sel.stack.setattr("owner", nil, All);
+	vis := None.add(sel.owner().p.id);
+	sel.stack.setattr("sel", s, vis);
+	sel.stack.setattrvisibility("sel", vis);
+}
+
+newlayout(parent: ref Object, vis: Set): ref Layout
+{
+	l := ref Layout(clique.newobject(parent, vis, "layout"));
+	x := strhash(nil, len layouts);
+	layobj := ref Layobject.Frame(nil, "", dTOP|EXPAND|FILLX|FILLY, dTOP);
+	layobj.lay = clique.newobject(l.lay, All, "layframe");
+	layobj.lay.setattr("opts", packopts2s(layobj.packopts), All);
+	layouts[x] = (nil, l, layobj) :: layouts[x];
+#	sys->print("[%d] => ('%s', %ux, %ux) (new layout)\n", x, "", l, layobj);
+	return l;
+}
+
+addlayframe(name, parent: string, layout: ref Layout, packopts: int, facing: int)
+{
+#	sys->print("addlayframe('%s', %ux, name: %s\n", parent, layout, name);
+	addlay(parent, layout, ref Layobject.Frame(nil, name, packopts, facing));
+}
+
+addlayobj(name, parent: string, layout: ref Layout, packopts: int, obj: ref Object)
+{
+#	sys->print("addlayobj('%s', %ux, name: %s, obj %d\n", parent, layout, name, obj.id);
+	addlay(parent, layout, ref Layobject.Obj(nil, name, packopts, obj));
+}
+
+addlay(parent: string, layout: ref Layout, layobj: ref Layobject)
+{
+	a := layouts;
+	name := layobj.name;
+	x := strhash(name, len a);
+	added := 0;
+	for (nl := a[strhash(parent, len a)]; nl != nil; nl = tl nl) {
+		(s, lay, parentlay) := hd nl;
+		if (s == parent && (layout == nil || layout == lay)) {
+			pick p := parentlay {
+			Obj =>
+				sys->fprint(sys->fildes(2),
+					"cardlib: cannot add layout to non-frame: %d\n", p.obj.id);
+			Frame =>
+				nlayobj := copylayobj(layobj);
+				nlayobj.packopts = packoptsfacing(nlayobj.packopts, p.facing);
+				o: ref Object;
+				pick lo := nlayobj {
+				Obj =>
+					o = clique.newobject(p.lay, All, "layobj");
+					id := lo.obj.getattr("layid");
+					if (id == nil) {
+						id = string maxlayid++;
+						lo.obj.setattr("layid", id, All);
+					}
+					o.setattr("layid", id, All);
+				Frame =>
+					o = clique.newobject(p.lay, All, "layframe");
+					lo.facing = (lo.facing + p.facing) % 4;
+				}
+				o.setattr("opts", packopts2s(nlayobj.packopts), All);
+				nlayobj.lay = o;
+				if (name != nil)
+					a[x] = (name, lay, nlayobj) :: a[x];
+				added++;
+			}
+		}
+	}
+	if (added == 0)
+		sys->print("no parent found, adding '%s', parent '%s', layout %ux\n",
+			layobj.name, parent, layout);
+#	sys->print("%d new entries\n", added);
+}
+
+maketable(parent: string)
+{
+	# make a table for all current members.
+	plcount := len cmembers;
+	packopts := table[plcount];
+	for (i := 0; i < plcount; i++) {
+		layout := cmembers[i].layout;
+		for (j := 0; j < len packopts; j++) {
+			(ord, outer, inner, facing) := packopts[j];
+			name := "public";
+			if (ord != -1)
+				name = "p" + string ((ord + i) % plcount);
+			addlayframe("@" + name, parent, layout, outer, dTOP);
+			addlayframe(name, "@" + name, layout, inner, facing);
+		}
+	}
+}
+
+dellay(name: string, layout: ref Layout)
+{
+	a := layouts;
+	x := strhash(name, len a);
+	rl: list of (string, ref Layout, ref Layobject);
+	for (nl := a[x]; nl != nil; nl = tl nl) {
+		(s, lay, layobj) := hd nl;
+		if (s != name || (layout != nil && layout != lay))
+			rl = hd nl :: rl;
+	}
+	a[x] = rl;
+}
+
+dellayout(layout: ref Layout)
+{
+	for (i := 0; i < len layouts; i++) {
+		ll: list of (string, ref Layout, ref Layobject);
+		for (nl := layouts[i]; nl != nil; nl = tl nl) {
+			(s, lay, layobj) := hd nl;
+			if (lay != layout)
+				ll = hd nl :: ll;
+		}
+		layouts[i] = ll;
+	}
+}
+
+copylayobj(obj: ref Layobject): ref Layobject
+{
+	pick o := obj {
+	Frame =>
+		return ref *o;
+	Obj =>
+		return ref *o;
+	}
+	return nil;
+}
+
+packoptsfacing(opts, facing: int): int
+{
+	if (facing == dTOP)
+		return opts;
+	nopts := 0;
+
+	# 4 directions
+	nopts |= (facing + (opts & dMASK)) % 4;
+
+	# 2 orientations
+	nopts |= ((facing + ((opts & oMASK) >> oSHIFT)) % 4) << oSHIFT;
+
+	# 8 anchorpoints (+ centre)
+	a := (opts & aMASK);
+	if (a != aCENTRE)
+		a = ((((a >> aSHIFT) - 1 + facing * 2) % 8) + 1) << aSHIFT;
+	nopts |= a;
+
+	# two fill options
+	if (facing % 2) {
+		if (opts & FILLX)
+			nopts |= FILLY;
+		if (opts & FILLY)
+			nopts |= FILLX;
+	} else
+		nopts |= (opts & (FILLX | FILLY));
+
+	nopts |= (opts & EXPAND);
+	return nopts;
+}
+
+# these arrays are dependent on the ordering of
+# the relevant constants defined in cardlib.m
+
+sides := array[] of {"top", "left", "bottom", "right"};
+anchors := array[] of {"centre", "n", "nw", "w", "sw", "s", "se", "e", "ne"};
+orientations := array[] of {"right", "up", "left", "down"};
+fills := array[] of {"none", "x", "y", "both"};
+
+packopts2s(opts: int): string
+{
+	s := orientations[(opts & oMASK) >> oSHIFT] +
+			" -side " + sides[opts & dMASK];
+	if ((opts & aMASK) != aCENTRE)
+		s += " -anchor " + anchors[(opts & aMASK) >> aSHIFT];
+	if (opts & EXPAND)
+		s += " -expand 1";
+	if (opts & (FILLX | FILLY))
+		s += " -fill " + fills[(opts & FILLMASK) >> FILLSHIFT];
+	return s;
+}
+
+searchopt(a: array of string, s: string): int
+{
+	for (i := 0; i < len a; i++)
+		if (a[i] == s)
+			return i;
+	panic("unknown pack option '" + s + "'");
+	return 0;
+}
+
+s2packopts(s: string): int
+{
+	(nil, toks) := sys->tokenize(s, " ");
+	if (toks == nil)
+		panic("invalid packopts: " + s);
+	p := searchopt(orientations, hd toks) << oSHIFT;
+	for (toks = tl toks; toks != nil; toks = tl tl toks) {
+		if (tl toks == nil)
+			panic("invalid packopts: " + s);
+		arg := hd tl toks;
+		case hd toks {
+		"-anchor" =>
+			p |= searchopt(anchors, arg) << aSHIFT;
+		"-fill" =>
+			p |= searchopt(fills, arg) << FILLSHIFT;
+		"-side" =>
+			p |= searchopt(sides, arg) << dSHIFT;
+		"-expand" =>
+			if (int hd tl toks)
+				p |= EXPAND;
+		* =>
+			panic("unknown pack option: " + hd toks);
+		}
+	}
+	return p;
+}
+
+panic(e: string)
+{
+	sys->fprint(sys->fildes(2), "cardlib panic: %s\n", e);
+	raise "panic";
+}
+
+assert(b: int, err: string)
+{
+	if (b == 0)
+		raise "parse:" + err;
+}
+
+# from Aho Hopcroft Ullman
+strhash(s: string, n: int): int
+{
+	h := 0;
+	m := len s;
+	for(i := 0; i<m; i++){
+		h = 65599 * h + s[i];
+	}
+	return (h & 16r7fffffff) % n;
+}
diff --git a/appl/spree/lib/cardlib.m b/appl/spree/lib/cardlib.m
new file mode 100644
index 00000000..94c05002
--- /dev/null
+++ b/appl/spree/lib/cardlib.m
@@ -0,0 +1,114 @@
+Cardlib: module {
+	PATH:		con "/dis/spree/lib/cardlib.dis";
+
+	Layout: adt {
+		lay:			ref Spree->Object;		# the actual layout object
+	};
+
+	Stackspec: adt {
+		style:	string;
+		maxcards:	int;
+		conceal:	int;
+		title:		string;
+	};
+
+	Card: adt {
+		suit:		int;
+		number:	int;
+		face:		int;
+	};
+
+	# a member currently playing
+	Cmember: adt {
+		ord:		int;
+		id:		int;
+		p:		ref Spree->Member;
+		obj:		ref Spree->Object;
+		layout:	ref Layout;
+		sel:		ref Selection;
+
+		join:		fn(p: ref Spree->Member, ord: int): ref Cmember;
+		index:	fn(ord: int): ref Cmember;
+		find:		fn(p: ref Spree->Member): ref Cmember;
+		findid:	fn(id: int): ref Cmember;
+		leave:	fn(cp: self ref Cmember);
+		next:		fn(cp: self ref Cmember, fwd: int): ref Cmember;
+		prev:		fn(cp: self ref Cmember, fwd: int): ref Cmember;
+	};
+
+	Selection: adt {
+		stack:	ref Spree->Object;
+		ownerid:	int;
+		isrange:	int;
+		r:		Range;
+		idxl:		list of int;
+
+		set:		fn(sel: self ref Selection, stack: ref Spree->Object);
+		setexcl:	fn(sel: self ref Selection, stack: ref Spree->Object): int;
+		setrange:	fn(sel: self ref Selection, r: Range);
+		addindex:	fn(sel: self ref Selection, i: int);
+		delindex:	fn(sel: self ref Selection, i: int);
+		isempty:	fn(sel: self ref Selection): int;
+		isset:		fn(sel: self ref Selection, index: int): int;
+		transfer:	fn(sel: self ref Selection, dst: ref Spree->Object, index: int);
+		owner:	fn(sel: self ref Selection): ref Cmember;
+	};
+
+	selection:	fn(stack: ref Spree->Object): ref Selection;
+
+	# pack and facing directions (clockwise by face direction)
+	dTOP, dLEFT, dBOTTOM, dRIGHT: con iota;
+	dMASK: con 7;
+	dSHIFT: con 0;
+	
+	# anchor positions
+	aSHIFT: con 4;
+	aMASK: con 16rf0;
+	aCENTRE, aUPPERCENTRE, aUPPERLEFT, aCENTRELEFT,
+		aLOWERLEFT, aLOWERCENTRE, aLOWERRIGHT,
+		aCENTRERIGHT, aUPPERRIGHT: con iota << aSHIFT;
+	
+	# orientations
+	oMASK: con 16rf00;
+	oSHIFT: con 8;
+	oRIGHT, oUP, oLEFT, oDOWN: con iota << oSHIFT;
+
+	EXPAND: con 16r1000;
+
+	FILLSHIFT: con 13;
+	FILLX, FILLY: con 1 << (FILLSHIFT + iota);
+	FILLMASK: con FILLX|FILLY;
+
+	CLUBS, DIAMONDS, HEARTS, SPADES: con iota;
+
+	init:			fn(spree: Spree, clique: ref Spree->Clique);
+
+	addlayframe:	fn(name: string, parent: string, layout: ref Layout, packopts: int, facing: int);
+	addlayobj:	fn(name: string, parent: string, layout: ref Layout, packopts: int, obj: ref Spree->Object);
+	dellay:		fn(name: string, layout: ref Layout);
+
+	newstack:		fn(parent: ref Spree->Object, p: ref Spree->Member, spec: Stackspec): ref Spree->Object;
+
+	archive:		fn(): ref Spree->Object;
+	unarchive:	fn(): ref Spree->Object;
+	setarchivename: fn(o: ref Spree->Object, name: string);
+	getarchiveobj:	fn(name: string): ref Spree->Object;
+	archivearray:	fn(a: array of ref Spree->Object, name: string);
+	getarchivearray: fn(name: string): array of ref Spree->Object;
+
+	newlayout:	fn(parent: ref Spree->Object, vis: Sets->Set): ref Layout;
+	makecards:	fn(stack: ref Spree->Object, r: Range, rear: string);
+	maketable:	fn(parent: string);
+	deal:			fn(stack: ref Spree->Object, n: int, stacks: array of ref Spree->Object, first: int);
+	shuffle:		fn(stack: ref Spree->Object);
+	sort:			fn(stack: ref Spree->Object, rank, suitrank: array of int);
+
+	getcard:		fn(card: ref Spree->Object): Card;
+	getcards:		fn(stack: ref Spree->Object): array of Card;
+	discard:		fn(stk, pile: ref Spree->Object, facedown: int);
+	setface:		fn(card: ref Spree->Object, face: int);
+
+	flip:			fn(stack: ref Spree->Object);
+
+	nmembers:		fn(): int;
+};
diff --git a/appl/spree/lib/commandline.b b/appl/spree/lib/commandline.b
new file mode 100644
index 00000000..8b60ab01
--- /dev/null
+++ b/appl/spree/lib/commandline.b
@@ -0,0 +1,191 @@
+implement Commandline;
+
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "tk.m";
+	tk: Tk;
+include "tkclient.m";
+	tkclient: Tkclient;
+include "commandline.m";
+
+Debug: con 0;
+
+nomodule(modpath: string)
+{
+	sys->fprint(stderr(), "fibs: couldn't load %s: %r\n", modpath);
+	raise "fail:bad module";
+}
+
+init()
+{	sys = load Sys Sys->PATH;
+
+	tk = load Tk Tk->PATH;
+	if (tk == nil) nomodule(Tk->PATH);
+
+	tkclient = load Tkclient Tkclient->PATH;
+	if (tkclient == nil) nomodule(Tkclient->PATH);
+	tkclient->init();
+}
+
+Cmdline.new(top: ref Tk->Toplevel, w, textopts: string): (ref Cmdline, chan of string)
+{
+	window_cfg := array[] of {
+		"frame " + w,
+		"scrollbar " + w + ".scroll -command {" + w + ".t yview}",
+		"text " + w + ".t -yscrollcommand {" + w + ".scroll set} " + textopts,
+		"pack " + w + ".scroll -side left -fill y",
+		"pack " + w + ".t -fill both -expand 1",
+	
+		"bind " + w + ".t <Key> {send evch k {%A}}",
+		"bind " + w + ".t <Control-d> {send evch k {%A}}",
+		"bind " + w + ".t <Control-u> {send evch k {%A}}",
+		"bind " + w + ".t <Control-w> {send evch k {%A}}",
+		"bind " + w + ".t <Control-h> {send evch k {%A}}",
+		# treat button 2 and button 3 the same so we're alright with a 2-button mouse
+		"bind " + w + ".t <ButtonPress-2> {send evch b %x %y}",
+		"bind " + w + ".t <ButtonPress-3> {send evch b %x %y}",
+		w + ".t mark set outpoint end",
+		w + ".t mark gravity outpoint left",
+		w + ".t mark set inpoint end",
+		w + ".t mark gravity inpoint left",
+	};
+	evch := chan of string;
+	tk->namechan(top, evch, "evch");
+
+	for (i := 0; i < len window_cfg; i++) {
+		e := cmd(top, window_cfg[i]);
+		if (e != nil && e[0] == '!')
+			break;
+	}
+
+	err := tk->cmd(top, "variable lasterror");
+	if (err != nil) {
+		sys->fprint(stderr(), "error in commandline config: %s\n", err);
+		raise "fail:commandline config error";
+	}
+	cmd(top, w + ".t mark set insert end;" + w + ".t see insert");
+	return (ref Cmdline(w, top), evch);
+}
+
+Cmdline.focus(cmdl: self ref Cmdline)
+{
+	cmd(cmdl.top, "focus " + cmdl.w + ".t");
+}
+
+Cmdline.event(cmdl: self ref Cmdline, e: string): list of string
+{
+	case e[0] {
+	'k' =>
+		return handle_key(cmdl, e[2:]);
+	'b' =>
+		;
+	}
+	return nil;
+}
+
+BS:		con 8;		# ^h backspace character
+BSW:		con 23;		# ^w bacspace word
+BSL:		con 21;		# ^u backspace line
+
+handle_key(cmdl: ref Cmdline, c: string): list of string
+{
+	(w, top) := (cmdl.w, cmdl.top);
+	# don't allow editing of the text before the inpoint.
+	if (int cmd(top, w + ".t compare insert < inpoint"))
+		return nil;
+	lines: list of string;
+	char := c[1];
+	if (char == '\\')
+		char = c[2];
+	case char {
+	* =>
+		cmd(top, w + ".t insert insert "+c+" {}");
+	'\n' =>
+		cmd(top, w + ".t insert insert "+c+" {}");
+		lines = sendinput(cmdl);
+	BSL or BSW or BS =>
+		delpoint: string;
+		case char {
+		BSL =>	delpoint = "{insert linestart}";
+		BSW =>	delpoint = "{insert -1char wordstart}";	# wordstart isn't ideal
+		BS  =>	delpoint = "{insert-1char}";
+		}
+		if (int cmd(top, w + ".t compare inpoint < " + delpoint))
+			cmd(top, w + ".t delete "+delpoint+" insert");
+		else
+			cmd(top, w + ".t delete inpoint insert");
+	}
+	cmd(top, w + ".t see insert;update");
+	return lines;
+}
+
+sendinput(cmdl: ref Cmdline): list of string
+{
+	(w, top) := (cmdl.w, cmdl.top);
+	# loop through all the lines that have been entered,
+	# processing each one in turn.
+	nl, lines: list of string;
+	for (;;) {
+		input: string;
+		input = cmd(top, w + ".t get inpoint end");
+		if (len input == 0)
+			break;
+		for (i := 0; i < len input; i++)
+			if (input[i] == '\n')
+				break;
+		if (i >= len input)
+			break;
+		cmd(top, w + ".t mark set outpoint inpoint+"+string (i+1)+"chars");
+		cmd(top, w + ".t mark set inpoint outpoint");
+		lines = input[0:i+1] :: lines;
+	}
+	for (; lines != nil; lines = tl lines)
+		nl = hd lines :: nl;
+	return nl;
+}
+
+add(cmdl: ref Cmdline, t: string, n: int)
+{
+	(w, top) := (cmdl.w, cmdl.top);
+	cmd(top, w + ".t insert outpoint " + t);
+	cmd(top, w + ".t mark set outpoint outpoint+"+string n+"chars");
+	cmd(top, w + ".t mark set inpoint outpoint");
+	cmd(top, w + ".t see insert");
+}
+
+Cmdline.tagaddtext(cmdl: self ref Cmdline, t: list of (string, string))
+{
+	txt := "";
+	n := 0;
+	for (; t != nil; t = tl t) {
+		(tags, s) := hd t;
+		txt += " " + tk->quote(s) + " {" + tags + "}";
+		n += len s;
+	}
+	add(cmdl, txt, n);
+}
+
+Cmdline.addtext(cmdl: self ref Cmdline, txt: string)
+{
+	if (Debug) sys->print("%s", txt);
+	add(cmdl, tk->quote(txt) + " {}" , len txt);
+}
+
+Cmdline.maketag(cmdl: self ref Cmdline, name, options: string)
+{
+	cmd(cmdl.top, cmdl.w + ".t tag configure " + name + " " + options);
+}
+
+stderr(): ref Sys->FD
+{
+	return sys->fildes(2);
+}
+
+cmd(top: ref Tk->Toplevel, s: string): string
+{
+	e := tk->cmd(top, s);
+	if (e != nil && e[0] == '!')
+		sys->fprint(stderr(), "cmd error on '%s': %s\n", s, e);
+	return e;
+}
diff --git a/appl/spree/lib/commandline.m b/appl/spree/lib/commandline.m
new file mode 100644
index 00000000..7fcfa965
--- /dev/null
+++ b/appl/spree/lib/commandline.m
@@ -0,0 +1,16 @@
+Commandline: module {
+	init:			fn();
+
+	PATH:		con "/dis/spree/lib/commandline.dis";
+	Cmdline: adt {
+		new:			fn(win: ref Tk->Toplevel, w, textopts: string): (ref Cmdline, chan of string);
+		event:		fn(cmdl: self ref Cmdline, e: string): list of string;
+		tagaddtext:	fn(cmdl: self ref Cmdline, t: list of (string, string));
+		addtext:		fn(cmdl: self ref Cmdline, txt: string);
+		focus:		fn(cmdl: self ref Cmdline);
+		maketag:		fn(cmdl: self ref Cmdline, name, options: string);
+
+		w: string;
+		top: ref Tk->Toplevel;
+	};
+};
diff --git a/appl/spree/lib/objstore.b b/appl/spree/lib/objstore.b
new file mode 100644
index 00000000..47d0b13d
--- /dev/null
+++ b/appl/spree/lib/objstore.b
@@ -0,0 +1,65 @@
+implement Objstore;
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "sets.m";
+	None: import Sets;
+include "../spree.m";
+	spree: Spree;
+	Object, Clique: import spree;
+include "objstore.m";
+
+clique: ref Clique;
+archiveobjs: array of list of (string, ref Object);
+
+init(mod: Spree, g: ref Clique)
+{
+	sys = load Sys Sys->PATH;
+	spree = mod;
+	clique = g;
+}
+
+unarchive()
+{
+	archiveobjs = array[27] of list of (string, ref Object);
+	for (i := 0; i < len clique.objects; i++) {
+		obj := clique.objects[i];
+		if (obj != nil && (nm := obj.getattr("§")) != nil) {
+			(n, toks) := sys->tokenize(nm, " ");
+			for (; toks != nil; toks = tl toks) {
+				x := strhash(hd toks, len archiveobjs);
+				archiveobjs[x] = (hd toks, obj) :: archiveobjs[x];
+			}
+			obj.setattr("§", nil, None);
+		}
+	}
+}
+
+setname(obj: ref Object, name: string)
+{
+	nm := obj.getattr("§");
+	if (nm != nil)
+		nm += " " + name;
+	else
+		nm = name;
+	obj.setattr("§", nm, None);
+}
+
+get(name: string): ref Object
+{
+	for (al := archiveobjs[strhash(name, len archiveobjs)]; al != nil; al = tl al)
+		if ((hd al).t0 == name)
+			return (hd al).t1;
+	return nil;
+}
+
+# from Aho Hopcroft Ullman
+strhash(s: string, n: int): int
+{
+	h := 0;
+	m := len s;
+	for(i := 0; i<m; i++){
+		h = 65599 * h + s[i];
+	}
+	return (h & 16r7fffffff) % n;
+}
diff --git a/appl/spree/lib/objstore.m b/appl/spree/lib/objstore.m
new file mode 100644
index 00000000..86aa33b5
--- /dev/null
+++ b/appl/spree/lib/objstore.m
@@ -0,0 +1,8 @@
+Objstore: module {
+	PATH: con "/dis/spree/lib/objstore.dis";
+
+	init:			fn(mod: Spree, g: ref Clique);
+	unarchive:	fn();
+	setname:		fn(o: ref Object, name: string);
+	get:			fn(name: string): ref Object;
+};
diff --git a/appl/spree/lib/testsets.b b/appl/spree/lib/testsets.b
new file mode 100644
index 00000000..2556838f
--- /dev/null
+++ b/appl/spree/lib/testsets.b
@@ -0,0 +1,152 @@
+implement Testsets;
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "rand.m";
+include "sets.m";		# "sets.m" or "sets32.m"
+	sets: Sets;
+	Set, set, A, B: import sets;
+
+BPW: con 32;
+SHIFT: con 5;
+MASK: con 31;
+
+Testsets: module {
+	init: fn(nil: ref Draw->Context, nil: list of string);
+};
+
+∅: Set;
+
+Testbig: con 1;
+
+init(ctxt: ref Draw->Context, argv: list of string)
+{
+	sys = load Sys Sys->PATH;
+	sets = load Sets Sets->PATH;
+	if (sets == nil) {
+		sys->print("cannot load %s: %r\n", Sets->PATH);
+		exit;
+	}
+	rand := load Rand Rand->PATH;
+	sets->init();
+
+	∅ = set();
+	s := set().addlist(1::2::3::4::nil);
+	addit(s);
+	sys->print("s %s\n", s.str());
+	r := s.invert();
+	sys->print("r %s\n", r.str());
+	r = r.del(20);
+	addit(r);
+	sys->print("r del20: %s\n", r.str());
+	z := r.X(~A&~B, s);
+	addit(z);
+	sys->print("z: %s\n", z.str());
+
+	x := set();
+	for (i := 0; i < 31; i++)
+		if (rand->rand(2))
+			x = x.add(i);
+	addit(x);
+	for(i = 0; i < 31; i++)
+		addit(set().add(i));
+	if (Testbig) {
+		r = r.del(100);
+		addit(r);
+		sys->print("rz: %s\n", r.str());
+		r = r.add(100);
+		addit(r);
+		sys->print("rz2: %s\n", r.str());
+		x = set();
+		for (i = 0; i < 200; i++)
+			x = x.add(rand->rand(300));
+		addit(x);
+		for(i = 31; i < 70; i++)
+			addit(set().add(i));
+	}
+	sys->print("empty: %s\n", set().str());
+	addit(set());
+	sys->print("full: %s\n", set().invert().str());
+	test();
+	sys->print("done tests\n");
+}
+
+ds(d: array of byte): string
+{
+	s := "";
+	for(i := len d - 1; i >= 0; i--)
+		s += sys->sprint("%.2x", int d[i]);
+	return s;
+}
+
+testsets: list of Set;
+addit(s: Set)
+{
+	testsets = s :: testsets;
+}
+
+test()
+{
+	for (t := testsets; t != nil; t = tl t)
+		testsets = (hd t).invert() :: testsets;
+
+	for (t = testsets; t != nil; t = tl t)
+		testa(hd t);
+	for (t = testsets; t != nil; t = tl t) {
+		a := hd t;
+		for (s := testsets; s != nil; s = tl s) {
+			b := hd s;
+			testab(a, b);
+		}
+	}
+}
+
+testab(a, b: Set)
+{
+	{
+		check(!a.eq(b) == !b.eq(a), "equality");
+		if (superset(a, b) && !a.eq(b))
+			check(!superset(b, a), "superset");
+	} exception {
+	"test failed" =>
+		sys->print("%s, %s [%s, %s]\n", a.str(), b.str(), a.debugstr(), b.debugstr());
+	}
+}
+
+testa(a: Set)
+{
+	{
+		check(sets->str2set(a.str()).eq(a), "string conversion");
+		check(a.eq(a), "self equality");
+		check(a.eq(a.invert().invert()), "double inversion");
+		check(a.X(A&~B, a).eq(∅), "self not intersect");
+		check(a.limit() == a.invert().limit(), "invert limit");
+		check(a.X(A&~B, set().invert()).limit() == 0, "zero limit");
+		check(sets->bytes2set(a.bytes(0)).eq(a), "bytes conversion");
+		check(sets->bytes2set(a.bytes(3)).eq(a), "bytes conversion(2)");
+
+		if (a.limit() > 0) {
+			if (a.msb())
+				check(!a.holds(a.limit() - 1), "hold limit 1");
+			else
+				check(a.holds(a.limit() - 1), "hold limit 2");
+		}
+	} exception {
+	"test failed" =>
+		sys->print("%s [%s]\n", a.str(), a.debugstr());
+	}
+}
+
+check(ok: int, s: string)
+{
+	if (!ok) {
+		sys->print("test failed: %s; ", s);
+		raise "test failed";
+	}
+}
+
+# return true if a is a superset of b
+superset(a, b: Set): int
+{
+	return a.X(~A&B, b).eq(∅);
+}
diff --git a/appl/spree/lib/tricks.b b/appl/spree/lib/tricks.b
new file mode 100644
index 00000000..3763bac5
--- /dev/null
+++ b/appl/spree/lib/tricks.b
@@ -0,0 +1,140 @@
+implement Tricks;
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "sets.m";
+	sets: Sets;
+	Set, All, None: import sets;
+include "../spree.m";
+	spree: Spree;
+	Attributes, Range, Object, Clique, Member: import spree;
+include "cardlib.m";
+	cardlib: Cardlib;
+	Card, getcard: import cardlib;
+include "tricks.m";
+
+clique: ref Clique;
+
+init(mod: Spree, g: ref Clique, cardlibmod: Cardlib)
+{
+	sys = load Sys Sys->PATH;
+	sets = load Sets Sets->PATH;
+	if (sets == nil)
+		panic(sys->sprint("cannot load %s: %r", Sets->PATH));
+	clique = g;
+	spree = mod;
+	cardlib = cardlibmod;
+}
+
+defaultrank := array[13] of {12, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11};
+
+# XXX should take a "rank" array so that we can cope with custom
+# card ranking
+Trick.new(pile: ref Object, trumps: int, hands: array of ref Object, rank: array of int): ref Trick
+{
+	t := ref Trick;
+	t.highcard = t.startcard = Card(-1, -1, -1);
+	t.winner = -1;
+	t.trumps = trumps;
+	t.pile = pile;
+	t.hands = hands;
+	if (rank == nil)
+		rank = defaultrank;
+	t.rank = rank;
+	return t;
+}
+
+Trick.archive(t: self ref Trick, archiveobj: ref Object, name: string)
+{
+	a := clique.newobject(archiveobj, None, "trick");
+	cardlib->setarchivename(a, name);
+	a.setattr("trumps", string t.trumps, None);
+	a.setattr("winner", string t.winner, None);
+	a.setattr("startcard.n", string t.startcard.number, None);
+	a.setattr("startcard.suit", string t.startcard.suit, None);
+	a.setattr("highcard.n", string t.highcard.number, None);
+	a.setattr("highcard.suit", string t.highcard.suit, None);
+	cardlib->setarchivename(t.pile, name + ".pile");
+	cardlib->archivearray(t.hands, name);
+	for (i := 0; i < len t.rank; i++)
+		if (t.rank[i] != defaultrank[i])
+			break;
+	if (i < len t.rank) {
+		r := "";
+		for (i = 0; i < len t.rank; i++)
+			r += " " + string t.rank[i];
+		a.setattr("rank", r, None);
+	}
+}
+
+Trick.unarchive(nil: ref Object, name: string): ref Trick
+{
+	t := ref Trick;
+	a := cardlib->getarchiveobj(name);
+	t.trumps = int a.getattr("trumps");
+	t.winner = int a.getattr("winner");
+	t.startcard.number = int a.getattr("startcard.n");
+	t.startcard.suit = int a.getattr("startcard.suit");
+	t.highcard.number = int a.getattr("highcard.n");
+	t.highcard.suit = int a.getattr("highcard.suit");
+	t.pile = cardlib->getarchiveobj(name + ".pile");
+	t.hands = cardlib->getarchivearray(name);
+	r := a.getattr("rank");
+	if (r != nil) {
+		(nil, toks) := sys->tokenize(r, " ");
+		t.rank = array[len toks] of int;
+		i := 0;
+		for (; toks != nil; toks = tl toks)
+			t.rank[i++] = int hd toks;
+	} else
+		t.rank = defaultrank;
+	return t;
+}
+
+Trick.play(t: self ref Trick, ord, idx: int): string
+{
+	stack := t.hands[ord];
+	if (idx < 0 || idx >= len stack.children)
+		return "invalid card to play";
+
+	c := getcard(stack.children[idx]);
+	c.number = t.rank[c.number];
+	if (len t.pile.children == 0) {
+		t.winner = ord;
+		t.startcard = t.highcard = c;
+	} else {
+		if (c.suit != t.startcard.suit) {
+			if (containssuit(stack, t.startcard.suit))
+				return "you must play the suit that was led";
+			if (c.suit == t.trumps &&
+					(t.highcard.suit != t.trumps ||
+					c.number > t.highcard.number)) {
+				t.highcard = c;
+				t.winner = ord;
+			}
+		} else if (c.suit == t.highcard.suit && c.number > t.highcard.number) {
+			t.highcard = c;
+			t.winner = ord;
+		}
+	}
+
+	stack.transfer((idx, idx + 1), t.pile, len t.pile.children);
+	stack.setattr("n", string (int stack.getattr("n") - 1), All);
+	return nil;
+}
+
+containssuit(stack: ref Object, suit: int): int
+{
+	ch := stack.children;
+	n := len ch;
+	for (i := 0; i < n; i++)
+		if (getcard(ch[i]).suit == suit)
+			return 1;
+	return 0;
+}
+
+panic(e: string)
+{
+	sys->fprint(sys->fildes(2), "tricks panic: %s\n", e);
+	raise "panic";
+}
diff --git a/appl/spree/lib/tricks.m b/appl/spree/lib/tricks.m
new file mode 100644
index 00000000..0cdab785
--- /dev/null
+++ b/appl/spree/lib/tricks.m
@@ -0,0 +1,21 @@
+Tricks: module {
+	PATH:		con "/dis/spree/lib/tricks.dis";
+	init:			fn(mod: Spree, g: ref Clique, cardlibmod: Cardlib);
+
+	Trick: adt {
+		trumps:	int;
+		startcard:	Cardlib->Card;
+		highcard:	Cardlib->Card;
+		winner:	int;
+		pile:		ref Object;
+		hands:	array of ref Object;
+		rank:		array of int;
+
+		new:		fn(pile: ref Object, trumps: int,
+					hands: array of ref Object, rank: array of int): ref Trick;
+		play:		fn(t: self ref Trick, ord, idx: int): string;
+		archive:	fn(t: self ref Trick, archiveobj: ref Object, name: string);
+		unarchive:	fn(archiveobj: ref Object, name: string): ref Trick;
+	};
+
+};