implement Clientmod;

# bouncing balls demo.  it uses tk and multiple processes to animate a
# number of balls bouncing around the screen.  each ball has its own
# process; CPU time is doled out fairly to each process by using
# a central monitor loop.

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

BALLSIZE: con 5;
ZERO: con 1e-6;
π: con Math->Pi;
Maxδ: con π / 4.0;			# max bat angle deflection

Line: adt {
	p, v:		Realpoint;
	s:		real;
	new:			fn(p1, p2: Point): ref Line;
	hittest:		fn(l: self ref Line, p: Point): (Realpoint, real, real);
	intersection:	fn(b: self ref Line, p, v: Realpoint): (int, Realpoint, real, real);
	point:		fn(b: self ref Line, s: real): Point;
};

Realpoint: adt {
	x, y: real;
};

gamecmds := array[] of {
"canvas .c -bg black",
"bind .c <ButtonRelease-1> {send mouse 0 1 %x %y}",
"bind .c <ButtonRelease-2> {send mouse 0 2 %x %y}",
"bind .c <Button-1> {send mouse 1 1 %x %y}",
"bind .c <Button-2> {send mouse 1 2 %x %y}",
"bind . <Key-b> {send ucmd newball}",
"bind . <ButtonRelease-1> {focus .}",
"bind .Wm_t <ButtonRelease-1> +{focus .}",
"focus .",
"bind .c <Key-b> {send ucmd newball}",
"bind .c <Key-u> {grab release .c}",
"frame .f",
"button .f.b -text {Start} -command {send ucmd start}",
"button .f.n -text {New ball} -command {send ucmd newball}",
"pack .f.b .f.n -side left",
"pack .f -fill x",
"pack .c -fill both -expand 1",
"update",
};

Ballstate: adt {
	owner: int;		# index into player array
	hitobs: ref Obstacle;
	t0: int;
	p, v: Realpoint;
	speed: real;
};

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

randch: chan of int;
lines: list of ref Obstacle;
lineversion := 0;
win: ref Tk->Toplevel;
playerid: int;
myturn: int;
stderr: ref Sys->FD;
timeoffset := 0;

Obstacle: adt {
	line: 		ref Line;
	id: 		int;
	isbat: 	int;
	s1, s2: 	real;
	srvid:	int;
	owner:	int;
	new: 	fn(id: int): ref Obstacle;
	config: 	fn(b: self ref Obstacle);
};

Object: adt {
	obstacle: ref Obstacle;
	ballctl: chan of ref Ballstate;
};

objects: array of ref Object;
srvobjects: array of ref Obstacle;	# all for lasthit...

Player: adt {
	id: int;
	colour: string;
};
players: array of ref Player;

CORNER: con 60;
INSET: con 20;
WIDTH: con 500;
HEIGHT: con 500;

bats: list of ref Obstacle;
mkball: chan of (int, chan of chan of ref Ballstate);
gamefd: ref Sys->FD;
currentlydragging := -1;
Ballexit: ref Ballstate;
Noobs: ref Obstacle;

nomod(s: string)
{
	sys->fprint(stderr, "bounce: cannot load %s: %r\n", s);
	sys->raise("fail:bad module");
}

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;
	math = load Math Math->PATH;
	tk = load Tk Tk->PATH;
	wmlib = load Wmlib Wmlib->PATH;
	if (wmlib == nil)
		nomod(Wmlib->PATH);
	wmlib->init();
	gamefd = sys->fildes(0);
	Ballexit = ref Ballstate;
	Noobs = Obstacle.new(-1);
	lines = tl lines;		# XXX ahem.

	sys->pctl(Sys->NEWPGRP, nil);
	wmctl: chan of string;
	(win, wmctl) = wmlib->titlebar(ctxt.screen, nil, "Bounce", 0);
	ucmd := chan of string;
	tk->namechan(win, ucmd, "ucmd");
	mouse := chan of string;
	tk->namechan(win, mouse, "mouse");
	for (i := 0; i < len gamecmds; i++)
		cmd(win, gamecmds[i]);
	cmd(win, ".c configure -width 500 -height 500");
	cmd(win, ".c configure -width [.c cget -actwidth] -height [.c cget -actheight]");
	imageinit();

	mch := chan of (int, Point);
	randch = chan of int;
	spawn randgenproc(randch);

	spawn mouseproc(mch);
	mkball = chan of (int, chan of chan of ref Ballstate);
	spawn monitor(mkball);
	balls: list of chan of ref Ballstate;

	spawn updateproc();
	sys->sleep(500);		# wait for things to calm down a little
	gamecmd("time " + string sys->millisec());

	buts := 0;
	for (;;) alt {
	c := <-wmctl =>
		if (c == "exit")
			sys->write(gamefd, array[0] of byte, 0);
		wmlib->titlectl(win, c);
	c := <-mouse =>
		(nil, toks) := sys->tokenize(c, " ");
		if ((hd toks)[0] == '1')
			buts |= int hd tl toks;
		else
			buts &= ~int hd tl toks;
		mch <-= (buts, Point(int hd tl tl toks, int hd tl tl tl toks));
	c := <-ucmd =>
		gamecmd(c);
	}
}

