| blob | e140f0b2fb64d26efd815db77a952d1d304b43cb |
1 {*
2 * Copyright (C) 2024 Mikulas Patocka
3 *
4 * This file is part of Ajla.
5 *
6 * Ajla is free software: you can redistribute it and/or modify it under the
7 * terms of the GNU General Public License as published by the Free Software
8 * Foundation, either version 3 of the License, or (at your option) any later
9 * version.
10 *
11 * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
12 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13 * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License along with
16 * Ajla. If not, see <https://www.gnu.org/licenses/>.
17 *}
19 private unit ui.widget.common;
21 uses ui.curses;
23 type wid;
24 const wid_none : wid;
25 fn wid_is_valid~inline(id : wid) : bool;
26 implicit fn instance_eq_wid : class_eq(wid);
28 type appstate;
29 type property;
31 record event_set_property [
32 prop : bytes;
33 val : property;
34 ]
36 option wevent [
37 keyboard : event_keyboard;
38 mouse : event_mouse;
39 resize : event_resize;
40 redraw : event_redraw;
41 set_property : event_set_property;
42 change_focus;
43 property_changed : bytes;
44 close;
45 quit;
46 noop;
47 ]
49 record wid_wevent [
50 id : wid;
51 wev : wevent;
52 ]
54 record widget_common [
55 self : wid;
56 parent : wid;
57 x y : int;
58 size_x size_y : int;
59 off_x off_y : int;
60 flt : bool;
61 sub_widgets : list(wid);
62 ]
64 record property_attrib [
65 fg_r fg_g fg_b bg_r bg_g bg_b : uint16;
66 attr mono : uint8;
67 ]
69 option property [
70 n;
71 o : bool;
72 i : int;
73 r : rational;
74 b : bytes;
75 s : string;
76 l : list(property);
77 a : property_attrib;
78 w : wid;
79 ]
81 record widget_class [
82 t : type;
83 name : bytes;
84 is_selectable : bool;
85 get_width : fn(appstate, widget_common, t, int) : int;
86 get_height : fn(appstate, widget_common, t, int) : int;
87 get_property : fn(appstate, widget_common, t, bytes) : property;
88 reflow : fn(appstate, widget_common, t) : (appstate, widget_common, t);
89 redraw : fn(appstate, curses, widget_common, t) : curses;
90 get_cursor : fn(appstate, widget_common, t) : (int, int);
91 get_pivot : fn(appstate, widget_common, t) : (int, int);
92 accepts_key : fn(appstate, widget_common, t, event_keyboard) : bool;
93 process_event : fn(world, appstate, widget_common, t, wevent) : (world, appstate, widget_common, t);
94 ]
96 option widget_align [
97 left;
98 center;
99 right;
100 ]
102 implicit fn instance_eq_property : class_eq(property);
104 fn widget_get_app(app : appstate) : wid;
105 fn widget_get_common(app : appstate, id : wid) : widget_common;
106 fn widget_get_class(app : appstate, id : wid) : bytes;
107 fn widget_get_underlying(app : appstate, id : wid) : wid;
108 fn widget_get_pivot(app : appstate, id : wid) : (int, int);
109 fn widget_get_width(app : appstate, id : wid, pref_x : int) : int;
110 fn widget_get_height(app : appstate, id : wid, x : int) : int;
111 fn widget_get_property(app : appstate, id : wid, prop : bytes) : property;
112 fn widget_send_async_event(w : world, app : appstate, id : wid, wev : wevent) : world;
113 fn widget_get_async_event_function(w : world, app : appstate, id : wid) : fn(ww : world, wev : wevent) : world;
114 fn widget_get_async_event_exchange_function(w : world, app : appstate, id : wid) : fn(ww : world, wev : wevent) : world;
115 fn widget_relative_mouse_coords(app : appstate, id : wid, m : event_mouse) : (int, int);
116 fn widget_enqueue_events(app : appstate, wev : list(wid_wevent)) : appstate;
117 fn widget_enqueue_event(app : appstate, id : wid, wev : wevent) : appstate;
118 fn widget_enqueue_event_to_underlying(app : appstate, id : wid, wev : wevent) : appstate;
119 fn widget_move(app : appstate, id : wid, x y size_x size_y off_x off_y : int) : appstate;
120 fn widget_place(app : appstate, id : wid, offs_x : int, size_x : int, yp : int) : (appstate, int);
121 fn widgets_get_width(app : appstate, ids : list(wid), x_space : int, x : int) : int;
122 fn widgets_place(app : appstate, ids : list(wid), align : widget_align, x_space y_space : int, offs_x : int, size_x : int, yp : int) : (appstate, int);
123 fn widget_is_top(app : appstate, id : wid) : bool;
124 fn widget_redraw_subwidgets(app : appstate, curs : curses, com : widget_common) : curses;
125 fn widget_get_cursor(implicit app : appstate, id : wid) : (int, int);
126 fn widget_accepts_key(app : appstate, id : wid, wev : wevent) : bool;
127 fn widget_should_forward(app : appstate, com : widget_common, wev : wevent) : bool;
128 fn widget_activate(w : world, app : appstate, com : widget_common, id : wid) : (world, appstate, widget_common);
129 fn widget_forward(w : world, app : appstate, com : widget_common, wev : wevent) : (world, appstate, widget_common);
130 fn widget_new(w : world, app : appstate, parent : wid, const cls : widget_class, init : fn(world, appstate, wid) : (world, appstate, cls.t), flt : bool) : (world, appstate, wid);
131 fn widget_new_window(w : world, app : appstate, const cls : widget_class, init : fn(world, appstate, wid) : (world, appstate, cls.t), flt : bool) : (world, appstate, wid);
132 fn widget_destroy_onclick(app : appstate, id : wid) : appstate;
134 fn property_get(app : appstate, name : bytes) : property;
135 fn property_set(app : appstate, name : bytes, value : property) : appstate;
136 fn property_observe(app : appstate, id : wid, name : bytes) : appstate;
137 fn property_serialize(p : property) : bytes;
138 fn property_deserialize(b : bytes) : property;
139 fn property_save(app : appstate, names : list(bytes)) : bytes;
140 fn property_load(implicit app : appstate, names : list(bytes), str : bytes) : appstate;
142 fn properties_backup(app : appstate, names : list(bytes)) : appstate;
143 fn properties_revert(app : appstate, names : list(bytes)) : appstate;
145 fn new_property_attrib(fg_r fg_g fg_b bg_r bg_g bg_b : uint16, attr mono : uint8) : property_attrib;
146 fn property_get_attrib(app : appstate, name : bytes, fg_r fg_g fg_b bg_r bg_g bg_b : uint16, mono attr : uint8) : property_attrib;
147 fn property_set_attrib(a : property_attrib, curs : curses) : curses;
149 fn app_suspend(w : world, app : appstate) : (world, appstate);
150 fn app_resume(w : world, app : appstate) : (world, appstate);
151 fn app_run(w : world, d : dhandle, h : list(handle), env : treemap(bytes, bytes), const cls : widget_class, init : fn(world, appstate, wid) : (world, appstate, cls.t)) : world;
153 implementation
155 uses exception;
157 type wid := int32;
158 const wid_none : wid := -1;
159 fn wid_is_valid~inline(id : wid) : bool := id <> wid_none;
161 implicit fn instance_eq_wid : class_eq(wid) :=
162 class_eq(wid).[
163 equal : lambda(a b : wid) [ return a = b; ],
164 ];
166 record widget [
167 common : widget_common;
168 const cls : widget_class;
169 state : cls.t;
170 ]
172 record widget_property [
173 val : property;
174 observers : list(wid);
175 ]
177 record appstate [
178 d : dhandle;
179 h : list(handle);
180 env : treemap(bytes, bytes);
181 widgets : list(widget);
182 wm_wid : wid;
183 app_wid : wid;
184 curs : curses;
185 events : list(wid_wevent);
186 properties : list(widget_property);
187 async_mq : msgqueue(wevent);
188 ]
190 fn widget_get_app(app : appstate) : wid
191 [
192 return app.app_wid;
193 ]
195 fn widget_get_common(app : appstate, id : wid) : widget_common
196 [
197 return app.widgets[id].common;
198 ]
200 fn widget_get_class(app : appstate, id : wid) : bytes
201 [
202 return app.widgets[id].cls.name;
203 ]
205 fn widget_get_underlying(app : appstate, id : wid) : wid
206 [
207 const wi := app.widgets[id];
208 const pa := app.widgets[wi.common.parent];
209 var u := wid_none;
210 for i := 0 to len(pa.common.sub_widgets) do [
211 if pa.common.sub_widgets[i] = id then
212 return u;
213 u := pa.common.sub_widgets[i];
214 ]
215 abort internal("widget_get_underlying: widget not found in the parent list");
216 ]
218 fn widget_get_pivot(app : appstate, id : wid) : (int, int)
219 [
220 const wi := app.widgets[id];
221 const pa := app.widgets[wi.common.parent];
222 var pivot_x, pivot_y := 0, 0;
223 for i := 0 to len(pa.common.sub_widgets) do [
224 if pa.common.sub_widgets[i] = id then [
225 return pivot_x, pivot_y;
226 ]
227 const un := app.widgets[pa.common.sub_widgets[i]];
228 if not is_uninitialized_record(un.cls.get_pivot) then [
229 pivot_x, pivot_y := un.cls.get_pivot(app, un.common, un.state);
230 pivot_x += un.common.x;
231 pivot_y += un.common.y;
232 ]
233 ]
234 abort internal("widget_get_pivot: widget not found in the parent list");
235 ]
237 fn widget_get_width(app : appstate, id : wid, pref_x : int) : int
238 [
239 const wi := app.widgets[id];
240 if is_uninitialized_record(wi.cls.get_width) then
241 return pref_x;
242 return wi.cls.get_width(app, wi.common, wi.state, pref_x);
243 ]
245 fn widget_get_height(app : appstate, id : wid, x : int) : int
246 [
247 const wi := app.widgets[id];
248 if is_uninitialized_record(wi.cls.get_height) then
249 return 1;
250 return wi.cls.get_height(app, wi.common, wi.state, x);
251 ]
253 fn widget_send_async_event(implicit w : world, app : appstate, id : wid, wev : wevent) : world
254 [
255 msgqueue_send(app.async_mq, id, wev);
256 ]
258 fn widget_get_async_event_function(w : world, app : appstate, id : wid) : fn(ww : world, wev : wevent) : world
259 [
260 return lambda(ww : world, wev : wevent) : world [
261 return msgqueue_send(ww, wevent, app.async_mq, id, wev);
262 ];
263 ]
265 fn widget_get_async_event_exchange_function(w : world, app : appstate, id : wid) : fn(ww : world, wev : wevent) : world
266 [
267 return lambda(ww : world, wev : wevent) : world [
268 var nw, xtag, xev := msgqueue_receive_tag_nonblock(ww, wevent, app.async_mq, id);
269 eval nw;
270 return msgqueue_send(ww, wevent, app.async_mq, id, wev);
271 ];
272 ]
274 fn widget_get_property(app : appstate, id : wid, prop : bytes) : property
275 [
276 const wi := app.widgets[id];
277 if is_uninitialized_record(wi.cls.get_property) then
278 return property.n;
279 return wi.cls.get_property(app, wi.common, wi.state, prop);
280 ]
282 fn widget_relative_mouse_coords(app : appstate, id : wid, m : event_mouse) : (int, int)
283 [
284 var x := m.x;
285 var y := m.y;
286 while id <> wid_none do [
287 var com := app.widgets[id].common;
288 x -= com.x;
289 y -= com.y;
290 x -= com.off_x;
291 y -= com.off_y;
292 id := com.parent;
293 ]
294 return x, y;
295 ]
297 fn widget_enqueue_events(implicit app : appstate, wev : list(wid_wevent)) : appstate
298 [
299 app.events := wev + app.events;
300 ]
302 fn widget_enqueue_event(implicit app : appstate, id : wid, wev : wevent) : appstate
303 [
304 return widget_enqueue_events([ wid_wevent.[
305 id : id,
306 wev : wev,
307 ] ]);
308 ]
310 fn widget_enqueue_event_to_underlying(implicit app : appstate, id : wid, wev : wevent) : appstate
311 [
312 var u := widget_get_underlying(id);
313 if wid_is_valid(u) then
314 widget_enqueue_event(u, wev);
315 ]
317 fn widget_move(implicit app : appstate, id : wid, x y size_x size_y off_x off_y : int) : appstate
318 [
319 app.widgets[id].common.x := x;
320 app.widgets[id].common.y := y;
321 app.widgets[id].common.size_x := size_x;
322 app.widgets[id].common.size_y := size_y;
323 app.widgets[id].common.off_x := off_x;
324 app.widgets[id].common.off_y := off_y;
325 if not is_uninitialized_record(app.widgets[id].cls.reflow) then [
326 mutable wi := app.widgets[id];
327 wi.common, wi.state := wi.cls.reflow(wi.common, wi.state);
328 app.widgets[id] := wi;
329 ]
330 ]
332 fn widget_place(implicit app : appstate, id : wid, offs_x : int, size_x : int, yp : int) : (appstate, int)
333 [
334 var ys := widget_get_height(id, size_x);
335 widget_move(id, offs_x, yp, size_x, ys, 0, 0);
336 return yp + ys;
337 ]
339 record widget_flow_line [
340 ids : list(wid);
341 x : list(int);
342 width : list(int);
343 x_size : int;
344 ]
346 fn widgets_flow(implicit app : appstate, ids : list(wid), x_space : int, pref_x : int) : list(widget_flow_line)
347 [
348 var flow := empty(widget_flow_line);
349 var flow_line := widget_flow_line.[ ids : empty(wid), x : empty(int), width : empty(int), x_size : 0 ];
350 var x := 0;
351 for i := 0 to len(ids) do [
352 var l := widget_get_width(ids[i], pref_x);
353 if x > 0, x + x_space + l > pref_x then [
354 flow +<= flow_line;
355 flow_line := widget_flow_line.[ ids : empty(wid), x : empty(int), width : empty(int), x_size : 0 ];
356 x := 0;
357 ]
358 x += select(x > 0, 0, x_space);
359 flow_line.ids +<= ids[i];
360 flow_line.x +<= x;
361 flow_line.width +<= l;
362 x += l;
363 flow_line.x_size := x;
364 ]
365 if x > 0 then
366 flow +<= flow_line;
367 return flow;
368 ]
370 fn widgets_get_width(implicit app : appstate, ids : list(wid), x_space : int, pref_x : int) : int
371 [
372 var flow := widgets_flow(ids, x_space, pref_x);
374 var max_x := 0;
375 for i := 0 to len(flow) do [
376 max_x := max(max_x, flow[i].x_size);
377 ]
379 return max_x;
380 ]
382 fn widgets_place(implicit app : appstate, ids : list(wid), align : widget_align, x_space y_space : int, offs_x : int, size_x : int, yp : int) : (appstate, int)
383 [
384 var flow := widgets_flow(ids, x_space, size_x);
385 for i := 0 to len(flow) do [
386 if i > 0 then
387 yp += y_space;
388 var flow_line := flow[i];
389 var x_offset := offs_x;
390 if align is center then
391 x_offset += size_x - flow_line.x_size shr 1;
392 if align is right then
393 x_offset += size_x - flow_line.x_size;
394 var y_size := 0;
395 for j := 0 to len(flow_line.ids) do [
396 var yh := widget_get_height(flow_line.ids[j], flow_line.width[j]);
397 widget_move(flow_line.ids[j], x_offset + flow_line.x[j], yp, flow_line.width[j], yh, 0, 0);
398 y_size := max(y_size, yh);
399 ]
400 yp += y_size;
401 ]
402 return yp;
403 ]
405 fn widget_get_top(implicit app : appstate, id : wid) : wid
406 [
407 if not wid_is_valid(id) then
408 return wid_none;
409 const wi := app.widgets[id];
410 var idx := len(wi.common.sub_widgets) - 1;
411 while idx >= 0, app.widgets[wi.common.sub_widgets[idx]].common.flt do
412 idx -= 1;
413 if idx >= 0 then
414 return wi.common.sub_widgets[idx];
415 return wid_none;
416 ]
418 fn widget_is_top(implicit app : appstate, id : wid) : bool
419 [
420 var top := widget_get_top(app.widgets[id].common.parent);
421 return id = top;
422 ]
424 fn wi_to_rect(com : widget_common) : rect
425 [
426 return rect.[ x1 : com.x, x2 : com.x + com.size_x, y1 : com.y, y2 : com.y + com.size_y ];
427 ]
429 fn widget_redraw_subwidgets(implicit app : appstate, implicit curs : curses, com : widget_common) : curses
430 [
431 for i := 0 to len(com.sub_widgets) do [
432 var id := com.sub_widgets[i];
433 const wi := app.widgets[id];
434 var sc := curses_get_scissors();
435 sc := rect_intersection(sc, wi_to_rect(wi.common));
436 var rs := [ sc ];
437 for j := i + 1 to len(com.sub_widgets) do [
438 var id2 := com.sub_widgets[j];
439 const wi2 := app.widgets[id2];
440 var r := wi_to_rect(wi2.common);
441 rs := rect_set_exclude(rs, r);
442 ]
443 var r := rect_set_to_rect(rs);
444 curses_restrict_viewport(r.x1, r.x2, r.y1, r.y2, wi.common.x, wi.common.y);
445 if curses_valid_viewport() then
446 wi.cls.redraw(wi.common, wi.state);
447 curses_revert_viewport();
448 ]
449 ]
451 fn widget_get_cursor(implicit app : appstate, id : wid) : (int, int)
452 [
453 var cx, cy := -1, -1;
454 var xo, yo := 0, 0;
455 go_down:
456 const wi := app.widgets[id];
457 xo += wi.common.x + wi.common.off_x;
458 yo += wi.common.y + wi.common.off_y;
459 if not is_uninitialized_record(wi.cls.get_cursor) then [
460 var x, y := wi.cls.get_cursor(wi.common, wi.state);
461 if x >= 0, y >= 0 then
462 cx, cy := x + xo, y + yo;
463 return cx, cy;
464 ]
465 id := widget_get_top(id);
466 if wid_is_valid(id) then
467 goto go_down;
468 return cx, cy;
469 ]
471 fn set_cursor(implicit app : appstate, implicit curs : curses) : curses
472 [
473 curses_set_cursor(widget_get_cursor(app.wm_wid));
474 ]
476 fn widget_accepts_key(implicit app : appstate, id : wid, wev : wevent) : bool
477 [
478 if wev is keyboard then [
479 const wi := app.widgets[id];
480 if is_uninitialized_record(wi.cls.accepts_key) then
481 return true;
482 return wi.cls.accepts_key(wi.common, wi.state, wev.keyboard);
483 ]
484 return false;
485 ]
487 fn widget_should_forward(implicit app : appstate, implicit com : widget_common, wev : wevent) : bool
488 [
489 var l := len(com.sub_widgets);
490 if l = 0 then
491 return false;
492 return widget_accepts_key(com.sub_widgets[l - 1], wev);
493 ]
495 fn widget_select(implicit w : world, implicit app : appstate, implicit com : widget_common, wev : wevent) : (world, appstate, widget_common)
496 [
497 var l := len(com.sub_widgets);
498 var old_top := com.sub_widgets[l - 1];
499 var fwd : bool;
500 if wev is keyboard then [
501 if wev.keyboard.key = key_right or wev.keyboard.key = key_down or (wev.keyboard.key = key_tab and wev.keyboard.flags = 0) then [
502 fwd := true;
503 goto rotate;
504 ]
505 if wev.keyboard.key = key_left or wev.keyboard.key = key_up or (wev.keyboard.key = key_tab and wev.keyboard.flags <> 0) then [
506 fwd := false;
507 goto rotate;
508 ]
509 ]
510 if wev is mouse, wev.mouse.buttons <> 0 or wev.mouse.prev_buttons <> 0 or wev.mouse.wx <> 0 or wev.mouse.wy <> 0 then [
511 var sw : wid;
512 var mx, my := widget_relative_mouse_coords(com.self, wev.mouse);
513 for i := 0 to l do [
514 sw := com.sub_widgets[i];
515 var r := rect.[
516 x1 : app.widgets[sw].common.x,
517 x2 : app.widgets[sw].common.x + app.widgets[sw].common.size_x,
518 y1 : app.widgets[sw].common.y,
519 y2 : app.widgets[sw].common.y + app.widgets[sw].common.size_y,
520 ];
521 if app.widgets[sw].cls.is_selectable, rect_test_point(r, mx, my) then
522 goto have_it;
523 ]
524 return;
525 have_it:
526 while com.sub_widgets[l - 1] <> sw do [
527 com.sub_widgets := [ com.sub_widgets[l - 1] ] + com.sub_widgets[ .. l - 1];
528 ]
529 widget_enqueue_event(sw, wev);
530 goto new_top_redraw;
531 ]
532 return;
534 rotate:
535 if fwd then [
536 com.sub_widgets := [ com.sub_widgets[l - 1] ] + com.sub_widgets[ .. l - 1];
537 ] else [
538 com.sub_widgets := com.sub_widgets[1 .. ] + [ com.sub_widgets[0] ];
539 ]
540 if not app.widgets[com.sub_widgets[l - 1]].cls.is_selectable then
541 goto rotate;
543 new_top_redraw:
544 var new_top := com.sub_widgets[l - 1];
545 if old_top = new_top then
546 return;
548 widget_enqueue_event(new_top, wevent.change_focus);
549 widget_enqueue_event(old_top, wevent.change_focus);
550 ]
552 fn widget_activate(implicit w : world, implicit app : appstate, implicit com : widget_common, id : wid) : (world, appstate, widget_common)
553 [
554 var l := len(com.sub_widgets);
555 var old_top := com.sub_widgets[l - 1];
557 while com.sub_widgets[l - 1] <> id do [
558 com.sub_widgets := [ com.sub_widgets[l - 1] ] + com.sub_widgets[ .. l - 1];
559 ]
561 var new_top := com.sub_widgets[l - 1];
562 if old_top = new_top then
563 return;
565 widget_enqueue_event(new_top, wevent.change_focus);
566 widget_enqueue_event(old_top, wevent.change_focus);
567 ]
569 fn widget_forward(implicit w : world, implicit app : appstate, implicit com : widget_common, wev : wevent) : (world, appstate, widget_common)
570 [
571 if widget_should_forward(wev) then [
572 widget_enqueue_event(com.sub_widgets[len(com.sub_widgets) - 1], wev);
573 return;
574 ]
575 if wev is keyboard or wev is mouse then [
576 widget_select(wev);
577 ]
578 ]
580 fn widget_new(implicit w : world, implicit app : appstate, parent : wid, const cls : widget_class, init : fn(world, appstate, wid) : (world, appstate, cls.t), flt : bool) : (world, appstate, wid)
581 [
582 var id : wid := len(app.widgets);
583 app.widgets +<= widget.[
584 common : widget_common.[
585 self : id,
586 parent : parent,
587 x : 0,
588 y : 0,
589 size_x : 0,
590 size_y : 0,
591 off_x : 0,
592 off_y : 0,
593 flt : flt,
594 sub_widgets : empty(wid),
595 ],
596 cls : cls,
597 ];
598 var x : cls.t;
599 x := init(id);
600 mutable wi := widget.[
601 common : app.widgets[id].common,
602 cls : cls,
603 state : x,
604 ];
605 app.widgets[id] := wi;
606 if wid_is_valid(parent) then [
607 var pos := len(app.widgets[parent].common.sub_widgets);
608 while pos > 0, app.widgets[app.widgets[parent].common.sub_widgets[pos - 1]].common.flt do
609 pos -= 1;
610 app.widgets[parent].common.sub_widgets := app.widgets[parent].common.sub_widgets[ .. pos] + [ id ] + app.widgets[parent].common.sub_widgets[pos .. ];
611 ]
612 return id;
613 ]
615 fn widget_new_window(implicit w : world, implicit app : appstate, const cls : widget_class, init : fn(world, appstate, wid) : (world, appstate, cls.t), flt : bool) : (world, appstate, wid)
616 [
617 var old_top := widget_get_top(app.wm_wid);
618 var id := widget_new(app.wm_wid, cls, init, flt);
619 widget_enqueue_event(id, wevent.resize.(event_resize.[
620 x : app.widgets[app.wm_wid].common.size_x,
621 y : app.widgets[app.wm_wid].common.size_y,
622 ]));
623 var new_top := widget_get_top(app.wm_wid);
624 if old_top <> new_top then [
625 if wid_is_valid(old_top) then
626 widget_enqueue_event(old_top, wevent.change_focus);
627 if wid_is_valid(new_top) then
628 widget_enqueue_event(new_top, wevent.change_focus);
629 ]
630 return id;
631 ]
633 fn widget_destroy_onclick(implicit app : appstate, id : wid) : appstate
634 [
635 if app.widgets[app.widgets[id].common.parent].cls.name = "dialog" then [
636 widget_enqueue_event(app.widgets[id].common.parent, wevent.close);
637 ] else [
638 var events := empty(wid_wevent);
639 while app.widgets[id].cls.name = "menu" or app.widgets[id].cls.name = "mainmenu" do [
640 events +<= wid_wevent.[
641 id : id,
642 wev : wevent.close,
643 ];
644 id := widget_get_underlying(id);
645 ]
646 widget_enqueue_events(events);
647 ]
648 ]
650 record wm_state [
651 ]
653 fn wm_init(implicit w : world, implicit app : appstate, id : wid) : (world, appstate, wm_state)
654 [
655 return wm_state.[ ];
656 ]
659 fn wm_redraw(implicit app : appstate, implicit curs : curses, com : widget_common, st : wm_state) : curses
660 [
661 widget_redraw_subwidgets(com);
662 ]
664 fn wm_process_event(implicit w : world, implicit app : appstate, implicit com : widget_common, implicit st : wm_state, wev : wevent) : (world, appstate, widget_common, wm_state)
665 [
666 //eval debug("wm_process_event: received event");
667 if wev is resize then [
668 com.size_x := wev.resize.x;
669 com.size_y := wev.resize.y;
670 var wwl := empty(wid_wevent);
671 for i := 0 to len(com.sub_widgets) do [
672 wwl +<= wid_wevent.[
673 id : com.sub_widgets[i],
674 wev : wev,
675 ];
676 ]
677 wwl +<= wid_wevent.[
678 id : com.self,
679 wev : wevent.redraw.(event_redraw.[
680 x1 : 0,
681 y1 : 0,
682 x2 : wev.resize.x,
683 y2 : wev.resize.y,
684 ]),
685 ];
686 widget_enqueue_events(wwl);
687 return;
688 ]
689 if len(com.sub_widgets) = 0 then
690 return;
691 const sub := app.widgets[com.sub_widgets[len(com.sub_widgets) - 1]];
692 widget_enqueue_event(sub.common.self, wev);
693 ]
695 const wm_class~flat := widget_class.[
696 t : wm_state,
697 name : "wm",
698 is_selectable : true,
699 redraw : wm_redraw,
700 process_event : wm_process_event,
701 ];
703 fn get_redraw_rect(implicit app : appstate, id : wid, r : rect) : rect
704 [
705 while id <> wid_none do [
706 var com := app.widgets[id].common;
707 r.x1 += com.x;
708 r.x2 += com.x;
709 r.y1 += com.y;
710 r.y2 += com.y;
711 id := com.parent;
712 if id <> wid_none then [
713 var com := app.widgets[id].common;
714 r.x1 += com.off_x;
715 r.x2 += com.off_x;
716 r.y1 += com.off_y;
717 r.y2 += com.off_y;
718 ]
719 ];
720 return r;
721 ]
723 fn do_redraw(implicit app : appstate, r : rect) : appstate
724 [
725 const wm := app.widgets[app.wm_wid];
726 implicit curs := app.curs;
727 curses_restrict_viewport(r.x1, r.x2, r.y1, r.y2, 0, 0);
728 wm.cls.redraw(wm.common, wm.state);
729 curses_revert_viewport();
730 app.curs := curs;
731 ]
733 fn delete_widget(implicit app : appstate, id : wid) : appstate
734 [
735 const wi := app.widgets[id];
736 for i := 0 to len(wi.common.sub_widgets) do [
737 delete_widget(wi.common.sub_widgets[i]);
738 ]
739 var parent := wi.common.parent;
740 var old_top := widget_get_top(parent);
741 const pa := app.widgets[parent];
742 for i := 0 to len(pa.common.sub_widgets) do [
743 if pa.common.sub_widgets[i] = id then [
744 app.widgets[parent].common.sub_widgets := app.widgets[parent].common.sub_widgets[ .. i] + app.widgets[parent].common.sub_widgets[i + 1 .. ];
745 app.widgets[id] := uninitialized(widget);
746 var new_top := widget_get_top(parent);
747 if old_top <> new_top then [
748 if wid_is_valid(old_top) then
749 widget_enqueue_event(old_top, wevent.change_focus);
750 if wid_is_valid(new_top) then
751 widget_enqueue_event(new_top, wevent.change_focus);
752 ]
753 return;
754 ]
755 ]
756 abort internal("delete_widget: widget not found in the parent list");
757 ]
759 fn property_equal(a b : property) : bool
760 [
761 if ord a <> ord b then
762 return false;
763 if a is n then
764 return true;
765 if a is o then
766 return a.o = b.o;
767 if a is i then
768 return a.i = b.i;
769 if a is r then
770 return a.r = b.r;
771 if a is b then
772 return a.b = b.b;
773 if a is s then
774 return a.s = b.s;
775 if a is l then
776 return a.l = b.l;
777 if a is a then
778 return a.a.fg_r = b.a.fg_r and
779 a.a.fg_g = b.a.fg_g and
780 a.a.fg_b = b.a.fg_b and
781 a.a.bg_r = b.a.bg_r and
782 a.a.bg_g = b.a.bg_g and
783 a.a.bg_b = b.a.bg_b and
784 a.a.attr = b.a.attr and
785 a.a.mono = b.a.mono;
786 if a is w then
787 return a.w = b.w;
788 abort internal("property_equal: impossible option type " + ntos(ord a));
789 ]
791 implicit fn instance_eq_property : class_eq(property) :=
792 class_eq(property).[
793 equal : property_equal,
794 ];
796 fn property_to_id(name : bytes) : int
797 [
798 var result := 0;
799 for i := 0 to len(name) do [
800 var c := name[i];
801 result := (result shl 8) + c;
802 ]
803 return result;
804 ]
806 fn property_get(app : appstate, name : bytes) : property
807 [
808 var n := property_to_id(name);
809 var p := app.properties[n].val;
810 if is_uninitialized(p) then
811 return property.n;
812 {
813 var s := property_serialize(p);
814 var p2 := property_deserialize(s);
815 if p <> p2 then
816 abort internal("error deserializing " + ntos(ord p) + " -> " + ntos(ord p2));
817 }
818 return p;
819 ]
821 fn property_set(implicit app : appstate, name : bytes, value : property) : appstate
822 [
823 var n := property_to_id(name);
824 if is_uninitialized(app.properties[n]) then [
825 app.properties[n] := widget_property.[
826 val : property.n,
827 observers : empty(wid),
828 ];
829 ]
831 if app.properties[n].val <> value then [
832 app.properties[n].val := value;
834 var i := 0;
835 while i < len(app.properties[n].observers) do [
836 var id := app.properties[n].observers[i];
837 if is_uninitialized(app.widgets[id]) then [
838 app.properties[n].observers := app.properties[n].observers[ .. i] + app.properties[n].observers[i + 1 .. ];
839 continue;
840 ]
841 widget_enqueue_event(id, wevent.property_changed.(name));
842 i += 1;
843 ]
844 ]
845 ]
847 fn property_observe(app : appstate, id : wid, name : bytes) : appstate
848 [
849 var n := property_to_id(name);
850 if is_uninitialized(app.properties[n]) then [
851 app.properties[n] := widget_property.[
852 val : property.n,
853 observers : empty(wid),
854 ];
855 ]
856 app.properties[n].observers +<= id;
857 return app;
858 ]
860 fn property_serialize(p : property) : bytes
861 [
862 if p is n then
863 return "n";
864 if p is o then
865 return "o:" + select(p.o, "0", "1");
866 if p is i then
867 return "i:" + ntos(p.i);
868 if p is r then
869 return "r:" + ntos(p.r.num) + "." + ntos(p.r.den);
870 if p is b then [
871 var r := "b:";
872 for x in p.b do
873 r += ntos(x) + ".";
874 return r;
875 ]
876 if p is s then [
877 var r := "s:";
878 for x in p.s do
879 r += ntos(x) + ".";
880 return r;
881 ]
882 if p is l then [
883 var r:= "l:";
884 for x in p.l do
885 r += "(" + property_serialize(x) + ")";
886 return r;
887 ]
888 if p is a then [
889 return "a:" + ntos(p.a.fg_r) + "." + ntos(p.a.fg_g) + "." + ntos(p.a.fg_b) + "." +
890 ntos(p.a.bg_r) + "." + ntos(p.a.bg_g) + "." + ntos(p.a.bg_b) + "." +
891 ntos(p.a.attr) + "." + ntos(p.a.mono);
892 ]
893 if p is w then
894 return "w:" + ntos(p.w);
895 abort internal("property_serialize: impossible option type " + ntos(ord p));
896 ]
898 fn property_deserialize(b : bytes) : property
899 [
900 if b = "n" then
901 return property.n;
902 if b = "o:0" then
903 return property.o.(false);
904 if b = "o:1" then
905 return property.o.(true);
906 if b[0] = 'i', b[1] = ':' then
907 return property.i.(ston(b[2 .. ]));
908 if b[0] = 'r', b[1] = ':' then [
909 b := b[2 .. ];
910 var idx := list_search(b, '.');
911 return property.r.(rational.[ num : ston(b[ .. idx]), den : ston(b[idx + 1 .. ])]);
912 ]
913 if b[0] = 'b', b[1] = ':' then [
914 var l := list_break(b[2 .. ], '.');
915 var res := empty(byte);
916 for x in l do
917 res +<= ston(x);
918 return property.b.(res);
919 ]
920 if b[0] = 's', b[1] = ':' then [
921 var l := list_break(b[2 .. ], '.');
922 var res := empty(char);
923 for x in l do
924 res +<= ston(x);
925 return property.s.(res);
926 ]
927 if b[0] = 'l', b[1] = ':' then [
928 var res := empty(property);
929 b := b[2 .. ];
930 while len_greater_than(b, 0) do [
931 var depth := 0;
932 var idx : int;
933 for i := 0 to len(b) do [
934 if b[i] = '(' then
935 depth += 1;
936 if b[i] = ')' then [
937 depth -= 1;
938 if depth = 0 then [
939 idx := i;
940 goto have_it;
941 ]
942 ]
943 ]
944 abort;
945 have_it:
946 res +<= property_deserialize(b[1 .. idx]);
947 b := b[idx + 1 .. ];
948 ]
949 return property.l.(res);
950 ]
951 if b[0] = 'a', b[1] = ':' then [
952 var l := list_break(b[2 .. ], '.');
953 var n := map(l, ston);
954 return property.a.(property_attrib.[
955 fg_r : n[0],
956 fg_g : n[1],
957 fg_b : n[2],
958 bg_r : n[3],
959 bg_g : n[4],
960 bg_b : n[5],
961 attr : n[6],
962 mono : n[7],
963 ]);
964 ]
965 if b[0] = 'w', b[1] = ':' then [
966 return property.w.(ston(b[2 .. ]));
967 ]
968 abort;
969 ]
971 fn property_save(implicit app : appstate, names : list(bytes)) : bytes
972 [
973 var saved := "";
974 for n in names do [
975 var p := property_get(n);
976 var s := property_serialize(p);
977 saved += n + ":" + s + nl;
978 ]
979 return saved;
980 ]
982 fn property_load(implicit app : appstate, names : list(bytes), str : bytes) : appstate
983 [
984 var ts := treeset_from_list(names);
985 var lines := list_break_to_lines(str);
986 for line in lines do [
987 var c := list_search(line, ':');
988 if c = -1 then
989 continue;
990 var name := line[ .. c];
991 if not treeset_test(ts, name) then
992 continue;
993 var prop := property_deserialize(line[c + 1 .. ]);
994 if not is_exception prop then
995 property_set(name, prop);
996 ]
997 ]
999 fn properties_backup(implicit app : appstate, names : list(bytes)) : appstate
1000 [
1001 for i := 0 to len(names) do [
1002 property_set("backup-" + names[i], property_get(names[i]));
1003 ]
1004 ]
1006 fn properties_revert(implicit app : appstate, names : list(bytes)) : appstate
1007 [
1008 for i := 0 to len(names) do [
1009 property_set(names[i], property_get("backup-" + names[i]));
1010 ]
1011 ]
1013 fn new_property_attrib(fg_r fg_g fg_b bg_r bg_g bg_b : uint16, attr mono : uint8) : property_attrib
1014 [
1015 return property_attrib.[
1016 fg_r : fg_r,
1017 fg_g : fg_g,
1018 fg_b : fg_b,
1019 bg_r : bg_r,
1020 bg_g : bg_g,
1021 bg_b : bg_b,
1022 attr : attr,
1023 mono : mono,
1024 ];
1025 ]
1027 fn property_get_attrib(implicit app : appstate, name : bytes, fg_r fg_g fg_b bg_r bg_g bg_b : uint16, attr mono : uint8) : property_attrib
1028 [
1029 var p := property_get(name);
1030 if p is a then
1031 return p.a;
1032 else
1033 return new_property_attrib(fg_r, fg_g, fg_b, bg_r, bg_g, bg_b, attr, mono);
1034 ]
1036 fn property_set_attrib(a : property_attrib, implicit curs : curses) : curses
1037 [
1038 if curses_n_colors() >= 16 then [
1039 curses_set_fgcolor(a.fg_r, a.fg_g, a.fg_b);
1040 curses_set_bgcolor(a.bg_r, a.bg_g, a.bg_b);
1041 curses_set_attributes(a.attr);
1042 ] else [
1043 curses_set_fgcolor(#aaaa, #aaaa, #aaaa);
1044 curses_set_bgcolor(#0000, #0000, #0000);
1045 curses_set_attributes(a.mono);
1046 ]
1047 ]
1049 fn app_suspend(implicit w : world, implicit app : appstate) : (world, appstate)
1050 [
1051 curses_done(app.curs);
1052 app.curs := exception_make(curses, ec_sync, error_record_field_not_initialized, 0, false);
1053 ]
1055 fn app_resume(implicit w : world, implicit app : appstate) : (world, appstate)
1056 [
1057 app.curs := curses_init(app.d, app.h, app.env);
1058 ]
1060 fn app_run(implicit w : world, d : dhandle, h : list(handle), env : treemap(bytes, bytes), const cls : widget_class, init : fn(world, appstate, wid) : (world, appstate, cls.t)) : world
1061 [
1062 var async_mq := msgqueue_new(wevent);
1063 implicit app := appstate.[
1064 d : d,
1065 h : h,
1066 env : env,
1067 widgets : empty(widget),
1068 wm_wid : wid_none,
1069 events : empty(wid_wevent),
1070 properties : infinite_uninitialized(widget_property),
1071 async_mq : async_mq,
1072 ];
1074 app_resume();
1076 app.wm_wid := widget_new(wid_none, wm_class, wm_init, false);
1078 app.app_wid := widget_new(app.wm_wid, cls, init, false);
1080 //property_set("test", property.b.("hello"));
1081 //var val := property_get("test");
1082 //eval debug(val.b);
1083 //sleep(w, 1000000);
1085 while true do [
1086 var quit := false;
1087 while len_greater_than(app.events, 0) do [
1088 var ww := app.events[0];
1089 app.events := app.events[1 .. ];
1090 if ww.id >= 0, is_uninitialized(app.widgets[ww.id]) then
1091 continue;
1092 if ww.wev is quit then [
1093 quit := true;
1094 continue;
1095 ]
1096 if ww.wev is redraw then [
1097 var r := rect.[
1098 x1 : ww.wev.redraw.x1,
1099 x2 : ww.wev.redraw.x2,
1100 y1 : ww.wev.redraw.y1,
1101 y2 : ww.wev.redraw.y2,
1102 ];
1103 r := get_redraw_rect(ww.id, r);
1104 do_redraw(r);
1105 continue;
1106 ]
1107 if ww.wev is close then [
1108 var r := rect.[
1109 x1 : 0,
1110 x2 : app.widgets[ww.id].common.size_x,
1111 y1 : 0,
1112 y2 : app.widgets[ww.id].common.size_y,
1113 ];
1114 r := get_redraw_rect(ww.id, r);
1115 delete_widget(ww.id);
1116 do_redraw(r);
1117 continue;
1118 ]
1119 if not is_uninitialized_record(app.widgets[ww.id].cls.process_event) then [
1120 mutable wi := app.widgets[ww.id];
1121 wi.common, wi.state := wi.cls.process_event(wi.common, wi.state, ww.wev);
1122 app.widgets[ww.id] := wi;
1123 ]
1124 ]
1125 if quit then
1126 break;
1127 app.curs := set_cursor(app.curs);
1128 var ev : event;
1129 app.curs, ev := curses_get_event(app.curs, wevent, async_mq);
1130 var wev := wevent.noop;
1131 if ev is altmq then [
1132 var id, wev := msgqueue_receive(async_mq);
1133 app.events := [ wid_wevent.[ id : id, wev : wev ] ];
1134 continue;
1135 ] if ev is keyboard then [
1136 wev.keyboard := ev.keyboard;
1137 ] else if ev is mouse then [
1138 wev.mouse := ev.mouse;
1139 wev.mouse.x := max(min(wev.mouse.x, app.widgets[app.wm_wid].common.size_x - 1), 0);
1140 wev.mouse.y := max(min(wev.mouse.y, app.widgets[app.wm_wid].common.size_y - 1), 0);
1141 ] else if ev is redraw then [
1142 wev.redraw := ev.redraw;
1143 ] else if ev is resize then [
1144 wev.resize := ev.resize;
1145 ] else if ev is suspend then [
1146 var ctrl_z, ctrl_z_token := signal_handle("SIGTSTP");
1147 app_suspend();
1148 tty_background();
1149 try_fg:
1150 var b := tty_foreground();
1151 if not b then [
1152 sleep(w, 1000000);
1153 goto try_fg;
1154 ]
1155 app_resume();
1156 signal_unhandle(ctrl_z);
1157 ] else [
1158 continue;
1159 ]
1160 app.events := [ wid_wevent.[ id : app.wm_wid, wev : wev ] ];
1161 ]
1162 app.curs := curses_update(app.curs);
1164 app_suspend();
1166 return w;
1167 ]