xref: /inferno-os/appl/lib/tkclient.b (revision 37da2899f40661e3e9631e497da8dc59b971cbd0)

implement Tkclient;

#
# Copyright © 2003 Vita Nuova Holdings Limited
#

include "sys.m";
	sys: Sys;
include "draw.m";
	draw: Draw;
	Display, Image, Screen, Rect, Point, Pointer, Wmcontext, Context: import draw;
include "tk.m";
	tk: Tk;
	Toplevel: import tk;
include "wmlib.m";
	wmlib: Wmlib;
	qword, splitqword, s2r: import wmlib;
include "titlebar.m";
	titlebar: Titlebar;
include "tkclient.m";

Background: con int 16r777777FF;		# should be drawn over immediately, but just in case...

init()
{
	sys = load Sys Sys->PATH;
	draw = load Draw Draw->PATH;
	tk = load Tk Tk->PATH;
	wmlib = load Wmlib Wmlib->PATH;
	if(wmlib == nil){
		sys->fprint(sys->fildes(2), "tkclient: cannot load %s: %r\n", Wmlib->PATH);
		raise "fail:bad module";
	}
	wmlib->init();
	titlebar = load Titlebar Titlebar->PATH;
	if(titlebar == nil){
		sys->fprint(sys->fildes(2), "tkclient: cannot load %s: %r\n", Titlebar->PATH);
		raise "fail:bad module";
	}
	titlebar->init();
}

makedrawcontext(): ref Draw->Context
{
	return wmlib->makedrawcontext();
}

toplevel(ctxt: ref Draw->Context, topconfig: string, title: string, buts: int): (ref Tk->Toplevel, chan of string)
{
	wm := wmlib->connect(ctxt);
	opts := "";
	if((buts & Plain) == 0)
		opts = "-borderwidth 1 -relief raised ";
	top := tk->toplevel(wm.ctxt.display, opts+topconfig);
	if (top == nil) {
		sys->fprint(sys->fildes(2), "wmlib: window creation failed (top %ux, i %ux)\n", top, top.image);
		raise "fail:window creation failed";
	}
	top.ctxt = wm;
	readscreenrect(top);
	c := titlebar->new(top, buts);
	titlebar->settitle(top, title);
	return (top, c);
}

readscreenrect(top: ref Tk->Toplevel)
{
	if((fd := sys->open("/chan/wmrect", Sys->OREAD)) != nil){
		buf := array[12*4] of byte;
		n := sys->read(fd, buf, len buf);
		if(n > 0)
			(top.screenr, nil) = s2r(string buf[0:n], 0);
	}
}

onscreen(top: ref Tk->Toplevel, how: string)
{
	if(how == nil)
		how = "place";
	wmctl(top, sys->sprint("!reshape . -1 %s %q",
			r2s(tk->rect(top, ".", Tk->Border|Tk->Required)), how));
}

startinput(top: ref Tk->Toplevel, devs: list of string)
{
	for(; devs != nil; devs = tl devs)
		wmctl(top, sys->sprint("start %q", hd devs));
}

r2s(r: Rect): string
{
	return sys->sprint("%d %d %d %d", r.min.x, r.min.y, r.max.x, r.max.y);
}

# commands originating both from tkclient and wm (via ctl)
wmctl(top: ref Tk->Toplevel, req: string): string
{
#sys->print("wmctl %s\n", req);
	(c, next) := qword(req, 0);
	case c {
	"exit" =>
		sys->fprint(sys->open("/prog/" + string sys->pctl(0, nil) + "/ctl", Sys->OWRITE), "killgrp");
		exit;
	# old-style requests: pass them back around in proper form.
	"move" =>
		# move x y
		titlebar->sendctl(top, "!move . -1 " + req[next:]);
	"size" =>
		minsz := titlebar->minsize(top);
		titlebar->sendctl(top, "!size . -1 " + string minsz.x + " " + string minsz.y);
	"ok" or
	"help" =>
		;
	"rect" =>
		r: Rect;
		(c, next) = qword(req, next);
		r.min.x = int c;
		(c, next) = qword(req, next);
		r.min.y = int c;
		(c, next) = qword(req, next);
		r.max.x = int c;
		(c, next) = qword(req, next);
		r.max.y = int c;
		top.screenr = r;
	"haskbdfocus" =>
		in := int qword(req, next).t0 != 0;
		cmd(top, "focus -global " + string in);
		cmd(top, "update");
	"task" =>
		(r, nil) := splitqword(req, next);
		if(r.t0 == r.t1)
			req = sys->sprint("task %q", cmd(top, ".Wm_t.title cget -text"));
		if(wmreq(top, c, req, next) == nil)
			cmd(top, ". unmap; update");
	"untask" =>
		cmd(top, ". map; update");
		return wmreq(top, c, req, next);
	* =>
		return wmreq(top, c, req, next);
	}
	return nil;
}

