implement Bounce; # 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;	Point, Rect: import draw;include "tk.m";	tk: Tk;include "tkclient.m";	tkclient: Tkclient;include "math.m";	math: Math;include "rand.m"; Bounce: module {	init: fn(ctxt: ref Draw->Context, argv: list of string);}; BALLSIZE: con 4;ZERO: con 1e-6;π: con Math->Pi; Line: adt {	p1, p2: Point;}; Realpoint: adt {	x, y: real;}; gamecmds := array[] of {"canvas .c","bind .c <ButtonRelease-1> {send cmd 0 %x %y}","bind .c <ButtonRelease-2> {send cmd 0 %x %y}","bind .c <Button-1> {send cmd 1 %x %y}","bind .c <Button-2> {send cmd 2 %x %y}","frame .f","button .f.left -bitmap small_color_left.bit -bd 0 -command {send cmd k -1}","button .f.right -bitmap small_color_right.bit -bd 0 -command {send cmd k 1}","label .f.l -text {8 balls}","pack .f.left .f.right -side left","pack .f.l -side left","pack .f -fill x","pack .c -fill both -expand 1",}; randch: chan of int;lines: list of (int, Line);lineid := 0;lineversion := 0; addline(win: ref Tk->Toplevel, v: Line){	lines = (++lineid, v) :: lines;	cmd(win, ".c create line " + pt2s(v.p1) + " " + pt2s(v.p2) + " -width 3 -fill black" +			" -tags l" + string lineid);	lineversion++;} nomod(s: string){	sys->fprint(sys->fildes(2), "bounce: cannot load %s: %r\n", s);	raise "fail:bad module";} init(ctxt: ref Draw->Context, argv: list of string){	sys = load Sys Sys->PATH;	draw = load Draw Draw->PATH;	math = load Math Math->PATH;	tk = load Tk Tk->PATH;	tkclient = load Tkclient Tkclient->PATH;	if (tkclient == nil)		nomod(Tkclient->PATH);	tkclient->init();	nballs := 8;	if (argv != nil && tl argv != nil)		nballs = int hd tl argv;	if (nballs < 0) {		sys->fprint(sys->fildes(2), "usage: bounce [nballs]\n");		raise "fail:usage";	}	sys->pctl(Sys->NEWPGRP, nil);	if(ctxt == nil)		ctxt = tkclient->makedrawcontext();	(win, wmctl) := tkclient->toplevel(ctxt, nil, "Bounce", 0);	cmdch := chan of string;	tk->namechan(win, cmdch, "cmd");	for (i := 0; i < len gamecmds; i++)		cmd(win, gamecmds[i]);	cmd(win, ".c configure -width 400 -height 400");	cmd(win, "pack propagate . 0");	cmd(win, ".f.l configure -text '" + string nballs + " balls");	tkclient->onscreen(win, nil);	tkclient->startinput(win, "kbd"::"ptr"::nil); 	mch := chan of (int, Point);	randch = chan of int;	spawn randgenproc(randch);	csz := Point(int cmd(win, ".c cget -actwidth"), int cmd(win, ".c cget -actheight")); 	# add edges of window	addline(win, ((-1, -1), (csz.x, -1)));	addline(win, ((csz.x, -1), csz));	addline(win, (csz, (-1, csz.y)));	addline(win, ((-1, csz.y), (-1, -1))); 	spawn makelinesproc(win, mch);	mkball := chan of (int, Realpoint, Realpoint);	spawn monitor(win, mkball);	for (i = 0; i < nballs; i++)		mkball <-= (1, randpoint(csz), makeunit(randpoint(csz)));	for (;;) alt {	s := <-win.ctxt.kbd =>		tk->keyboard(win, s);	s := <-win.ctxt.ptr =>		tk->pointer(win, *s);	s := <-win.ctxt.ctl or	s = <-win.wreq or	s = <-wmctl =>		tkclient->wmctl(win, s);	c := <-cmdch =>		(nil, toks) := sys->tokenize(c, " ");		if (hd toks != "k") {			mch <-= (int hd toks, Point(int hd tl toks, int hd tl tl toks));			continue;		}		n := nballs + int hd tl toks;		if (n < 0)			n = 0;		dn := 1;		if (n < nballs)			dn = -1;		for (; nballs != n; nballs += dn)			mkball <-= (dn, randpoint(csz), makeunit(randpoint(csz)));		cmd(win, ".f.l configure -text '" + string nballs + " balls");		cmd(win, "update");	}} randpoint(size: Point): Realpoint{	return (randreal(size.x), randreal(size.y));} # return randomish real number between 1 and x-1randreal(x: int): real{	return real (<-randch % ((x - 1) * 100)) / 100.0 + 1.0;} # 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 can be created and destroyed by# sending on mkball. processes are arranged in a stack-like# order: new processes are added to the top of the stack, and# processes are destroyed from the top of the stack downwards.monitor(win: ref Tk->Toplevel, mkball: chan of (int, Realpoint, Realpoint)){	procl := proc := chan of int :: nil;	spawn nullproc(hd proc);	# always there to avoid deadlock when no balls.	hd proc <-= 1;			# hand token to dummy proc	for (;;) {		procc := hd proc;		alt {		(n, p, v) := <-mkball =>			if (n > 0) {					# start new ball proc going.				procl = chan of int :: procl;				spawn animproc(hd procl, win, p, v);			} else if (tl procl != nil) {		# stop a ball proc.				<-hd proc;			# get token.				hd procl <-= 0;			# stop proc.				proc = procl = tl procl;	# remove proc.				hd proc <-= 1;			# hand out token.			}		<-procc =>					# got token.			if ((proc = tl proc) == nil)				proc = procl;			hd proc <-= 1;				# hand token to next process.		}	}} nullproc(c: chan of int){	for (;;)		c <-= <-c;} # animate one ball. initial position and unit-velocity are# given by p and v.animproc(c: chan of int, win: ref Tk->Toplevel, p, v: Realpoint){	speed := 0.1 + real (<-randch % 40) / 100.0;	ballid := cmd(win, sys->sprint(".c create oval 0 0 1 1 -fill #%.6x", <-randch & 16rffffff));	hitlineid := -1;	smallcount := 0;	version := lineversion;loop:	for (;;) {		hitline: Line;		hitp: Realpoint; 		dist := 1000000.0;		oldid := hitlineid;		for (l := lines; l != nil; l = tl l) {			(id, line) := hd l;			(ok, hp, hdist) := intersect(p, v, line);			if (ok && hdist < dist && id != oldid && (smallcount < 10 || hdist > 1.5)) {				(hitp, hitline, hitlineid, dist) = (hp, line, id, hdist);			}		}		if (dist > 10000.0) {			sys->print("no intersection!\n");#			sys->print("p: [%f, %f], v: [%f, %f]\n", p.x, p.y, v.x, v.y);#			for (l := lines; l != nil; l = tl l) {#				(id, line) := hd l;#				(ok, hp, hdist) := intersect(p, v, line);#				sys->print("line: [%d %d]->[%d %d] -> %d, [%f, %f], %f\n", line.p1.x, line.p1.y, line.p2.x, line.p2.y,#						ok, hp.x, hp.y, hdist);#			}			cmd(win, ".c delete " + ballid + ";update");			while (c <-= <-c)				;			exit;		}		if (dist < 0.0001)			smallcount++;		else			smallcount = 0;		bouncev := boing(v, hitline);		t0 := sys->millisec();		dt := int (dist / speed);		t := 0;		do {			s := real t * speed;			currp := Realpoint(p.x + s * v.x,  p.y + s * v.y);			bp := Point(int currp.x, int currp.y);			cmd(win, ".c coords " + ballid + " " +				string (bp.x-BALLSIZE)+" "+string (bp.y-BALLSIZE)+" "+				string (bp.x+BALLSIZE)+" "+string (bp.y+BALLSIZE));			cmd(win, "update");			if (lineversion > version) {				(p, hitlineid, version) = (currp, oldid, lineversion);				continue loop;			}			# pass the token back to the monitor.			if (<-c == 0) {				cmd(win, ".c delete " + ballid + ";update");				exit;			}			c <-= 1;			t = sys->millisec() - t0;		} while (t < dt);		p = hitp;		v = bouncev;	}} # thread-safe access to the Rand modulerandgenproc(ch: chan of int){	rand := load Rand Rand->PATH;	for (;;)		ch <-= rand->rand(16r7fffffff);} makelinesproc(win: ref Tk->Toplevel, mch: chan of (int, Point)){	for (;;) {		(down, p1) := <-mch;		addline(win, (p1, p1));		(id, nil) := hd lines;		p2 := p1;		do {			(down, p2) = <-mch;			cmd(win, ".c coords l" + string id + " " + pt2s(p1) + " " + pt2s(p2));			cmd(win, "update");			lines = (id, (p1, p2)) :: tl lines;			lineversion++;			if (down > 1) {				dp := p2.sub(p1);				if (dp.x*dp.x + dp.y*dp.y > 5) {					p1 = p2;					addline(win, (p2, p2));					(id, nil) = hd lines;				}			}		} while (down);	}} # make a vector of unit-length, parallel to v.makeunit(v: Realpoint): Realpoint{	mag := math->sqrt(v.x * v.x + v.y * v.y);	return (v.x / mag, v.y / mag);} # bounce ball travelling in direction av off line b.# return the new unit vector.boing(av: Realpoint, b: Line): Realpoint{	f := b.p2.sub(b.p1);	d := math->atan2(real f.y, real f.x) * 2.0 - math->atan2(av.y, av.x);	return (math->cos(d), math->sin(d));} # 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.intersect(p, v: Realpoint, b: Line): (int, Realpoint, real){	w := Realpoint(real (b.p2.x - b.p1.x), real (b.p2.y - b.p1.y));	det := w.x * v.y - v.x * w.y;	if (det > -ZERO && det < ZERO)		return (0, (0.0, 0.0), 0.0); 	y21 := real b.p1.y - p.y;	x21 := real b.p1.x - p.x;	s := (w.x * y21 - w.y * x21) / det;	if (s < 0.0)		return (0, (0.0, 0.0), 0.0); 	hp := Realpoint(p.x+v.x*s, p.y+v.y*s);	if (b.p1.x > b.p2.x)		(b.p1.x, b.p2.x) = (b.p2.x, b.p1.x);	if (b.p1.y > b.p2.y)		(b.p1.y, b.p2.y) = (b.p2.y, b.p1.y); 	return (int hp.x >= b.p1.x && int hp.x <= b.p2.x			&& int hp.y >= b.p1.y && int hp.y <= int b.p2.y, hp, s);} 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;} pt2s(p: Point): string{	return string p.x + " " + string p.y;}