diff options
Diffstat (limited to 'appl/spree/clients/chat.b')
| -rw-r--r-- | appl/spree/clients/chat.b | 194 |
1 files changed, 194 insertions, 0 deletions
diff --git a/appl/spree/clients/chat.b b/appl/spree/clients/chat.b new file mode 100644 index 00000000..d474ef8f --- /dev/null +++ b/appl/spree/clients/chat.b @@ -0,0 +1,194 @@ +implement Clientmod; +include "sys.m"; + sys: Sys; +include "draw.m"; + draw: Draw; + Point, Rect, Display, Image: import draw; +include "tk.m"; + tk: Tk; +include "tkclient.m"; + tkclient: Tkclient; +include "../client.m"; +include "commandline.m"; + commandline: Commandline; + Cmdline: import commandline; + +stderr: ref Sys->FD; + +memberid := -1; +win: ref Tk->Toplevel; + +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; + tk = load Tk Tk->PATH; + tkclient = load Tkclient Tkclient->PATH; + if (tkclient == nil) { + sys->fprint(stderr, "chat: cannot load %s: %r\n", Tkclient->PATH); + sys->raise("fail:bad module"); + } + commandline = load Commandline Commandline->PATH; + if (commandline == nil) { + sys->fprint(stderr, "chat: cannot load %s: %r\n", Commandline->PATH); + sys->raise("fail:bad module"); + } + commandline->init(); + + tkclient->init(); + client1(ctxt); +} +cmdlinech: chan of string; +cmdline: ref Cmdline; + +client1(ctxt: ref Draw->Context) +{ + cliquefd := sys->fildes(0); + + sys->pctl(Sys->NEWPGRP, nil); + + winctl: chan of string; + (win, winctl) = tkclient->toplevel(ctxt.screen, nil, + "Cards", Tkclient->Appl); + cmdlinech = chan of string; + + srvcmd := chan of string; + spawn updateproc(cliquefd, srvcmd); + + for (;;) alt { + c := <-cmdlinech => + for (cmds := cmdline.event(c); cmds != nil; cmds = tl cmds) + cliquecmd(cliquefd, "say " + quote(hd cmds)); + c := <-srvcmd => + applyupdate(c); + cmd(win, "update"); + c := <-winctl => + if (c == "exit") + sys->write(cliquefd, array[0] of byte, 0); + tkclient->wmctl(win, c); + } +} + +quote(s: string): string +{ + for (i := 0; i < len s; i++) + if (s[i] == ' ') + s[i] = '_'; + return s; +} + +unquote(s: string): string +{ + for (i := 0; i < len s; i++) + if (s[i] == '_') + s[i] = ' '; + return s; +} + +cliquecmd(fd: ref Sys->FD, s: string): int +{ + if (sys->fprint(fd, "%s\n", s) == -1) { + sys->print("chat: cmd error on '%s': %r\n", s); + return 0; + } + return 1; +} + + +updateproc(fd: ref Sys->FD, srvcmd: chan of string) +{ + wfd := sys->open("/prog/" + string sys->pctl(0, nil) + "/wait", Sys->OREAD); + spawn updateproc1(fd, srvcmd); + 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(fd: ref Sys->FD, srvcmd: chan of string) +{ + buf := array[Sys->ATOMICIO] of byte; + while ((n := sys->read(fd, buf, len buf)) > 0) { + (nil, lines) := sys->tokenize(string buf[0:n], "\n"); + for (; lines != nil; lines = tl lines) + srvcmd <-= hd lines; + } + if (n < 0) + sys->fprint(stderr, "chat: error reading updates: %r\n"); + sys->fprint(stderr, "chat: updateproc exiting\n"); +} + + +applyupdate(s: string) +{ + (nt, toks) := sys->tokenize(s, " "); + case hd toks { + "memberid" => + # memberid clientid memberid name + memberid = int hd tl tl toks; + cmd(win, "frame .me"); + cmd(win, "label .me.l -text {Type here}"); + (cmdline, cmdlinech) = Cmdline.new(win, ".me.f", nil); + cmd(win, "pack .me -side top -fill x"); + cmd(win, "pack .me.l -side top"); + cmd(win, "pack .me.f -side top -fill both -expand 1 -anchor w"); + + "joinclique" => + # joinclique cliqueid clientid memberid name + id := int hd tl tl tl toks; + name := hd tl tl tl tl toks; + if (id == memberid) + break; + f := "." + string id; + cmd(win, "frame " + f); + cmd(win, "label " + f + ".l -text '" + name); + tf := f + ".tf"; + cmd(win, "frame " + tf); + cmd(win, "scrollbar " + tf + ".s -orient vertical -command {" + tf + ".t yview}"); + cmd(win, "text " + tf + ".t -height 5h"); + cmd(win, "pack " + f + ".l -side top"); + cmd(win, "pack " + tf + ".s -side left -fill y"); + cmd(win, "pack " + tf + ".t -side top -fill both -expand 1"); + cmd(win, "pack " + tf + " -side top -fill both -expand 1"); + cmd(win, "pack " + f + " -side top -fill both -expand 1"); + + "say" => + # say memberid text + id := int hd tl toks; + if (id == memberid) + break; + t := "." + string id + ".tf.t"; + cmd(win, t + " insert end '" + unquote(hd tl tl toks) + "\n"); + cmd(win, t + " see end"); + * => + sys->fprint(stderr, "chat: unknown update message '%s'\n", s); + } +} + +concat(v: list of string): string +{ + if (v == nil) + return nil; + s := hd v; + for (v = tl v; v != nil; v = tl v) + s += " " + hd v; + return s; +} + +kill(pid: int) +{ + if ((fd := sys->open("/prog/"+string pid+"/ctl", Sys->OWRITE)) != nil) + sys->write(fd, array of byte "kill", 4); +} + +showtk := 0; +cmd(top: ref Tk->Toplevel, s: string): string +{ + if (showtk) + sys->print("tk: %s\n", s); + e := tk->cmd(top, s); + if (e != nil && e[0] == '!') + sys->fprint(stderr, "tk error %s on '%s'\n", e, s); + return e; +} + |