ref: db1eb844461b07a25ca49117851fa874fd88e065
dir: /appl/lib/wmlib.b/
implement Wmlib; # # Copyright © 2003 Vita Nuova Holdings Limited # # basic window manager functionality, used by # tkclient and wmclient to create more usable functionality. include "sys.m"; sys: Sys; include "draw.m"; draw: Draw; Display, Image, Screen, Rect, Point, Pointer, Wmcontext, Context: import draw; include "wmsrv.m"; include "wmlib.m"; Client: adt{ ptrpid: int; kbdpid: int; ctlpid: int; req: chan of (array of byte, Sys->Rwrite); dir: string; ctlfd: ref Sys->FD; winfd: ref Sys->FD; }; DEVWM: con "/mnt/wm"; Ptrsize: con 1+4*12; # 'm' plus 4 12-byte decimal integers kbdstarted: int; ptrstarted: int; wptr: chan of Point; # set mouse position (only if we've opened /dev/pointer directly) cswitch: chan of (string, int, chan of string); # switch cursor images (as for wptr) init() { sys = load Sys Sys->PATH; draw = load Draw Draw->PATH; } # (_screen, dispi) := ctxt.display.getwindow("/dev/winname", nil, nil, 1); XXX corrupts heap... fix it! makedrawcontext(): ref Draw->Context { display := Display.allocate(nil); if(display == nil){ sys->fprint(sys->fildes(2), "wmlib: can't allocate Display: %r\n"); raise "fail:no display"; } return ref Draw->Context(display, nil, nil); } importdrawcontext(devdraw, mntwm: string): (ref Draw->Context, string) { if(mntwm == nil) mntwm = "/mnt/wm"; display := Display.allocate(devdraw); if(display == nil) return (nil, sys->sprint("cannot allocate display: %r")); (ok, nil) := sys->stat(mntwm + "/clone"); if(ok == -1) return (nil, "cannot find wm namespace"); wc := chan of (ref Draw->Context, string); spawn wmproxy(display, mntwm, wc); return <-wc; } # XXX we have no way of knowing when this process should go away... # perhaps a Draw->Context should hold a file descriptor # so that we do. wmproxy(display: ref Display, dir: string, wc: chan of (ref Draw->Context, string)) { wmsrv := load Wmsrv Wmsrv->PATH; if(wmsrv == nil){ wc <-= (nil, sys->sprint("cannot load %s: %r", Wmsrv->PATH)); return; } sys->pctl(Sys->NEWFD, 1 :: 2 :: nil); (wm, join, req) := wmsrv->init(); if(wm == nil){ wc <-= (nil, sys->sprint("%r")); return; } wc <-= (ref Draw->Context(display, nil, wm), nil); clients: array of ref Client; for(;;) alt{ (sc, rc) := <-join => sync := chan of (ref Client, string); spawn clientproc(display, sc, dir, sync); (c, err) := <-sync; rc <-= err; if(c != nil){ if(sc.id >= len clients) clients = (array[sc.id + 1] of ref Client)[0:] = clients; clients[sc.id] = c; } (sc, data, rc) := <-req => clients[sc.id].req <-= (data, rc); if(rc == nil) clients[sc.id] = nil; } } zclient: Client; clientproc(display: ref Display, sc: ref Wmsrv->Client, dir: string, rc: chan of (ref Client, string)) { ctlfd := sys->open(dir + "/clone", Sys->ORDWR); if(ctlfd == nil){ rc <-= (nil, sys->sprint("cannot open %s/clone: %r", dir)); return; } buf := array[20] of byte; n := sys->read(ctlfd, buf, len buf); if(n <= 0){ rc <-= (nil, "cannot read ctl id"); return; } sys->fprint(ctlfd, "fixedorigin"); dir += "/" + string buf[0:n]; c := ref zclient; c.req = chan of (array of byte, Sys->Rwrite); c.dir = dir; c.ctlfd = ctlfd; if ((c.winfd = sys->open(dir + "/winname", Sys->OREAD)) == nil){ rc <-= (nil, sys->sprint("cannot open %s/winname: %r", dir)); return; } rc <-= (c, nil); pidc := chan of int; spawn ctlproc(pidc, ctlfd, sc.ctl); c.ctlpid = <-pidc; for(;;) { (data, drc) := <-c.req; if(drc == nil) break; err := handlerequest(display, c, sc, data); n = len data; if(err != nil) n = -1; alt{ drc <-= (n, err) =>; * =>; } } sc.stop <-= 1; kill(c.kbdpid, "kill"); kill(c.ptrpid, "kill"); kill(c.ctlpid, "kill"); c.ctlfd = nil; c.winfd = nil; } handlerequest(display: ref Display, c: ref Client, sc: ref Wmsrv->Client, data: array of byte): string { req := string data; if(req == nil) return nil; (w, e) := qword(req, 0); case w { "start" => (w, e) = qword(req, e); case w { "ptr" or "mouse" => if(c.ptrpid == -1) return "already started"; fd := sys->open(c.dir + "/pointer", Sys->OREAD); if(fd == nil) return sys->sprint("cannot open %s: %r", c.dir + "/pointer"); sync := chan of int; spawn ptrproc(sync, fd, sc.ptr); c.ptrpid = <-sync; return nil; "kbd" => if(c.kbdpid == -1) return "already started"; sync := chan of (int, string); spawn kbdproc(sync, c.dir + "/keyboard", sc.kbd); (pid, err) := <-sync; c.kbdpid = pid; return err; } } if(sys->write(c.ctlfd, data, len data) == -1) return sys->sprint("%r"); if(req[0] == '!'){ buf := array[100] of byte; n := sys->read(c.winfd, buf, len buf); if(n <= 0) return sys->sprint("read winname: %r"); name := string buf[0:n]; # XXX this is the dodgy bit... i := display.namedimage(name); if(i == nil) return sys->sprint("cannot get image %#q: %r", name); s := Screen.allocate(i, display.white, 0); i = s.newwindow(i.r, Draw->Refnone, Draw->Nofill); rc := chan of int; sc.images <-= (nil, i, rc); if(<-rc == -1) return "image request already in progress"; } return nil; } connect(ctxt: ref Context): ref Wmcontext { # don't automatically make a new Draw->Context, 'cos the # client should be aware that there's no wm so multiple # windows won't work correctly. # ... unless there's an exported wm available, of course! if(ctxt == nil){ sys->fprint(sys->fildes(2), "wmlib: no draw context\n"); raise "fail:error"; } if(ctxt.wm == nil){ wm := ref Wmcontext( chan of int, chan of ref Draw->Pointer, chan of string, nil, # unused chan of ref Image, nil, ctxt ); return wm; } fd := sys->open("/chan/wmctl", Sys->ORDWR); if(fd == nil){ sys->fprint(sys->fildes(2), "wmlib: cannot open /chan/wmctl: %r\n"); raise "fail:error"; } buf := array[32] of byte; n := sys->read(fd, buf, len buf); if(n < 0){ sys->fprint(sys->fildes(2), "wmlib: cannot get window token: %r\n"); raise "fail:error"; } reply := chan of (string, ref Wmcontext); ctxt.wm <-= (string buf[0:n], reply); (err, wm) := <-reply; if(err != nil){ sys->fprint(sys->fildes(2), "wmlib: cannot connect: %s\n", err); raise "fail:" + err; } wm.connfd = fd; wm.ctxt = ctxt; return wm; } startinput(wm: ref Wmcontext, devs: list of string): string { for(; devs != nil; devs = tl devs) wmctl(wm, "start " + hd devs); return nil; } reshape(wm: ref Wmcontext, name: string, r: Draw->Rect, i: ref Draw->Image, how: string): ref Draw->Image { if(name == nil) return nil; (nil, ni, err) := wmctl(wm, sys->sprint("!reshape %s -1 %d %d %d %d %s", name, r.min.x, r.min.y, r.max.x, r.max.y, how)); if(err == nil) return ni; return i; } # # wmctl implements the default window behaviour # wmctl(wm: ref Wmcontext, request: string): (string, ref Image, string) { (w, e) := qword(request, 0); case w { "exit" => kill(sys->pctl(0, nil), "killgrp"); exit; * => if(wm.connfd != nil){ # standard form for requests: if request starts with '!', # then the next word gives the tag of the window that the # request applies to, and a new image is provided. if(sys->fprint(wm.connfd, "%s", request) == -1){ sys->fprint(sys->fildes(2), "wmlib: wm request '%s' failed\n", request); return (nil, nil, sys->sprint("%r")); } if(request[0] == '!'){ i := <-wm.images; if(i == nil) i = <-wm.images; return (qword(request, e).t0, i, nil); } return (nil, nil, nil); } # requests we can handle ourselves, if we have to. case w{ "start" => (w, e) = qword(request, e); case w{ "ptr" or "mouse" => if(!ptrstarted){ fd := sys->open("/dev/pointer", Sys->ORDWR); if(fd != nil) wptr = chan of Point; else fd = sys->open("/dev/pointer", Sys->OREAD); if(fd == nil) return (nil, nil, sys->sprint("cannot open /dev/pointer: %r")); cfd := sys->open("/dev/cursor", Sys->OWRITE); if(cfd != nil) cswitch = chan of (string, int, chan of string); spawn wptrproc(fd, cfd); sync := chan of int; spawn ptrproc(sync, fd, wm.ptr); <-sync; ptrstarted = 1; } "kbd" => if(!kbdstarted){ sync := chan of (int, string); spawn kbdproc(sync, "/dev/keyboard", wm.kbd); (nil, err) := <-sync; if(err != nil) return (nil, nil, err); spawn sendreq(wm.ctl, "haskbdfocus 1"); kbdstarted = 1; } * => return (nil, nil, "unknown input source"); } return (nil, nil, nil); "ptr" => if(wptr == nil) return (nil, nil, "cannot change mouse position"); p: Point; (w, e) = qword(request, e); p.x = int w; (w, e) = qword(request, e); p.y = int w; wptr <-= p; return (nil, nil, nil); "cursor" => if(cswitch == nil) return (nil, nil, "cannot switch cursor"); cswitch <-= (request, e, reply := chan of string); return (nil, nil, <-reply); * => return (nil, nil, "unknown wmctl request"); } } } sendreq(c: chan of string, s: string) { c <-= s; } ctlproc(sync: chan of int, fd: ref Sys->FD, ctl: chan of string) { sync <-= sys->pctl(0, nil); buf := array[4096] of byte; while((n := sys->read(fd, buf, len buf)) > 0) ctl <-= string buf[0:n]; } kbdproc(sync: chan of (int, string), f: string, keys: chan of int) { sys->pctl(Sys->NEWFD, nil); fd := sys->open(f, Sys->OREAD); if(fd == nil){ sync <-= (-1, sys->sprint("cannot open /dev/keyboard: %r")); return; } sync <-= (sys->pctl(0, nil), nil); buf := array[12] of byte; while((n := sys->read(fd, buf, len buf)) > 0){ s := string buf[0:n]; for(j := 0; j < len s; j++) keys <-= int s[j]; } } wptrproc(pfd, cfd: ref Sys->FD) { if(wptr == nil && cswitch == nil) return; if(wptr == nil) wptr = chan of Point; if(cswitch == nil) cswitch = chan of (string, int, chan of string); for(;;)alt{ p := <-wptr => sys->fprint(pfd, "m%11d %11d", p.x, p.y); (c, start, reply) := <-cswitch => buf: array of byte; if(start == len c){ buf = array[0] of byte; }else{ hot, size: Point; (w, e) := qword(c, start); hot.x = int w; (w, e) = qword(c, e); hot.y = int w; (w, e) = qword(c, e); size.x = int w; (w, e) = qword(c, e); size.y = int w; ((d0, d1), nil) := splitqword(c, e); nb := size.x/8*size.y; if(d1 - d0 != nb * 2){ reply <-= "inconsistent cursor image data"; break; } buf = array[4*4 + nb] of byte; bplong(buf, 0*4, hot.x); bplong(buf, 1*4, hot.y); bplong(buf, 2*4, size.x); bplong(buf, 3*4, size.y); j := 4*4; for(i := d0; i < d1; i += 2) buf[j++] = byte ((hexc(c[i]) << 4) | hexc(c[i+1])); } if(sys->write(cfd, buf, len buf) != len buf) reply <-= sys->sprint("%r"); else reply <-= nil; } } hexc(c: int): int { if(c >= '0' && c <= '9') return c - '0'; if(c >= 'a' && c <= 'f') return c - 'a' + 10; if(c >= 'A' && c <= 'F') return c - 'A' + 10; return 0; } bplong(d: array of byte, o: int, x: int) { d[o] = byte x; d[o+1] = byte (x >> 8); d[o+2] = byte (x >> 16); d[o+3] = byte (x >> 24); } ptrproc(sync: chan of int, fd: ref Sys->FD, ptr: chan of ref Draw->Pointer) { sync <-= sys->pctl(0, nil); b:= array[Ptrsize] of byte; while(sys->read(fd, b, len b) > 0){ p := bytes2ptr(b); if(p != nil) ptr <-= p; } } bytes2ptr(b: array of byte): ref Pointer { if(len b < Ptrsize || int b[0] != 'm') return nil; x := int string b[1:13]; y := int string b[13:25]; but := int string b[25:37]; msec := int string b[37:49]; return ref Pointer (but, (x, y), msec); } snarfbuf: string; # at least we get *something* when there's no wm. snarfget(): string { fd := sys->open("/chan/snarf", sys->OREAD); if(fd == nil) return snarfbuf; buf := array[8192] of byte; nr := 0; while ((n := sys->read(fd, buf[nr:], len buf - nr)) > 0) { nr += n; if (nr == len buf) { nbuf := array[len buf * 2] of byte; nbuf[0:] = buf; buf = nbuf; } } return string buf[0:nr]; } snarfput(buf: string) { fd := sys->open("/chan/snarf", sys->OWRITE); if(fd != nil) sys->fprint(fd, "%s", buf); else snarfbuf = buf; } # return (qslice, end). # the slice has a leading quote if the word is quoted; it does not include the terminating quote. splitqword(s: string, start: int): ((int, int), int) { for(; start < len s; start++) if(s[start] != ' ') break; if(start >= len s) return ((start, start), start); i := start; end := -1; if(s[i] == '\''){ gotq := 0; for(i++; i < len s; i++){ if(s[i] == '\''){ if(i + 1 >= len s || s[i + 1] != '\''){ end = i+1; break; } i++; gotq = 1; } } if(!gotq && i > start+1) start++; if(end == -1) end = i; } else { for(; i < len s; i++) if(s[i] == ' ') break; end = i; } return ((start, i), end); } # unquote a string slice as returned by sliceqword. qslice(s: string, r: (int, int)): string { if(r.t0 == r.t1) return nil; if(s[r.t0] != '\'') return s[r.t0:r.t1]; t := ""; for(i := r.t0 + 1; i < r.t1; i++){ t[len t] = s[i]; if(s[i] == '\'') i++; } return t; } qword(s: string, start: int): (string, int) { (w, next) := splitqword(s, start); return (qslice(s, w), next); } s2r(s: string, e: int): (Rect, int) { r: Rect; w: string; (w, e) = qword(s, e); r.min.x = int w; (w, e) = qword(s, e); r.min.y = int w; (w, e) = qword(s, e); r.max.x = int w; (w, e) = qword(s, e); r.max.y = int w; return (r, e); } kill(pid: int, note: string): int { fd := sys->open("#p/"+string pid+"/ctl", Sys->OWRITE); if(fd == nil) # dodgy failover fd = sys->open("/prog/"+string pid+"/ctl", Sys->OWRITE); if(fd == nil || sys->fprint(fd, "%s", note) < 0) return -1; return 0; }