1implement Dividers; 2 3include "sys.m"; 4 sys: Sys; 5include "draw.m"; 6 draw: Draw; 7 Point, Rect: import draw; 8include "tk.m"; 9 tk: Tk; 10include "dividers.m"; 11 12Lay: adt { 13 d: int; 14 x: fn(l: self Lay, p: Point): int; 15 y: fn(l: self Lay, p: Point): int; 16 mkr: fn(l: self Lay, r: Rect): Rect; 17 mkpt: fn(l: self Lay, p: Point): Point; 18}; 19 20DIVHEIGHT: con 6; 21 22init() 23{ 24 sys = load Sys Sys->PATH; 25 draw = load Draw Draw->PATH; 26 tk = load Tk Tk->PATH; 27} 28 29# dir is direction in which to stack widgets (NS or EW) 30Divider.new(win: ref Tk->Toplevel, w: string, wl: list of string, dir: int): (ref Divider, chan of string) 31{ 32 lay := Lay(dir); 33 n := len wl; 34 d := ref Divider(win, w, nil, dir, array[n] of {* => ref DWidget}, (0, 0)); 35 p := Point(0, 0); 36 for (i := 0; wl != nil; (wl, i) = (tl wl, i+1)) { 37 sz := lay.mkpt(wsize(win, hd wl)); 38 *d.widgets[i] = (hd wl, (p, p.add(sz)), sz); 39 if (sz.x > d.canvsize.x) 40 d.canvsize.x = sz.x; 41 p.y += sz.y + DIVHEIGHT; 42 } 43 d.canvsize.y = p.y - DIVHEIGHT; 44 cmd(win, "canvas " + d.w + " -width " + string lay.x(d.canvsize) + 45 " -height " + string lay.y(d.canvsize)); 46 ech := chan of string; 47 echname := "dw" + d.w; 48 tk->namechan(win, ech, echname); 49 for (i = 0; i < n; i++) { 50 dw := d.widgets[i]; 51 dw.r.max.x = d.canvsize.x + dw.r.min.x; 52 sz := dxy(dw.r); 53 cmd(win, d.w + " create window " + p2s(lay.mkpt(dw.r.min)) + 54 " -window " + dw.w + 55 " -tags w" + string i + " -anchor nw" + 56 " -width " + string lay.x(sz) + 57 " -height " + string lay.y(sz)); 58 cmd(win, "pack propagate " + dw.w + " 0"); 59 if (i < n - 1) { 60 r := lay.mkr(((dw.r.min.x, dw.r.max.y), 61 (dw.r.max.x, dw.r.max.y + DIVHEIGHT))); 62 cmd(win, d.w + " create rectangle " + r2s(r) + 63 " -fill red" + 64 " -tags d" + string i); 65 cmd(win, d.w + " bind d" + string i + " <Button-1>" + 66 " {send " + echname + " but " + string i + " %x %y}"); 67 cmd(win, d.w + " bind d" + string i + " <Motion-Button-1> {}"); 68 cmd(win, d.w + " bind d" + string i + " <ButtonRelease-1>" + 69 " {send " + echname + " up x %x %y}"); 70 } 71 } 72 cmd(win, d.w + " create rectangle -2 -2 -1 -1 -tags grab"); 73 cmd(win, d.w + " bind grab <Button-1> {send " + echname + " drag x %x %y}"); 74 cmd(win, d.w + " bind grab <ButtonRelease-1> {send " + echname + " up x %x %y}"); 75 cmd(win, "bind " + d.w + " <Configure> {send " + echname + " config x x x}"); 76 return (d, ech); 77} 78 79Divider.event(d: self ref Divider, e: string) 80{ 81 (n, toks) := sys->tokenize(e, " "); 82 if (n != 4) { 83 sys->print("dividers: invalid event %s\n", e); 84 return; 85 } 86 lay := Lay(d.dir); 87 p := lay.mkpt((int hd tl tl toks, int hd tl tl tl toks)); 88 t := hd toks; 89 if (t == "but" && d.state != nil) 90 t = "drag"; 91 case t { 92 "but" => 93 if (d.state != nil) { 94 sys->print("dividers: event '%s' received in drag mode\n", e); 95 return; 96 } 97 div := int hd tl toks; 98 d.state = ref DState; 99 d.state.dragdiv = div; 100 d.state.dy = p.y - d.widgets[div].r.max.y; 101 d.state.maxy = d.widgets[div+1].r.max.y - DIVHEIGHT; 102 d.state.miny = d.widgets[div].r.min.y; 103 cmd(d.win, d.w + " itemconfigure d" + string div + " -fill orange"); 104 cmd(d.win, d.w + " raise d" + string div); 105 cmd(d.win, d.w + " coords grab -10000 -10000 10000 10000"); 106 cmd(d.win, "grab set " + d.w); 107 cmd(d.win, "update"); 108 "drag" => 109 if (d.state == nil) { 110 sys->print("dividers: event '%s' received in non-drag mode\n", e); 111 return; 112 } 113 div := d.state.dragdiv; 114 ypos := p.y - d.state.dy; 115 if (ypos > d.state.maxy) 116 ypos = d.state.maxy; 117 else if (ypos < d.state.miny) 118 ypos = d.state.miny; 119 r := Rect((0, ypos), (d.canvsize.x, ypos + DIVHEIGHT)); 120 cmd(d.win, d.w + " coords d" + string div + " " + r2s(lay.mkr(r))); 121 d.widgets[div].r.max.y = ypos; 122 d.widgets[div+1].r.min.y = ypos + DIVHEIGHT; 123 relayout(d); 124 cmd(d.win, "update"); 125 "up" => 126 if (d.state == nil) { 127 sys->print("dividers: event '%s' received in non-drag mode\n", e); 128 return; 129 } 130 div := d.state.dragdiv; 131 cmd(d.win, d.w + " itemconfigure d" + string div + " -fill red"); 132 cmd(d.win, d.w + " coords grab -2 -2 -1 -1"); 133 cmd(d.win, "grab release " + d.w); 134 cmd(d.win, "update"); 135 d.state = nil; 136 "config" => 137 resize(d); 138 cmd(d.win, "update"); 139 } 140} 141 142# lay out widgets according to rectangles that have been already specified. 143relayout(d: ref Divider) 144{ 145 lay := Lay(d.dir); 146 for (i := 0; i < len d.widgets; i++) { 147 dw := d.widgets[i]; 148 sz := dxy(dw.r); 149 szs := " -width " + string lay.x(sz) + " -height " + string lay.y(sz); 150 cmd(d.win, d.w + " coords w" + string i + " " + p2s(lay.mkpt(dw.r.min))); 151 cmd(d.win, d.w + " itemconfigure w" + string i + szs); 152 cmd(d.win, dw.w + " configure" + szs); 153 if (i < len d.widgets - 1) { 154 r := lay.mkr(((dw.r.min.x, dw.r.max.y), 155 (dw.r.max.x, dw.r.max.y + DIVHEIGHT))); 156 cmd(d.win, d.w + " coords d" + string i + " " + r2s(r)); 157 } 158 } 159} 160 161# resize based on current actual size of canvas; 162# sections resize proportionate to their previously occupied space. 163# strange things will happen if we're resizing in the middle of a drag... 164resize(d: ref Divider) 165{ 166 lay := Lay(d.dir); 167 sz := lay.mkpt((int cmd(d.win, d.w + " cget -actwidth"), 168 int cmd(d.win, d.w + " cget -actheight"))); 169 170 wspace := (len d.widgets - 1) * DIVHEIGHT; 171 y := 0; 172 for (i := 0; i < len d.widgets; i++) { 173 dw := d.widgets[i]; 174 prop := real dw.r.dy() / real (d.canvsize.y - wspace); 175 dw.r = ((0, y), (sz.x, y + int (prop * real (sz.y - wspace)))); 176 y = dw.r.max.y + DIVHEIGHT; 177 } 178 y -= DIVHEIGHT; 179 # compensate for rounding errors 180 d.widgets[i - 1].r.max.y -= y - sz.y; 181 d.canvsize = sz; 182 relayout(d); 183} 184 185wsize(win: ref Tk->Toplevel, w: string): Point 186{ 187 bw := int cmd(win, w + " cget -borderwidth"); 188 return Point(int cmd(win, w + " cget -width") + bw*2, 189 int cmd(win, w + " cget -height") + bw*2); 190} 191 192dxy(r: Rect): Point 193{ 194 return r.max.sub(r.min); 195} 196 197p2s(p: Point): string 198{ 199 return string p.x + " " + string p.y; 200} 201 202r2s(r: Rect): string 203{ 204 return string r.min.x + " " + string r.min.y + " " + 205 string r.max.x + " " + string r.max.y; 206} 207 208Lay.x(l: self Lay, p: Point): int 209{ 210 if (l.d == NS) 211 return p.x; 212 return p.y; 213} 214 215Lay.y(l: self Lay, p: Point): int 216{ 217 if (l.d == NS) 218 return p.y; 219 return p.x; 220} 221 222Lay.mkr(l: self Lay, r: Rect): Rect 223{ 224 if (l.d == NS) 225 return r; 226 return ((r.min.y, r.min.x), (r.max.y, r.max.x)); 227} 228 229Lay.mkpt(l: self Lay, p: Point): Point 230{ 231 if (l.d == NS) 232 return p; 233 return (p.y, p.x); 234} 235 236cmd(top: ref Tk->Toplevel, s: string): string 237{ 238 e := tk->cmd(top, s); 239 if (e != nil && e[0] == '!') 240 sys->print("dividers: tk error %s on '%s'\n", e, s); 241 return e; 242} 243