20060303a

1 files changed, 282 insertions, 0 deletions

diff --git a/appl/collab/clients/poll.b b/appl/collab/clients/poll.b
new file mode 100644
index 00000000..ffb79c73
--- /dev/null
+++ b/appl/collab/clients/poll.b
@@ -0,0 +1,282 @@
+implement Poll;
+
+include "sys.m";
+	sys: Sys;
+
+include "draw.m";
+
+include "tk.m";
+	tk: Tk;
+
+include "tkclient.m";
+	tkclient: Tkclient;
+
+include "dialog.m";
+	dialog: Dialog;
+
+include "arg.m";
+
+Poll: module
+{
+	init:	fn(nil: ref Draw->Context, nil: list of string);
+};
+
+Maxanswer: con 4;
+
+contents := array[] of {
+	"frame .f",
+	"frame .a",
+	"radiobutton .a.a1 -state disabled -variable answer -value A -text {A} -command {send entry A}",
+	"radiobutton .a.a2 -state disabled -variable answer -value B -text {B} -command {send entry B}",
+	"radiobutton .a.a3 -state disabled -variable answer -value C -text {C} -command {send entry C}",
+	"radiobutton .a.a4 -state disabled -variable answer -value D -text {D} -command {send entry D}",
+	"pack .a.a1 -side top -fill x -expand 1",
+	"pack .a.a2 -side top -fill x -expand 1",
+	"pack .a.a3 -side top -fill x -expand 1",
+	"pack .a.a4 -side top -fill x -expand 1",
+	"pack .a -side top -fill both -expand 1",
+	"pack .f -side top -fill both",
+};
+
+dbcontents := array[] of {
+	"text .f.t -state disabled -wrap word -yscrollcommand {.f.sb set} -height 4h",
+	"scrollbar .f.sb -orient vertical -command {.f.t yview}",
+	"pack .f.sb -side left -fill y",
+	"pack .f.t -side left -fill both -expand 1",
+};
+
+usage()
+{
+	sys->fprint(sys->fildes(2), "usage: poll [-d] [servicedir] pollname\n");
+	raise "fail:usage";
+}
+
+init(ctxt: ref Draw->Context, args: list of string)
+{
+	sys = load Sys Sys->PATH;
+	tk = load Tk Tk->PATH;
+	tkclient = load Tkclient Tkclient->PATH;
+	dialog = load Dialog Dialog->PATH;
+
+	arg := load Arg Arg->PATH;
+	if(arg == nil){
+		sys->fprint(sys->fildes(2), "poll: can't load %s: %r\n", Arg->PATH);
+		raise "fail:load";
+	}
+	arg->init(args);
+	debug := 0;
+	while((ch := arg->opt()) != 0)
+		case ch {
+		'd' =>
+			debug = 1;
+		* =>
+			usage();
+		}
+	args = arg->argv();
+	arg = nil;
+	if(len args < 1)
+		usage();
+	sys->pctl(Sys->NEWPGRP, nil);
+
+	servicedir := "/n/remote/services";
+	if(len args == 2)
+		(servicedir, args) = (hd args, tl args);
+	pollname := hd args;
+
+	(cfd, dir, emsg) := opensvc(servicedir, "mpx", pollname);
+	if(cfd == nil){
+		sys->fprint(sys->fildes(2), "poll: can't access poll %s: %s\n", pollname, emsg);
+		raise "fail:error";
+	}
+	fd := sys->open(dir+"/leaf", Sys->ORDWR);
+	if(fd == nil){
+		sys->fprint(sys->fildes(2), "poll: can't open %s/leaf: %r\n", dir);
+		raise "fail:open";
+	}
+
+	tkclient->init();
+	dialog->init();
+	(frame, wmctl) := tkclient->toplevel(ctxt, nil, sys->sprint("Poll %s", pollname), Tkclient->Appl);
+	entry := chan of string;
+	tk->namechan(frame, entry, "entry");
+	tkcmds(frame, contents);
+	if(debug)
+		tkcmds(frame, dbcontents);
+	tkcmd(frame, "pack propagate . 0");
+	fittoscreen(frame);
+	tk->cmd(frame, "update");
+	tkclient->onscreen(frame, nil);
+	tkclient->startinput(frame, "kbd"::"ptr"::nil);
+
+	in := chan of string;
+	spawn reader(fd, in);
+	first := 1;
+	lastval := -1;
+	qno := -1;
+	for(;;)
+		alt{
+		s := <-frame.ctxt.kbd =>
+			tk->keyboard(frame, s);
+		s := <-frame.ctxt.ptr =>
+			tk->pointer(frame, *s);
+		s := <-frame.ctxt.ctl or
+		s = <-frame.wreq or
+		s = <-wmctl =>
+			tkclient->wmctl(frame, s);
+
+		msg := <-entry =>
+			if(fd == nil){
+				dialog->prompt(ctxt, frame.image, "error -fg red", "Error", "Lost connection to polling station", 0, "Dismiss"::nil);
+				break;
+			}
+			n := msg[0]-'A';
+			lastval = n;
+			selectonly(frame, n, Maxanswer, "disabled");
+			if(qno >= 0) {
+				# send our answer to the polling station
+				if(sys->fprint(fd, "%d %s", qno, msg) < 0){
+					sys->fprint(sys->fildes(2), "poll: write error: %r\n");
+					fd = nil;
+				}
+				qno = -1;	# only one go at it
+			}
+
+		s := <-in =>
+			if(s != nil){
+				if(debug){
+					t := s;
+					if(!first)
+						t = "\n"+t;
+					first = 0;
+					tk->cmd(frame, ".f.t insert end '" + t);
+					tk->cmd(frame, ".f.t see end");
+					tk->cmd(frame, "update");
+				}
+				(nf, flds) := sys->tokenize(s, " ");
+				if(nf > 1 && hd flds == "error:"){
+					dialog->prompt(ctxt, frame.image, "error -fg red", "Error", sys->sprint("polling station reports: %s", s), 0, "Dismiss"::nil);
+					break;
+				}
+				if(nf < 4)
+					break;
+				# seq clientid op name data
+				op, name: string;
+				flds = tl flds;	# ignore seq
+				flds = tl flds;	# ignore clientid
+				(op, flds) = (hd flds, tl flds);
+				(name, flds) = (hd flds, tl flds);
+				case op {
+				"M" =>
+					# poll qno nanswer opt
+					# stop qno
+					selectonly(frame, -1, Maxanswer, "disabled");
+					if(len flds < 2)
+						break;
+					(op, flds) = (hd flds, tl flds);
+					(s, flds) = (hd flds, tl flds);
+					case op {
+					"poll" =>
+						qno = int s;
+						(s, flds) = (hd flds, tl flds);
+						n := int s;
+						if(n > Maxanswer)
+							n = Maxanswer;
+						if(n < 2)
+							n = 2;
+						selectonly(frame, -1, n, "normal");
+						lastval = -1;
+					"stop" =>
+						selectonly(frame, lastval, Maxanswer, "disabled");
+					}
+				"L" =>
+					dialog->prompt(ctxt, frame.image, "error -fg red", "Notice", sys->sprint("Poller (%s) has gone", name), 0, "Exit"::nil);
+					tkclient->wmctl(frame, "exit");
+				}
+			}else{
+				dialog->prompt(ctxt, frame.image, "error -fg red", "Notice", "Polling station closed", 0, "Exit"::nil);
+				tkclient->wmctl(frame, "exit");
+			}
+		}
+}
+
+selectonly(t: ref Tk->Toplevel, n: int, top: int, state: string)
+{
+	for(i := 0; i < top; i++){
+		path := sys->sprint(".a.a%d", i+1);
+		if(i != n)
+			tkcmd(t, path+" deselect");
+		else
+			tkcmd(t, path+" select");
+		tkcmd(t, path+" configure -state "+state);
+	}
+	tk->cmd(t, "update");
+}
+
+reader(fd: ref Sys->FD, c: chan of string)
+{
+	buf := array[Sys->ATOMICIO] of byte;
+	while((n := sys->read(fd, buf, len buf)) > 0)
+		c <-= string buf[0:n];
+	if(n < 0)
+		c <-= sys->sprint("error: %r");
+	c <-= nil;
+}
+
+opensvc(dir: string, svc: string, name: string): (ref Sys->FD, string, string)
+{
+	ctlfd := sys->open(dir+"/ctl", Sys->ORDWR);
+	if(ctlfd == nil)
+		return (nil, nil, sys->sprint("can't open %s/ctl: %r", dir));
+	if(sys->fprint(ctlfd, "%s %s", svc, name) <= 0)
+		return (nil, nil, sys->sprint("can't access %s service %s: %r", svc, name));
+	buf := array [32] of byte;
+	sys->seek(ctlfd, big 0, Sys->SEEKSTART);
+	n := sys->read(ctlfd, buf, len buf);
+	if (n <= 0)
+		return (nil, nil, sys->sprint("%s/ctl: protocol error: %r", dir));
+	return (ctlfd, dir+"/"+string buf[0:n], nil);
+}
+
+tkcmds(t: ref Tk->Toplevel, cmds: array of string)
+{
+	for (i := 0; i < len cmds; i++)
+		tkcmd(t, cmds[i]);
+}
+
+tkcmd(t: ref Tk->Toplevel, cmd: string): string
+{
+	s := tk->cmd(t, cmd);
+	if (s != nil && s[0] == '!')
+		sys->fprint(sys->fildes(2), "poll: tk error: %s [%s]\n", s, cmd);
+	return s;
+}
+
+fittoscreen(win: ref Tk->Toplevel)
+{
+	draw := load Draw Draw->PATH;
+	Point, Rect: import draw;
+	if (win.image == nil || win.image.screen == nil)
+		return;
+	r := win.image.screen.image.r;
+	scrsize := Point((r.max.x - r.min.x), (r.max.y - r.min.y));
+	bd := int tkcmd(win, ". cget -bd");
+	winsize := Point(int tkcmd(win, ". cget -actwidth") + bd * 2, int tkcmd(win, ". cget -actheight") + bd * 2);
+	if (winsize.x > scrsize.x)
+		tkcmd(win, ". configure -width " + string (scrsize.x - bd * 2));
+	if (winsize.y > scrsize.y)
+		tkcmd(win, ". configure -height " + string (scrsize.y - bd * 2));
+	actr: Rect;
+	actr.min = Point(int tkcmd(win, ". cget -actx"), int tkcmd(win, ". cget -acty"));
+	actr.max = actr.min.add((int tkcmd(win, ". cget -actwidth") + bd*2,
+				int tkcmd(win, ". cget -actheight") + bd*2));
+	(dx, dy) := (actr.dx(), actr.dy());
+	if (actr.max.x > r.max.x)
+		(actr.min.x, actr.max.x) = (r.min.x - dx, r.max.x - dx);
+	if (actr.max.y > r.max.y)
+		(actr.min.y, actr.max.y) = (r.min.y - dy, r.max.y - dy);
+	if (actr.min.x < r.min.x)
+		(actr.min.x, actr.max.x) = (r.min.x, r.min.x + dx);
+	if (actr.min.y < r.min.y)
+		(actr.min.y, actr.max.y) = (r.min.y, r.min.y + dy);
+	tkcmd(win, ". configure -x " + string actr.min.x + " -y " + string actr.min.y);
+}