gamecmd(s: string): int
{
	if (sys->fprint(gamefd, "%s\n", s) == -1) {
		err := sys->sprint("%r");
		notify(err);
		sys->print("bounce: 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]);
}

updateproc1()
{
	buf := array[Sys->ATOMICIO] of byte;
	while ((n := sys->read(gamefd, buf, len buf)) > 0) {
		(nil, lines) := sys->tokenize(string buf[0:n], "\n");
		for (; lines != nil; lines = tl lines)
			applyupdate(hd lines);
		cmd(win, "update");
	}
	if (n < 0)
		sys->fprint(stderr, "bounce: error reading updates: %r\n");
	sys->fprint(stderr, "bounce: updateproc exiting\n");
}

UNKNOWN, BALL, OBSTACLE: con iota;

applyupdate(s: string)
{
#	sys->print("bounce: got update %s\n", s);
	(nt, toks) := sys->tokenize(s, " ");
	case hd toks {
	"playerid" =>
		# playerid clientid playerid name
		playerid = int hd tl tl toks;
	"create" =>
		# create id parentid vis type
		id := int hd tl toks;
		if (id >= len objects) {
			newobjects := array[id + 10] of ref Object;
			newobjects[0:] = objects;
			objects = newobjects;
		}
		objects[id] = ref Object;
	"del" =>
		# del parent start end objid...
		for (toks = tl tl tl tl toks; toks != nil; toks = tl toks) {
			id := int hd toks;
			if (objects[id].obstacle != nil)
				sys->fprint(stderr, "bounce: cannot delete obstructions yet\n");
			else
				objects[id].ballctl <-= Ballexit;
			objects[id] = nil;
		}
	"set" =>
		# set obj attr val
		id := int hd tl toks;
		attr := hd tl tl toks;
		val := tl tl tl toks;
		case attr {
		"state" =>
			# state lasthit owner p.x p.y v.x v.y s time
			state := ref Ballstate;
			(state.hitobs, val) = (srvobj(int hd val), tl val);
			(state.owner, val) = (int hd val, tl val);
			(state.p.x, val) = (real hd val, tl val);
			(state.p.y, val) = (real hd val, tl val);
			(state.v.x, val) = (real hd val, tl val);
			(state.v.y, val) = (real hd val, tl val);
			(state.speed, val) = (real hd val, tl val);
			(state.t0, val) = (int hd val, tl val);
			if (objects[id].ballctl == nil)
				objects[id].ballctl = makeball(id, state);
			else
				objects[id].ballctl <-= state;
		"pos" or "coords" or "owner" or "id" =>
			if (objects[id].obstacle == nil)
				objects[id].obstacle = Obstacle.new(id);
			o := objects[id].obstacle;
			case attr {
			"pos" =>
				(o.s1, val) = (real hd val, tl val);
				(o.s2, val) = (real hd val, tl val);
				o.isbat = 1;
			"coords" =>
				p1, p2: Point;
				(p1.x, val) = (int hd val, tl val);
				(p1.y, val) = (int hd val, tl val);
				(p2.x, val) = (int hd val, tl val);
				(p2.y, val) = (int hd val, tl val);
				o.line = Line.new(p1, p2);
			"owner" =>
				o.owner = int hd val;
				if (o.owner == playerid)
					bats = o :: bats;
			"id" =>
				o.srvid = int hd val;
				if (o.srvid >= len srvobjects) {
					newobjects := array[id + 10] of ref Obstacle;
					newobjects[0:] = srvobjects;
					srvobjects = newobjects;
				}
				srvobjects[o.srvid] = o;
			}
			if (currentlydragging != id)
				o.config();
		"arenasize" =>
			# arenasize w h
			cmd(win, ".c configure -width " + hd val + " -height " + hd tl val);
		* =>
			
			if (len attr > 5 && attr[0:5] == "score") {
				# scoreN val
				n := int attr[5:];
				w := ".f." + string n;
				if (!tkexists(w)) {
					cmd(win, "label " + w + "l -text '" + attr);
					cmd(win, "label " + w + " -relief sunken -bd 5 -width 5w");
					cmd(win, "pack " +w + "l " + w + " -side left");
				}
				cmd(win, w + " configure -text {" + hd val + "}");
			} else if (len attr > 6 && attr[0:6] == "player") {
				# playerN id colour
				n := int attr[6:];
				if (n >= len players) {
					newplayers := array[n + 1] of ref Player;
					newplayers[0:] = players;
					players = newplayers;
				}
				p := players[n] = ref Player(int hd val, hd tl val);
				cmd(win, ".c itemconfigure o" + string p.id + " -fill " + p.colour);
				if (p.id == playerid)
					myturn = n;
			}
			else
				sys->fprint(stderr, "bounce: unknown attr '%s'\n", attr);
		}
	"time" =>
		# time offset orig
		now := sys->millisec();
		time := int hd tl tl toks;
		transit := now - time;
		timeoffset = int hd tl toks - transit / 2;
		sys->print("transit time %d, timeoffset: %d\n", transit, timeoffset);
	* =>
		sys->fprint(stderr, "chat: unknown update message '%s'\n", s);
	}
}

tkexists(w: string): int
{
	return tk->cmd(win, w + " cget -bd")[0] != '!';
}

srvobj(id: int): ref Obstacle
{
	if (id < 0 || id >= len srvobjects || srvobjects[id] == nil)
		return Noobs;
	return srvobjects[id];
}

mouseproc(mch: chan of (int, Point))
{
	procname("mouse");
	for (;;) {
		hitbat: ref Obstacle = nil;
		minperp, hitdist: real;
		(buts, p) := <-mch;
		for (bl := bats; bl != nil; bl = tl bl) {
			b := hd bl;
			(normal, perp, dist) := b.line.hittest(p);
			perp = abs(perp);
			
			if ((hitbat == nil || perp < minperp) && (dist >= b.s1 && dist <= b.s2))
				(hitbat, minperp, hitdist) = (b, perp, dist);
		}
		if (hitbat == nil || minperp > 30.0) {
			while ((<-mch).t0)
				;
			continue;
		}
		offset := hitdist - hitbat.s1;
		if (buts & 2)
			(buts, p) = aim(mch, hitbat, p);
		if (buts & 1)
			drag(mch, hitbat, offset);
	}
}


drag(mch: chan of (int, Point), hitbat: ref Obstacle, offset: real)
{
	realtosrv := chan of string;
	dummytosrv := chan of string;
	tosrv := dummytosrv;
	currevent := "";

	currentlydragging = hitbat.id;

	line := hitbat.line;
	batlen := hitbat.s2 - hitbat.s1;

	cvsorigin := Point(int cmd(win, ".c cget -actx"), int cmd(win, ".c cget -acty"));
	spawn sendproc(realtosrv);

	cmd(win, "grab set .c");
	cmd(win, "focus .");
loop:	for (;;) alt {
	tosrv <-= currevent =>
		tosrv = dummytosrv;

	(buts, p) := <-mch =>
		if (buts & 2)
			(buts, p) = aim(mch, hitbat, p);
		(v, perp, dist) := line.hittest(p);
		dist -= offset;
		# constrain bat and mouse positions
		if (dist < 0.0 || dist + batlen > line.s) {
			if (dist < 0.0) {
				p = line.point(offset);
				dist = 1.0;
			} else {
				p = line.point(line.s - batlen + offset);
				dist = line.s - batlen;
			}
			p.x -= int (v.x * perp);
			p.y -= int (v.y * perp);
			win.image.display.cursorset(p.add(cvsorigin));
		}
		(hitbat.s1, hitbat.s2) = (dist, dist + batlen);
		hitbat.config();
		cmd(win, "update");
		currevent = "bat " + string hitbat.s1;
		tosrv = realtosrv;
		if (!buts)
			break loop;
	}
	cmd(win, "grab release .c");
	realtosrv <-= nil;
	currentlydragging = -1;
}

CHARGETIME: con 1000.0;
MAXCHARGE: con 50.0;

α: con 0.999;		# decay in one millisecond
D: con 5;
aim(mch: chan of (int, Point), hitbat: ref Obstacle, p: Point): (int, Point)
{
	cvsorigin := Point(int cmd(win, ".c cget -actx"), int cmd(win, ".c cget -acty"));
	startms := ms := sys->millisec();
	δ := Realpoint(0.0, 0.0);
	line := hitbat.line;
	charge := 0.0;
	pivot := line.point((hitbat.s1 + hitbat.s2) / 2.0);
	s1 := p2s(line.point(hitbat.s1));
	s2 := p2s(line.point(hitbat.s2));
	cmd(win, ".c create line 0 0 0 0 -tags wire -fill yellow");
	ballid := makeballitem(-1, myturn);
	bp, p2: Point;
	buts := 2;
	for (;;) {
		v := makeunit(δ);
		bp = pivot.add((int (v.x * charge), int (v.y * charge)));
		cmd(win, ".c coords wire "+s1+" "+p2s(bp)+" "+s2);
		ballmove(ballid, bp);
		cmd(win, "update");
		if ((buts & 2) == 0)
			break;
		(buts, p2) = <-mch;
		now := sys->millisec();
		fade := math->pow(α, real (now - ms));
		charge = real (now - startms) * (MAXCHARGE / CHARGETIME);
		if (charge > MAXCHARGE)
			charge = MAXCHARGE;
		ms = now;
		dp := p2.sub(p);
		δ.x = δ.x * fade + real dp.x;
		δ.y = δ.y * fade + real dp.y;
		mag := δ.x * δ.x + δ.y * δ.y;
		if (dp.x != 0 || dp.y != 0)
			win.image.display.cursorset(p.add(cvsorigin));
	}
	cmd(win, ".c delete wire " + ballid);
	cmd(win, "update");
	(δ.x, δ.y) = (-δ.x, -δ.y);
	gamecmd("newball " + string hitbat.id + " " +
		p2s(bp) + " " + rp2s(makeunit(δ)) + " " + string (charge / 100.0));
	return (buts, p2);
}

makeunit(v: Realpoint): Realpoint
{
	mag := math->sqrt(v.x * v.x + v.y * v.y);
	if (mag < ZERO)
		return (1.0, 0.0);
	return (v.x / mag, v.y / mag);
}

sendproc(tosrv: chan of string)
{
	procname("send");
	while ((ev := <-tosrv) != nil)
		gamecmd(ev);
}

makeball(id: int, state: ref Ballstate): chan of ref Ballstate
{
	mkballreply := chan of chan of ref Ballstate;
	mkball <-= (id, mkballreply);
	ballctl := <-mkballreply;
	ballctl <-= state;
	return ballctl;
}

blankobstacle: Obstacle;
Obstacle.new(id: int): ref Obstacle
{
	cmd(win, ".c create line 0 0 0 0 -width 3 -fill #aaaaaa" + " -tags l" + string id);
	o := ref blankobstacle;
	o.line = Line.new((0, 0), (0, 0));
	o.id = id;
	o.owner = -1;
	o.srvid = -1;
	lineversion++;
	lines = o :: lines;
	return o;
}

Obstacle.config(o: self ref Obstacle)
{
	if (o.isbat) {
		cmd(win, ".c coords l" + string o.id + " " +
			p2s(o.line.point(o.s1)) + " " + p2s(o.line.point(o.s2)));
		if (o.owner == playerid)
			cmd(win, ".c itemconfigure l" + string o.id + " -fill red");
		else
			cmd(win, ".c itemconfigure l" + string o.id + " -fill white");
	} else {
		cmd(win, ".c coords l" + string o.id + " " +
			p2s(o.line.point(0.0)) + " " + p2s(o.line.point(o.line.s)));
	}
}
	
# make sure cpu time is handed to all ball processes fairly
# by passing a "token" around to each process in turn.
# each process does its work when it *hasn't* got its
# token but it can't go through two iterations without
# waiting its turn.
#
# new processes are created by sending on mkball.
# the channel sent back can be used to control the position
# and velocity of the ball and to destroy it.
monitor(mkball: chan of (int, chan of chan of ref Ballstate))
{
	procname("mon");
	procl, proc: list of (chan of ref Ballstate, chan of int);
	rc := dummyrc := chan of int;
	for (;;) {
		alt {
		(id, ch) := <-mkball =>
			(newc, newrc) := (chan of ref Ballstate, chan of int);
			procl = (newc, newrc) :: procl;
			spawn animproc(id, newc, newrc);
			ch <-= newc;
			if (tl procl == nil) {		# first ball
				newc <-= nil;
				rc = newrc;
				proc = procl;
			}
		alive := <-rc =>					# got token.
			if (!alive) {
				# ball has exited: remove from list
				newprocl: list of (chan of ref Ballstate, chan of int);
				for (; procl != nil; procl = tl procl)
					if ((hd procl).t1 != rc)
						newprocl = hd procl :: newprocl;
				procl = newprocl;
			}
			if ((proc = tl proc) == nil)
				proc = procl;
			if (proc == nil) {
				rc = dummyrc;
			} else {
				c: chan of ref Ballstate;
				(c, rc) = hd proc;
				c <-= nil;				# hand token to next process.
			}
		}
	}
}

# buffer ball state commands, so at least balls we handle
# locally appear glitch free.
bufferproc(cmdch: chan of string)
{
	procname("buffer");
	buffer := ref Queue;
	bufhd: string;
	dummytosrv := chan of string;
	realtosrv := chan of string;
	spawn sendproc(realtosrv);
	tosrv := dummytosrv;
	for (;;) alt {
	tosrv <-= bufhd =>
		if ((bufhd = buffer.get()) == nil)
			tosrv = dummytosrv;
	s := <-cmdch =>
		if (s == nil) {
			# ignore other queued requests, as they're
			# only state changes for a ball that's now been deleted.
			realtosrv <-= nil;
			exit;
		}
		buffer.put(s);
		if (tosrv == dummytosrv) {
			tosrv = realtosrv;
			bufhd = buffer.get();
		}
	}
}
start: int;
# animate one ball. initial position and unit-velocity are
# given by p and v.
animproc(id: int, c: chan of ref Ballstate, rc: chan of int)
{
	procname("anim");
	while ((newstate := <-c) == nil)
		rc <-= 1;
	state := *newstate;
	totaldist := 0.0;		# distance ball has travelled from reference point to last intersection
	ballid := makeballitem(id, state.owner);
	smallcount := 0;
	version := lineversion;
	tosrv := chan of string;
	start := sys->millisec();
	spawn bufferproc(tosrv);
loop:	for (;;) {
		hitp: Realpoint;

		dist := 1000000.0;
		oldobs := state.hitobs;
		hitt: real;
		for (l := lines; l != nil; l = tl l) {
			obs := hd l;
			(ok, hp, hdist, t) := obs.line.intersection(state.p, state.v);
			if (ok && hdist < dist && obs != oldobs && (smallcount < 10 || hdist > 1.5)) {
				(hitp, state.hitobs, dist, hitt) = (hp, obs, hdist, t);
			}
		}
		if (dist > 10000.0) {
			sys->print("no intersection!\n");
			state = ballexit(1, ballid, tosrv, c, rc);
			totaldist = 0.0;
			continue loop;
		}
		if (dist < 0.0001)
			smallcount++;
		else
			smallcount = 0;
		t0 := int (totaldist / state.speed) + state.t0 - timeoffset;
		et := t0 + int (dist / state.speed);
		t := sys->millisec() - t0;
		dt := et - t0;
		do {
			s := real t * state.speed;
			currp := Realpoint(state.p.x + s * state.v.x,  state.p.y + s * state.v.y);
			ballmove(ballid, (int currp.x, int currp.y));
			cmd(win, "update");
			if (lineversion > version) {
				(state.p, state.hitobs, version) = (currp, oldobs, lineversion);
				totaldist += s;
				continue loop;
			}
			if ((newstate := <-c) != nil) {
				if (newstate == Ballexit)
					ballexit(0, ballid, tosrv, c, rc);
				state = *newstate;
				totaldist = 0.0;
				continue loop;
			}
			rc <-= 1;
			t = sys->millisec() - t0;
		} while (t < dt);
		totaldist += dist;
		state.p = hitp;
		hitobs := state.hitobs;
		if (hitobs.isbat) {
			if (hitobs.owner == playerid) {
				if (hitt >= hitobs.s1 && hitt <= hitobs.s2)
					state.v = batboing(hitobs, hitt, state.v);
				tosrv <-= "state " + 
					string id + 
					" " + string hitobs.srvid +
					" " + string state.owner +
					" " + rp2s(state.p) + " " + rp2s(state.v) +
					" " + string state.speed +
					" " + string (sys->millisec() + timeoffset);
			} else {
				# wait for enlightenment
				while ((newstate := <-c) == nil)
					rc <-= 1;
				if (newstate == Ballexit)
					ballexit(0, ballid, tosrv, c, rc);
				state = *newstate;
				totaldist = 0.0;
			}
		} else if (hitobs.owner == playerid) {
			# if line has an owner but isn't a bat, then it's
			# a terminating line, so we inform server.
			gamecmd("lost " + string id);
			state = ballexit(1, ballid, tosrv, c, rc);
			totaldist = 0.0;
		} else
			state.v = boing(state.v, hitobs.line);
	}
}

#ballmask: ref Image;
imageinit()
{
#	displ := win.image.display;
#	ballmask = displ.newimage(((0, 0), (BALLSIZE+1, BALLSIZE+1)), 0, 0, Draw->White);
#	ballmask.draw(ballmask.r, displ.zeros, displ.ones, (0, 0));
#	ballmask.fillellipse((BALLSIZE/2, BALLSIZE/2), BALLSIZE/2, BALLSIZE/2, displ.ones,  (0, 0));
#	End: con Draw->Endsquare;
#	n := 5;
#	θ := 0.0;
#	δ := (2.0 * π) / real n;
#	c := Point(BALLSIZE / 2, BALLSIZE / 2).sub((1, 1));
#	r := real (BALLSIZE / 2);
#	for (i := 0; i < n; i++) {
#		p2 := Point(int (r * math->cos(θ)), int (r * math->sin(θ)));
#		sys->print("drawing from %s to %s\n", p2s(c), p2s(p2.add(c)));
#		ballmask.line(c, c.add(p2), End, End, 1, displ.ones, (0, 0));
#		θ += δ;
#	}
}

makeballitem(id, owner: int): string
{
	displ := win.image.display;
	return cmd(win, ".c create oval 0 0 1 1 -fill " + players[owner].colour +
			" -tags o" + string owner);

#	col := <-randch & 16rffffff;
#	tag := "b" + string id;
#	cmd(win, "image create bitmap " + tag);
#	img := displ.newimage(ballmask.r, 3, 0, Draw->White);
#	img.draw(img.r, displ.rgb(col & 16rff, (col >> 8) & 16rff, (col >> 16) & 16rff), displ.ones, (0, 0));
#	tk->imageput(win, tag, img, ballmask);
#	cmd(win, ".c create image -100 -100 -image " + tag + " -tags " + tag);
#	return tag;
}

ballmove(ballid: string, p: Point)
{
	cmd(win, ".c coords " + ballid +
		" " + string (p.x - BALLSIZE) +
		" " + string (p.y - BALLSIZE) +
		" " + string (p.x + BALLSIZE) +
		" " + string (p.y + BALLSIZE));
}

ballexit(wait: int, ballid: string, tosrv: chan of string, c: chan of ref Ballstate, rc: chan of int): Ballstate
{
	if (wait) {
		while ((s := <-c) != Ballexit)
			if (s == nil)
				rc <-= 1;
			else
				return *s;			# maybe we're not exiting, after all...
	}
	cmd(win, ".c delete " + ballid + ";update");
#	cmd(win, "image delete " + ballid);
	tosrv <-= nil;
	<-c;
	rc <-= 0;		# inform monitor that we've gone
	exit;
}

# thread-safe access to the Rand module
randgenproc(ch: chan of int)
{
	procname("rand");
	rand := load Rand Rand->PATH;
	for (;;)
		ch <-= rand->rand(16r7fffffff);
}

abs(x: real): real
{
	if (x < 0.0)
		return -x;
	return x;
}

# bounce ball travelling in direction av off line b.
# return the new unit vector.
boing(av: Realpoint, b: ref Line): Realpoint
{
	d := math->atan2(b.v.y, b.v.x) * 2.0 - math->atan2(av.y, av.x);
	return (math->cos(d), math->sin(d));
}

# calculate how a bounce vector should be modified when
# hitting a bat. t gives the intersection point on the bat;
# ballv is the ball's vector.
batboing(bat: ref Obstacle, t: real, ballv: Realpoint): Realpoint
{
	ballθ := math->atan2(ballv.y, ballv.x);
	batθ := math->atan2(bat.line.v.y, bat.line.v.x);
	φ := ballθ - batθ;
	δ: real;
	t -= bat.s1;
	batlen := bat.s2 - bat.s1;
	if (math->sin(φ) > 0.0)
		δ = (t / batlen) * Maxδ * 2.0 - Maxδ;
	else
		δ = (t / batlen) * -Maxδ * 2.0 + Maxδ;
	θ := math->atan2(bat.line.v.y, bat.line.v.x) * 2.0 - ballθ;	# boing
	θ += δ;
	return (math->cos(θ), math->sin(θ));
}

Line.new(p1, p2: Point): ref Line
{
	ln := ref Line;
	ln.p = (real p1.x, real p1.y);
	v := Realpoint(real (p2.x - p1.x), real (p2.y - p1.y));
	ln.s =  math->sqrt(v.x * v.x + v.y * v.y);
	if (ln.s > ZERO)
		ln.v = (v.x / ln.s, v.y / ln.s);
	else
		ln.v = (1.0, 0.0);
	return ln;
}

# return normal from line, perpendicular distance from line and distance down line
Line.hittest(l: self ref Line, ip: Point): (Realpoint, real, real)
{
	p := Realpoint(real ip.x, real ip.y);
	v := Realpoint(-l.v.y, l.v.x);
	(nil, nil, perp, ldist) := l.intersection(p, v);
	return (v, perp, ldist);
}

Line.point(l: self ref Line, s: real): Point
{
	return (int (l.p.x + s * l.v.x), int (l.p.y + s * l.v.y));
}

# compute the intersection of lines a and b.
# b is assumed to be fixed, and a is indefinitely long
# but doesn't extend backwards from its starting point.
# a is defined by the starting point p and the unit vector v.
# return whether it hit, the point at which it hit if so,
# the distance of the intersection point from p,
# and the distance of the intersection point from b.p.
Line.intersection(b: self ref Line, p, v: Realpoint): (int, Realpoint, real, real)
{
	det := b.v.x * v.y - v.x * b.v.y;
	if (det > -ZERO && det < ZERO)
		return (0, (0.0, 0.0), 0.0, 0.0);

	y21 := b.p.y - p.y;
	x21 := b.p.x - p.x;
	s := (b.v.x * y21 - b.v.y * x21) / det;
	t := (v.x * y21 - v.y * x21) / det;
	if (s < 0.0)
		return (0, (0.0, 0.0), s, t);
	hit := t >= 0.0 && t <= b.s;
	hp: Realpoint;
	if (hit)
		hp = (p.x+v.x*s, p.y+v.y*s);
	return (hit, hp, s, t);
}

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

state2s(s: ref Ballstate): string
{
	return sys->sprint("[hitobs:%d(id %d), t0: %d, p: %g %g; v: %g %g; s: %g",
		s.hitobs.srvid, s.hitobs.id, s.t0, s.p.x, s.p.y, s.v.x, s.v.y, s.speed);
}

l2s(l: ref Line): string
{
	return p2s(l.point(0.0)) + " " + p2s(l.point(l.s));
}

rp2s(rp: Realpoint): string
{
	return string rp.x + " " + string rp.y;
}


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

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

notifyproc(s: string, sync: chan of int)
{
	procname("notify");
	sync <-= sys->pctl(0, nil);
	cmd(win, ".c delete notify");
	id := cmd(win, ".c create text 0 0 -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(750);
	cmd(win, ".c delete notify");
	cmd(win, "update");
	notifypid = -1;
}

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

T: type string;

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

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

procname(s: string)
{
#	sys->procname(sys->procname(nil) + " " + s);
}