summaryrefslogtreecommitdiff
path: root/appl/spree/clients/bounce.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/spree/clients/bounce.b')
-rw-r--r--appl/spree/clients/bounce.b958
1 files changed, 958 insertions, 0 deletions
diff --git a/appl/spree/clients/bounce.b b/appl/spree/clients/bounce.b
new file mode 100644
index 00000000..f1960582
--- /dev/null
+++ b/appl/spree/clients/bounce.b
@@ -0,0 +1,958 @@
+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 "tkclient.m";
+ tkclient: Tkclient;
+include "math.m";
+ math: Math;
+include "rand.m";
+include "../client.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;
+};
+
+cliquecmds := 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 member 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;
+};
+
+
+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;
+};
+
+
+Member: adt {
+ id: int;
+ colour: string;
+};
+
+win: ref Tk->Toplevel;
+
+lines: list of ref Obstacle;
+lineversion := 0;
+memberid: int;
+myturn: int;
+stderr: ref Sys->FD;
+timeoffset := 0;
+
+objects: array of ref Object;
+srvobjects: array of ref Obstacle; # all for lasthit...
+members: array of ref Member;
+
+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);
+cliquefd: 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;
+ tkclient = load Tkclient Tkclient->PATH;
+ if (tkclient == nil)
+ nomod(Tkclient->PATH);
+ tkclient->init();
+ cliquefd = sys->fildes(0);
+ Ballexit = ref Ballstate;
+ Noobs = Obstacle.new(-1);
+ lines = tl lines; # XXX ahem.
+
+ if (len argv >= 3) # argv: modname mnt dir ...
+ membername = readfile(hd tl argv + "/name");
+
+ sys->pctl(Sys->NEWPGRP, nil);
+ wmctl: chan of string;
+ (win, wmctl) = tkclient->toplevel(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 cliquecmds; i++)
+ cmd(win, cliquecmds[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);
+
+ 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
+ cliquecmd("time " + string sys->millisec());
+
+ buts := 0;
+ for (;;) alt {
+ c := <-wmctl =>
+ if (c == "exit")
+ sys->write(cliquefd, array[0] of byte, 0);
+ tkclient->wmctl(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 =>
+ cliquecmd(c);
+ }
+}
+
+cliquecmd(s: string): int
+{
+ if (sys->fprint(cliquefd, "%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(cliquefd, 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 {
+ "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 = hd val;
+ if (o.owner == membername)
+ 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] == "member") {
+ # memberN id colour
+ n := int attr[6:];
+ if (n >= len members) {
+ newmembers := array[n + 1] of ref Member;
+ newmembers[0:] = members;
+ members = newmembers;
+ }
+ p := members[n] = ref Member(int hd val, hd tl val);
+ cmd(win, ".c itemconfigure o" + string p.id + " -fill " + p.colour);
+ if (p.id == memberid)
+ 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);
+ cliquecmd("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)
+ cliquecmd(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 == memberid)
+ 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 == memberid) {
+ 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 == memberid) {
+ # if line has an owner but isn't a bat, then it's
+ # a terminating line, so we inform server.
+ cliquecmd("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 " + members[owner].colour +
+ " -tags o" + string owner);
+}
+
+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);
+}
+
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-11 14:13:25 +0000