shithub: purgatorio

ref: 05d9123a707dec0eaa0ab079b94e69cdb750c6db
dir: /appl/spree/clients/chat.b/

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;
}