wmreq(top: ref Tk->Toplevel, c, req: string, e: int): string
{
	err := wmreq1(top, c, req, e);
#	if(err != nil)
#		sys->fprint(sys->fildes(2), "tkclient: request %#q failed: %s\n", req, err);
	return err;
}

wmreq1(top: ref Tk->Toplevel, c, req: string, e: int): string
{
	name, reqid: string;
	if(req != nil && req[0] == '!'){
		(name, e) = qword(req, e);
		(reqid, e) = qword(req, e);
		if(name == nil || reqid == nil)
			return "bad arg count";
	}
	if(top.ctxt.connfd != nil){
		if(sys->fprint(top.ctxt.connfd, "%s", req) == -1)
			return sys->sprint("%r");
		if(req[0] == '!')
			recvimage(top, name, reqid);
		return nil;
	}
	if(req[0] != '!'){
		(nil, nil, err) := wmlib->wmctl(top.ctxt, req);
		return err;
	}
	# if there's no window manager, then we create a screen on the
	# display image. there's nowhere to find the screen again except
	# through the toplevel's image. that means that you can't create a
	# menu without mapping a toplevel, and if you manage to unmap
	# the toplevel without unmapping the menu, you'll have two
	# screens on the same display image
	# in the image, so
	if(c != "!reshape")
		return "unknown request";
	i: ref Image;
	if(top.image == nil){
		if(name != ".")
			return "screen not available";
		di := top.display.image;
		screen := Screen.allocate(di, top.display.color(Background), 0);
		di.draw(di.r, screen.fill, nil, screen.fill.r.min);
		i = screen.newwindow(di.r, Draw->Refbackup, Draw->Nofill);
	}else{
		if(name == ".")
			i = top.image;
		else
			i = top.image.screen.newwindow(s2r(req, e).t0, Draw->Refbackup, Draw->Red);
	}
	tk->putimage(top, name+" "+reqid, i, nil);
	return nil;
}

recvimage(top: ref Tk->Toplevel, name, reqid: string)
{
	i := <-top.ctxt.images;
	if(i == nil){
		cmd(top, name + " suspend");
		i = <-top.ctxt.images;
	}
	tk->putimage(top, name+" "+reqid, i, nil);
}

settitle(top: ref Tk->Toplevel, name: string): string
{
	return titlebar->settitle(top, name);
}

handler(top: ref Tk->Toplevel, stop: chan of int)
{
	ctxt := top.ctxt;
	if(stop == nil)
		stop = chan of int;
	for(;;)alt{
	c := <-ctxt.kbd =>
		tk->keyboard(top, c);
	p := <-ctxt.ptr =>
		tk->pointer(top, *p);
	c := <-ctxt.ctl or
	c = <-top.wreq =>
		wmctl(top, c);
	<-stop =>
		exit;
	}
}

snarfget(): string
{
	return wmlib->snarfget();
}

snarfput(buf: string)
{
	return wmlib->snarfput(buf);
}

cmd(top: ref Tk->Toplevel, s: string): string
{
	e := tk->cmd(top, s);
	if (e != nil && e[0] == '!')
		sys->fprint(sys->fildes(2), "tkclient: tk error %s on '%s'\n", e, s);
	return e;
}