diff options
Diffstat (limited to 'appl/collab/clients/poller.b')
| -rw-r--r-- | appl/collab/clients/poller.b | 330 |
1 files changed, 330 insertions, 0 deletions
diff --git a/appl/collab/clients/poller.b b/appl/collab/clients/poller.b new file mode 100644 index 00000000..90365606 --- /dev/null +++ b/appl/collab/clients/poller.b @@ -0,0 +1,330 @@ +implement Poller; + +include "sys.m"; + sys: Sys; + +include "draw.m"; + draw: Draw; + Rect, Point: import draw; + +include "tk.m"; + tk: Tk; + +include "tkclient.m"; + tkclient: Tkclient; + +include "dialog.m"; + dialog: Dialog; + +include "arg.m"; + +Poller: module +{ + init: fn(nil: ref Draw->Context, nil: list of string); +}; + +Maxanswer: con 4; # Tk below isn't parametrised, but could be + +contents := array[] of { + "frame .f", + "frame .f.n", + "label .f.l -anchor nw -text {Number of answers: }", + "radiobutton .f.n.a2 -text {2} -variable nanswer -value 2", + "radiobutton .f.n.a3 -text {3} -variable nanswer -value 3", + "radiobutton .f.n.a4 -text {4} -variable nanswer -value 4", + "pack .f.n.a2 .f.n.a3 .f.n.a4 -side left", + + "frame .f.b", + "button .f.b.start -text {Start} -command {send cmd start}", + "button .f.b.stop -text {Stop} -state disabled -command {send cmd stop}", + "pack .f.b.start .f.b.stop -side left", + + "canvas .f.c -height 230 -width 200", + + "pack .f.l -side top -fill x", + "pack .f.n -side top -fill x", + "pack .f.b -side top -fill x -expand 1", + "pack .f.c -side top -pady 2", + "pack .f -side top -fill both -expand 1", +}; + +dbcontents := array[] of { + "text .f.t -state disabled -wrap word -height 4h -yscrollcommand {.f.sb set}", # message log + "scrollbar .f.sb -orient vertical -command {.f.t yview}", + "pack .f.sb -side left -fill y", + "pack .f.t -side left -fill both", +}; + +Bar: adt { + frame: ref Tk->Toplevel; + canvas: string; + border: string; + inside: string; + label: string; + r: Rect; + v: real; + + draw: fn(nil: self ref Bar); +}; + +usage() +{ + sys->fprint(sys->fildes(2), "usage: poller [-d] [servicedir] pollname\n"); + raise "fail:usage"; +} + +init(ctxt: ref Draw->Context, args: list of string) +{ + sys = load Sys Sys->PATH; + draw = load Draw Draw->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), "poller: 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), "poller: can't access polling station %s: %s\n", pollname, emsg); + raise "fail:error"; + } + fd := sys->open(dir+"/root", Sys->ORDWR); + if(fd == nil){ + sys->fprint(sys->fildes(2), "poller: can't open %s/root: %r\n", dir); + raise "fail:open"; + } + + tkclient->init(); + dialog->init(); + (frame, wmctl) := tkclient->toplevel(ctxt, nil, sys->sprint("Poller: %s", pollname), Tkclient->Appl); + cmd := chan of string; + tk->namechan(frame, cmd, "cmd"); + 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); + + bars := mkbars(frame, ".f.c", Maxanswer); + count: array of int; + + in := chan of string; + spawn reader(fd, in); + first := 1; + qno := 0; + nanswer := 0; + opt := 0; + total := 0; + 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); + + c := <-cmd => + if(fd == nil){ + dialog->prompt(ctxt, frame.image, "error -fg red", "Error", "Lost connection to polling station", 0, "Dismiss"::nil); + break; + } + case c { + "start" => + s := tkcmd(frame, "variable nanswer"); + if(s == nil || s[0] == '!'){ + dialog->prompt(ctxt, frame.image, "error -fg red", "Error", "Please select number of answers", 0, "Ok"::nil); + break; + } + nanswer = int s; + count = array[Maxanswer] of {* => 0}; + total = 0; + qno++; + #opt = (int tkcmd(frame, "variable none") << 1) | int tkcmd(frame, "variable all"); + tkcmd(frame, ".f.b.start configure -state disabled"); + tkcmd(frame, ".f.b.stop configure -state normal"); + if(sys->fprint(fd, "poll %d %d %d", qno, nanswer, opt) <= 0) + sys->fprint(sys->fildes(2), "poller: write error: %r\n"); + "stop" => + tkcmd(frame, ".f.b.stop configure -state disabled"); + tkcmd(frame, "update"); + if(sys->fprint(fd, "stop %d", qno) <= 0) + sys->fprint(sys->fildes(2), "poller: write error: %r\n"); + # stop ... + tkcmd(frame, ".f.b.start configure -state normal"); + } + tk->cmd(frame, "update"); + + s := <-in => + if(s != nil){ + if(debug){ + t := s; + if(!first) + t = "\n"+t; + first = 0; + tkcmd(frame, ".f.t insert end '" + t); + tkcmd(frame, ".f.t see end"); + tkcmd(frame, "update"); + } + r := getresult(s, qno); + if(r < 0) + break; + if(r >= 0 && r < len count){ + count[r]++; + total++; + for(i:=0; i < len count; i++){ + bars[i].v = real count[i]/real total; + bars[i].draw(); + } + tk->cmd(frame, "update"); + } + #sys->print("%d %d\n", qno, r); + }else + fd = nil; + } +} + +mkbars(t: ref Tk->Toplevel, canvas: string, nbars: int): array of ref Bar +{ + x := 0; + a := array[nbars] of ref Bar; + for(i := 0; i < nbars; i++){ + b := ref Bar(t, canvas, nil, nil, nil, Rect((x,2),(x+20,202)), 0.0); + b.border = tkcmd(t, sys->sprint("%s create rectangle %d %d %d %d", + canvas, b.r.min.x,b.r.min.y,b.r.max.x,b.r.max.y)); + r := b.r.inset(1); + b.inside = tkcmd(t, sys->sprint("%s create rectangle %d %d %d %d -fill red", + canvas, r.max.x, r.max.y,r.max.x,r.max.y)); + b.label = tkcmd(t, sys->sprint("%s create text %d %d -justify center -anchor n -text '0%%", + canvas, (r.min.x+r.max.x)/2, r.max.y+4)); + a[i] = b; + x += 50; + } + tk->cmd(t, "update"); + return a; +} + +Bar.draw(b: self ref Bar) +{ + r := b.r.inset(2); + y := r.max.y - int (b.v * real r.dy()); + tkcmd(b.frame, sys->sprint("%s coords %s %d %d %d %d", + b.canvas, b.inside, r.min.x, y, r.max.x, r.max.y)); + tkcmd(b.frame, sys->sprint("%s itemconfigure %s -text '%.0f%%", + b.canvas, b.label, b.v*100.0)); +} + +getresult(msg: string, qno: int): int +{ + (nf, flds) := sys->tokenize(msg, " "); + if(nf < 5 || hd flds == "error:") + return -1; # not of interest + op := hd tl tl flds; + flds = tl tl tl flds; + if(op != "m") + return -1; # not a message from leaf + if(len flds < 3) + return -1; # bad format + flds = tl flds; # ignore user name + if(int hd flds != qno) + return -1; # not current question + result := hd tl flds; + if(result[0] >= 'A' && result[0] <= 'D') + return result[0]-'A'; + return -1; +} + +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), "poller: tk error: %s [%s]\n", s, cmd); + return s; +} + +fittoscreen(win: ref Tk->Toplevel) +{ + 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); +} |