diff options
Diffstat (limited to 'appl/collab/clients/whiteboard.b')
| -rw-r--r-- | appl/collab/clients/whiteboard.b | 586 |
1 files changed, 586 insertions, 0 deletions
diff --git a/appl/collab/clients/whiteboard.b b/appl/collab/clients/whiteboard.b new file mode 100644 index 00000000..e05e1b45 --- /dev/null +++ b/appl/collab/clients/whiteboard.b @@ -0,0 +1,586 @@ +implement Whiteboard; + +include "sys.m"; + sys: Sys; + +include "draw.m"; + draw: Draw; + Screen, Display, Image, Rect, Point, Font: import draw; + +include "tk.m"; + tk: Tk; + +include "tkclient.m"; + tkclient: Tkclient; + +Whiteboard: module { + init: fn(ctxt: ref Draw->Context, args: list of string); +}; + +ERASEWIDTH: con 6; + + +stderr: ref Sys->FD; +srvfd: ref Sys->FD; +disp: ref Display; +font: ref Draw->Font; +drawctxt: ref Draw->Context; + +tksetup := array[] of { + "frame .f -bd 2", + "frame .c -bg white -width 234 -height 279", + "menu .penmenu", + ".penmenu add command -command {send cmd pen 0} -bitmap @/icons/whiteboard/0.bit", + ".penmenu add command -command {send cmd pen 1} -bitmap @/icons/whiteboard/1.bit", + ".penmenu add command -command {send cmd pen 2} -bitmap @/icons/whiteboard/2.bit", + ".penmenu add command -command {send cmd pen erase} -bitmap @/icons/whiteboard/erase.bit", + "menubutton .pen -menu .penmenu -bitmap @/icons/whiteboard/1.bit", + "button .colour -bg black -activebackground black -command {send cmd getcolour}", + "pack .c -in .f", + "pack .f -side top -anchor center", + "pack .pen -side left", + "pack .colour -side left -fill both -expand 1", + "update", +}; + +tkconnected := array[] of { + "bind .c <Button-1> {send cmd down %x %y}", + "bind .c <ButtonRelease-1> {send cmd up %x %y}", + "update", +}; + +init(ctxt: ref Draw->Context, args: list of string) +{ + sys = load Sys Sys->PATH; + sys->pctl(Sys->NEWPGRP, nil); + stderr = sys->fildes(2); + + draw = load Draw Draw->PATH; + tk = load Tk Tk->PATH; + + tkclient = load Tkclient Tkclient->PATH; + if (tkclient == nil) + badmod(Tkclient->PATH); + + if (len args < 2) { + sys->fprint(stderr, "Usage: whiteboard [servicedir] id\n"); + raise "fail:init"; + } + + args = tl args; + servicedir := "/n/remote/services"; + if(len args == 2) + (servicedir, args) = (hd args, tl args); + wbid := hd args; + + disp = ctxt.display; + if (disp == nil) { + sys->fprint(stderr, "bad Draw->Context\n"); + raise "fail:init"; + } + drawctxt = ctxt; + + tkclient->init(); + (win, winctl) := tkclient->toplevel(ctxt, nil, "Whiteboard", 0); + font = Font.open(disp, tkcmd(win, ". cget -font")); + if(font == nil) + font = Font.open(disp, "*default*"); + cmd := chan of string; + tk->namechan(win, cmd, "cmd"); + tkcmds(win, tksetup); + tkclient->onscreen(win, nil); + tkclient->startinput(win, "kbd" :: "ptr" :: nil); + cimage := makeimage(win); + + sc := chan of array of (Point, Point); + cc := chan of (string, ref Image, ref Sys->FD, ref Sys->FD); + connected := 0; + sfd: ref Sys->FD; + ctlfd: ref Sys->FD; # must keep this open to keep service active + + showtext(cimage, "connecting..."); + spawn connect(servicedir, wbid, cc); + + err: string; + strokeimg: ref Image; +Connect: + for (;;) alt { + (err, strokeimg, sfd, ctlfd) = <-cc => + if (err == nil) + break Connect; + else + showtext(cimage, "Error: " + err); + + s := <-winctl or + s = <-win.wreq or + s = <-win.ctxt.ctl => + oldimg := win.image; + err = tkclient->wmctl(win, s); + if(s[0] == '!' && err == nil && win.image != oldimg){ + cimage = makeimage(win); + showtext(cimage, "connecting..."); + } + p := <-win.ctxt.ptr => + tk->pointer(win, *p); + c := <-win.ctxt.kbd => + tk->keyboard(win, c); + } + + tkcmd(win, ".c configure -width " + string strokeimg.r.dx()); + tkcmd(win, ".c configure -height " + string strokeimg.r.dy()); + tkcmds(win, tkconnected); + tkcmd(win, "update"); + cimage.draw(cimage.r, strokeimg, nil, strokeimg.r.min); + + strokesin := chan of (int, int, array of Point); + strokesout := chan of (int, int, Point, Point); + spawn reader(sfd, strokesin); + spawn writer(sfd, strokesout); + + pendown := 0; + p0, p1: Point; + + getcolour := 0; + white := disp.white; + whitepen := disp.newimage(Rect(Point(0,0), Point(1,1)), Draw->CMAP8, 1, Draw->White); + pencolour := Draw->Black; + penwidth := 1; + erase := 0; + drawpen := disp.newimage(Rect(Point(0,0), Point(1,1)), Draw->CMAP8, 1, pencolour); + + for (;;) alt { + s := <-winctl or + s = <-win.ctxt.ctl or + s = <-win.wreq => + oldimg := win.image; + err = tkclient->wmctl(win, s); + if(s[0] == '!' && err == nil && win.image != oldimg){ + cimage = makeimage(win); + cimage.draw(cimage.r, strokeimg, nil, strokeimg.r.min); + } + p := <-win.ctxt.ptr => + tk->pointer(win, *p); + c := <-win.ctxt.kbd => + tk->keyboard(win, c); + (colour, width, strokes) := <-strokesin => + if (strokes == nil) + tkclient->settitle(win, "Whiteboard (Disconnected)"); + else { + pen := disp.newimage(Rect(Point(0,0), Point(1,1)), Draw->CMAP8, 1, colour); + drawstrokes(cimage, cimage.r.min, pen, width, strokes); + drawstrokes(strokeimg, strokeimg.r.min, pen, width, strokes); + } + + c := <-cmd => + (nil, toks) := sys->tokenize(c, " "); + case hd toks { + "down" => + toks = tl toks; + x := int hd toks; + y := int hd tl toks; + if (!pendown) { + pendown = 1; + p0 = Point(x, y); + continue; + } + p1 = Point(x, y); + if (p1.x == p0.x && p1.y == p0.y) + continue; + pen := drawpen; + colour := pencolour; + width := penwidth; + if (erase) { + pen = whitepen; + colour = Draw->White; + width = ERASEWIDTH; + } + drawstroke(cimage, cimage.r.min, p0, p1, pen, width); + drawstroke(strokeimg, strokeimg.r.min, p0, p1, pen, width); + strokesout <-= (colour, width, p0, p1); + p0 = p1; + "up" => + pendown = 0; + + "getcolour" => + pendown = 0; + if (!getcolour) + spawn colourmenu(cmd); + "colour" => + pendown = 0; + getcolour = 0; + toks = tl toks; + if (toks == nil) + # colourmenu was dismissed + continue; + erase = 0; + tkcmd(win, ".pen configure -bitmap @/icons/whiteboard/" + string penwidth + ".bit"); + tkcmd(win, "update"); + pencolour = int hd toks; + toks = tl toks; + tkcolour := hd toks; + drawpen = disp.newimage(Rect(Point(0,0), Point(1,1)), Draw->CMAP8, 1, pencolour); + tkcmd(win, ".colour configure -bg " + tkcolour + " -activebackground " + tkcolour); + tkcmd(win, "update"); + + "pen" => + pendown = 0; + p := hd tl toks; + i := ""; + if (p == "erase") { + erase = 1; + i = "erase.bit"; + } else { + erase = 0; + penwidth = int p; + i = p + ".bit"; + } + tkcmd(win, ".pen configure -bitmap @/icons/whiteboard/" + i); + tkcmd(win, "update"); + } + + } +} + +makeimage(win: ref Tk->Toplevel): ref Draw->Image +{ + if(win.image == nil) + return nil; + scr := Screen.allocate(win.image, win.image.display.white, 0); + w := scr.newwindow(tk->rect(win, ".c", Tk->Local), Draw->Refnone, Draw->Nofill); + return w; +} + +showtext(img: ref Image, s: string) +{ + r := img.r; + r.max.y = img.r.min.y + font.height; + img.draw(r, disp.white, nil, (0, 0)); + img.text(r.min, disp.black, (0, 0), font, s); +} + +penmenu(t: ref Tk->Toplevel, p: Point) +{ + topy := int tkcmd(t, ".penmenu yposition 0"); + boty := int tkcmd(t, ".penmenu yposition end"); + dy := boty - topy; + p.y -= dy; + tkcmd(t, ".penmenu post " + string p.x + " " + string p.y); +} + +colourcmds := array[] of { + "label .l -height 10", + "frame .c -height 224 -width 224", + "pack .l -fill x -expand 1", + "pack .c -side bottom -fill both -expand 1", + "pack propagate . 0", + "bind .c <Button-1> {send cmd push %x %y}", + "bind .c <ButtonRelease-1> {send cmd release}", +}; + +lastcolour := "255"; +lasttkcolour := "#000000"; + +colourmenu(c: chan of string) +{ + (t, winctl) := tkclient->toplevel(drawctxt, nil, "Whiteboard", Tkclient->OK); + cmd := chan of string; + tk->namechan(t, cmd, "cmd"); + tkcmds(t, colourcmds); + tkcmd(t, ".l configure -bg " + lasttkcolour); + tkcmd(t, "update"); + tkclient->onscreen(t, "onscreen"); + tkclient->startinput(t, "kbd" :: "ptr" :: nil); + + drawcolours(t.image, tk->rect(t, ".c", Tk->Local)); + + for(;;) alt { + p := <-t.ctxt.ptr => + tk->pointer(t, *p); + s := <-t.ctxt.kbd => + tk->keyboard(t, s); + s := <-winctl or + s = <-t.ctxt.ctl or + s = <-t.wreq => + case s{ + "ok" => + c <-= "colour " + lastcolour + " " + lasttkcolour; + return; + "exit" => + c <-= "colour"; + return; + * => + oldimage := t.image; + e := tkclient->wmctl(t, s); + if(s[0] == '!' && e == nil && oldimage != t.image) + drawcolours(t.image, tk->rect(t, ".c", Tk->Local)); + } + + press := <-cmd => + (n, word) := sys->tokenize(press, " "); + case hd word { + "push" => + (lastcolour, lasttkcolour) = color(int hd tl word, int hd tl tl word, tk->rect(t, ".c", 0).size()); + tkcmd(t, ".l configure -bg " + lasttkcolour); + } + } +} + +drawcolours(img: ref Image, cr: Rect) +{ + # use writepixels because it's much faster than allocating all those colors. + tmp := disp.newimage(((0,0),(cr.dx(),cr.dy()/16+1)), Draw->CMAP8, 0, 0); + if(tmp == nil) + return; + buf := array[tmp.r.dx()*tmp.r.dy()] of byte; + dx := cr.dx(); + dy := cr.dy(); + for(y:=0; y<16; y++){ + for(i:=tmp.r.dx()-1; i>=0; --i) + buf[i] = byte (16*y+(16*i)/dx); + for(k:=tmp.r.dy()-1; k>=1; --k) + buf[dx*k:] = buf[0:dx]; + tmp.writepixels(tmp.r, buf); + r: Rect; + r.min.x = cr.min.x; + r.max.x = cr.max.x; + r.min.y = cr.min.y+(dy*y)/16; + r.max.y = cr.min.y+(dy*(y+1))/16; + img.draw(r, tmp, nil, tmp.r.min); + } +} + +color(x, y: int, size: Point): (string, string) +{ + x = (16*x)/size.x; + y = (16*y)/size.y; + col := 16*y+x; + (r, g, b) := disp.cmap2rgb(col); + tks := sys->sprint("#%.2x%.2x%.2x", r, g, b); + return (string disp.cmap2rgba(col), tks); +} + +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); +} + +connect(dir, name: string, res: chan of (string, ref Image, ref Sys->FD, ref Sys->FD)) +{ + (ctlfd, srvdir, emsg) := opensvc(dir, "whiteboard", name); + if(ctlfd == nil) { + res <-= (emsg, nil, nil, nil); + return; + } + + bitpath := srvdir + "/wb.bit"; + strokepath := srvdir + "/strokes"; + + sfd := sys->open(strokepath, Sys->ORDWR); + if (sfd == nil) { + err := sys->sprint("cannot open whiteboard data: %r"); + res <-= (err, nil, nil, nil); + srvfd = nil; + return; + } + + bfd := sys->open(bitpath, Sys->OREAD); + if (bfd == nil) { + err := sys->sprint("cannot open whiteboard image: %r"); + res <-= (err, nil, nil, nil); + srvfd = nil; + return; + } + + img := disp.readimage(bfd); + if (img == nil) { + err := sys->sprint("cannot read whiteboard image: %r"); + res <-= (err, nil, nil, nil); + srvfd = nil; + return; + } +sys->print("read image ok\n"); + + # make sure image is depth 8 (because of image.line() bug) + if (img.depth != 8) { +sys->print("depth is %d, not 8\n", img.depth); + nimg := disp.newimage(img.r, Draw->CMAP8, 0, 0); + if (nimg == nil) { + res <-= ("cannot allocate local image", nil, nil, nil); + srvfd = nil; + return; + } + nimg.draw(nimg.r, img, nil, img.r.min); + img = nimg; + } + + res <-= (nil, img, sfd, ctlfd); +} + +reader(fd: ref Sys->FD, sc: chan of (int, int, array of Point)) +{ + buf := array [Sys->ATOMICIO] of byte; + + for (;;) { + n := sys->read(fd, buf, len buf); + if (n <= 0) { + sc <-= (0, 0, nil); + return; + } + s := string buf[0:n]; + (npts, toks) := sys->tokenize(s, " "); + if (npts & 1) + # something wrong + npts--; + if (npts < 6) + # ignore + continue; + + colour, width: int; + (colour, toks) = (int hd toks, tl toks); + (width, toks) = (int hd toks, tl toks); + pts := array [(npts - 2)/ 2] of Point; + for (i := 0; toks != nil; i++) { + x, y: int; + (x, toks) = (int hd toks, tl toks); + (y, toks) = (int hd toks, tl toks); + pts[i] = Point(x, y); + } + sc <-= (colour, width, pts); + pts = nil; + } +} + +Wmsg: adt { + data: array of byte; + datalen: int; + next: cyclic ref Wmsg; +}; + +writer(fd: ref Sys->FD, sc: chan of (int, int, Point, Point)) +{ + lastcol := -1; + lastw := -1; + lastpt := Point(-1, -1); + curmsg: ref Wmsg; + nextmsg: ref Wmsg; + + eofc := chan of int; + wc := chan of ref Wmsg; + wseof := 0; + spawn wslave(fd, wc, eofc); + + for (;;) { + colour := -1; + width := 0; + p0, p1: Point; + + if (curmsg == nil || wseof) + (colour, width, p0, p1) = <-sc; + else alt { + wseof = <-eofc => + ; + + (colour, width, p0, p1) = <-sc => + ; + + wc <-= curmsg => + curmsg = curmsg.next; + continue; + } + + newseq := 0; + if (curmsg == nil) { + curmsg = ref Wmsg(array [Sys->ATOMICIO] of byte, 0, nil); + nextmsg = curmsg; + newseq = 1; + } + + if (colour != lastcol || width != lastw || p0.x != lastpt.x || p0.y != lastpt.y) + newseq = 1; + + d: array of byte = nil; + if (!newseq) { + d = sys->aprint(" %d %d", p1.x, p1.y); + if (nextmsg.datalen + len d >= Sys->ATOMICIO) { + nextmsg.next = ref Wmsg(array [Sys->ATOMICIO] of byte, 0, nil); + nextmsg = nextmsg.next; + newseq = 1; + } + } + if (newseq) { + d = sys->aprint(" %d %d %d %d %d %d", colour, width, p0.x, p0.y, p1.x, p1.y); + if (nextmsg.datalen != 0) { + nextmsg.next = ref Wmsg(array [Sys->ATOMICIO] of byte, 0, nil); + nextmsg = nextmsg.next; + } + } + nextmsg.data[nextmsg.datalen:] = d; + nextmsg.datalen += len d; + lastcol = colour; + lastw = width; + lastpt = p1; + } +} + +wslave(fd: ref Sys->FD, wc: chan of ref Wmsg, eof: chan of int) +{ + for (;;) { + wm := <-wc; + n := sys->write(fd, wm.data, wm.datalen); + if (n != wm.datalen) + break; + } + eof <-= 1; +} + +drawstroke(img: ref Image, offset, p0, p1: Point, pen: ref Image, width: int) +{ + p0 = p0.add(offset); + p1 = p1.add(offset); + img.line(p0, p1, Draw->Endsquare, Draw->Endsquare, width, pen, p0); +} + +drawstrokes(img: ref Image, offset: Point, pen: ref Image, width: int, pts: array of Point) +{ + if (len pts < 2) + return; + p0, p1: Point; + p0 = pts[0].add(offset); + for (i := 1; i < len pts; i++) { + p1 = pts[i].add(offset); + img.line(p0, p1, Draw->Endsquare, Draw->Endsquare, width, pen, p0); + p0 = p1; + } +} + +badmod(mod: string) +{ + sys->fprint(stderr, "cannot load %s: %r\n", mod); + raise "fail:bad module"; +} + +tkcmd(t: ref Tk->Toplevel, cmd: string): string +{ + s := tk->cmd(t, cmd); + if (s != nil && s[0] == '!') { + sys->fprint(stderr, "%s\n", cmd); + sys->fprint(stderr, "tk error: %s\n", s); + } + return s; +} + +tkcmds(t: ref Tk->Toplevel, cmds: array of string) +{ + for (i := 0; i < len cmds; i++) + tkcmd(t, cmds[i]); +} |