diff options
Diffstat (limited to 'appl/wm/smenu.b')
| -rw-r--r-- | appl/wm/smenu.b | 204 |
1 files changed, 204 insertions, 0 deletions
diff --git a/appl/wm/smenu.b b/appl/wm/smenu.b new file mode 100644 index 00000000..6b06754f --- /dev/null +++ b/appl/wm/smenu.b @@ -0,0 +1,204 @@ +implement Smenu; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "tk.m"; + tk: Tk; +include "smenu.m"; + +Scrollmenu.new(t: ref Tk->Toplevel, name: string, labs: array of string, e: int, o: int): ref Scrollmenu +{ + if(sys == nil) + sys = load Sys Sys->PATH; + if(tk == nil) + tk = load Tk Tk->PATH; + m := ref Scrollmenu; + n := len labs; + if(n < e) + e = n; + if(o > n-e) + o = n-e; + l := 0; + for(i := 0; i < n; i++){ + if(len labs[i] > l) + l = len labs[i]; + i++; + } + nlabs := array[n] of string; + sp := string array[l] of { * => byte ' ' }; + for(i = 0; i < n; i++) + nlabs[i] = labs[i] + sp[0: l - len labs[i]]; + sch := cname(name); + cmd(t, "menu " + name); + for(i = 0; i < e; i++){ + cmd(t, name + " add command -label {" + nlabs[o+i] + "} -command {send " + sch + " " + string i + "}"); + } + # cmd(t, "bind " + name + " <ButtonPress-1> +{send " + sch + " b}"); + # cmd(t, "bind " + name + " <ButtonRelease-1> +{send " + sch + " b}"); + cmd(t, "bind " + name + " <Motion> +{send " + sch + " M %x %y}"); + cmd(t, "bind " + name + " <Map> +{send " + sch + " m}"); + cmd(t, "bind " + name + " <Unmap> +{send " + sch + " u}"); + cmd(t, "update"); + m.name = name; + m.labs = nlabs; + m.c = nil; + m.t = t; + m.m = e; + m.n = n; + m.o = o; + m.timer = 1; + return m; +} + +Scrollmenu.post(m: self ref Scrollmenu, x: int, y: int, resc: chan of string, prefix: string) +{ + sync := chan of int; + spawn listen(m, sync, resc, prefix); + <- sync; + cmd(m.t, m.name + " post " + string x + " " + string y); + cmd(m.t, "update"); +} + +Scrollmenu.destroy(m: self ref Scrollmenu) +{ + if(m.c != nil){ + m.c <-= "u"; # fake unmap message + m.c = nil; + } + m.name = nil; + m.labs = nil; + m.t = nil; +} + +timer(t: int, sync: chan of int, c: chan of int) +{ + sync <-= 0; + for(;;){ + alt{ + c <-= 0 => + sys->sleep(t); + <- sync => + exit; + } + } +} + +TINT: con 100; +SEC: con 1000/TINT; + +listen(m: ref Scrollmenu, sync: chan of int, resc: chan of string, prefix: string) +{ + timerc := chan of int; + cmdc := chan of string; + m.c = cmdc; + tk->namechan(m.t, cmdc, cname(m.name)); + sync <-= 0; + x := y := ly := w := h := -1; + for(;;){ + alt{ + <- timerc => + if(x > 0 && x < w){ + if(y < 0 && y > -h/m.m) + menudir(m, -1); + else if(y > 0+h && y < h+h/m.m) + menudir(m, 1); + } + s := <- cmdc => + (nil, toks) := sys->tokenize(s, " "); + case hd toks{ + "M" => + x = int hd tl toks; + y = int hd tl tl toks; + if(!m.timer && x > 0 && x < w){ + mv := 0; + if(y < ly && y < 0) + mv = y/(h/m.m)-1; + else if(y > ly && y > h) + mv = (y-h)/(h/m.m)+1; + if(mv != 0) + menudirs(m, mv); + ly = y; + } + "m" => + w = int cmd(m.t, m.name + " cget -actwidth"); + h = int cmd(m.t, m.name + " cget -actheight"); + ly = -1; + if(m.timer){ + spawn timer(TINT, sync, timerc); + <- sync; + } + "u" => + if(m.timer) + sync <-= 0; + m.c = nil; + exit; + * => + # do not block + res := prefix + string (int hd toks + m.o); + for(t := 0; t < SEC; ){ + if(m.timer) + alt{ + resc <-= res => + t = SEC; + <- timerc => + t++; + } + else + alt{ + resc <-= res => + t = SEC; + * => + sys->sleep(TINT); + t++; + } + } + } + } + } +} + +menudirs(sm: ref Scrollmenu, n: int) +{ + if(n < 0) + (a, d) := (-n, -1); + else + (a, d) = (n, 1); + for(i := 0; i < a; i++) + menudir(sm, d); +} + +menudir(sm: ref Scrollmenu, d: int) +{ + o := sm.o; + n := sm.n; + m := sm.m; + if(d == -1){ + if(o == 0) + return; + for(i := 0; i < m; i++) + cmd(sm.t, sm.name + " entryconfigure " + string i + " -label {" + sm.labs[o-1+i] + "}"); + sm.o = o-1; + } + else{ + if(o+m == n) + return; + for(i := 0; i < m; i++) + cmd(sm.t, sm.name + " entryconfigure " + string i + " -label {" + sm.labs[o+1+i] + "}"); + sm.o = o+1; + } + cmd(sm.t, "update"); +} + +cname(s: string): string +{ + return "sm_" + s + "_sm"; +} + +cmd(top: ref Tk->Toplevel, s: string): string +{ + e := tk->cmd(top, s); + if (e != nil && e[0] == '!') + sys->fprint(sys->fildes(2), "Smenu: tk error on '%s': %s\n", s, e); + return e; +} |