full-sensor

This commit is contained in:
Frédéric Bour 2020-06-04 14:49:56 +02:00
부모 de82afccac
커밋 07823fed56
2개의 변경된 파일70개의 추가작업 그리고 20개의 파일을 삭제

파일 보기

@ -168,6 +168,7 @@ struct
type 'a desc =
| Atom of image
| Size_sensor of 'a * (int -> int -> unit)
| Full_sensor of 'a * (int -> int -> int -> int -> unit)
| Resize of 'a * Gravity.t2 * A.t
| Mouse_handler of 'a * mouse_handler
| Focus_area of 'a * (key -> may_handle)
@ -188,11 +189,16 @@ struct
o_direction : Gravity.t;
}
type flags = int
let flags_none = 0
let flag_full_sensor = 1
type t = {
w : int; sw : int;
h : int; sh : int;
desc : t desc;
focus : Focus.status;
flags : flags;
mutable cache : cache;
}
and cache = {
@ -214,14 +220,14 @@ struct
image = I.empty; overlays = [] }
let empty : t =
{ w = 0; sw = 0; h = 0; sh = 0;
{ w = 0; sw = 0; h = 0; sh = 0; flags = flags_none;
focus = Focus.empty; desc = Atom I.empty; cache }
let atom img : t =
{ w = I.width img; sw = 0;
h = I.height img; sh = 0;
focus = Focus.empty;
desc = Atom img; cache }
focus = Focus.empty; flags = flags_none;
desc = Atom img; cache; }
let void x y = atom (I.void x y)
@ -241,6 +247,10 @@ struct
let size_sensor handler t : t =
{ t with desc = Size_sensor (t, handler) }
let full_sensor handler t =
{ t with desc = Full_sensor (t, handler);
flags = t.flags lor flag_full_sensor }
let resize ?w ?h ?sw ?sh ?fill ?crop ?(bg=A.empty) t : t =
let g = match fill, crop with
| None, None -> Gravity.(pair default default)
@ -263,7 +273,8 @@ struct
let o_z = incr last_z; !last_z in
fun o_n ->
let desc = Overlay { o_n; o_x; o_y; o_h; o_z; o_origin; o_direction } in
{ w = 0; sw = 0; h = 0; sh = 0; desc; focus = Focus.empty; cache }
{ w = 0; sw = 0; h = 0; sh = 0; desc;
flags = flags_none; focus = Focus.empty; cache }
let event_filter ?focus f t : t =
let focus = match focus with
@ -275,18 +286,21 @@ struct
let join_x a b = {
w = (a.w + b.w); sw = (a.sw + b.sw);
h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
flags = a.flags lor b.flags;
focus = Focus.merge a.focus b.focus; desc = X (a, b); cache
}
let join_y a b = {
w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
h = (a.h + b.h); sh = (a.sh + b.sh);
flags = a.flags lor b.flags;
focus = Focus.merge a.focus b.focus; desc = Y (a, b); cache;
}
let join_z a b = {
w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
flags = a.flags lor b.flags;
focus = Focus.merge a.focus b.focus; desc = Z (a, b); cache;
}
@ -309,6 +323,8 @@ struct
| Atom _ -> Format.fprintf ppf "Atom _"
| Size_sensor (desc, _) ->
Format.fprintf ppf "Size_sensor (@[%a,@ _@])" pp desc
| Full_sensor (desc, _) ->
Format.fprintf ppf "Full_sensor (@[%a,@ _@])" pp desc
| Resize (desc, gravity, _bg) ->
Format.fprintf ppf "Resize (@[%a,@ %a,@ %a@])" pp desc
Gravity.pp (Gravity.p1 gravity)
@ -334,7 +350,8 @@ struct
let iter f ui = match ui.desc with
| Atom _ -> ()
| Size_sensor (u, _) | Resize (u, _, _) | Mouse_handler (u, _)
| Size_sensor (u, _) | Full_sensor (u, _)
| Resize (u, _, _) | Mouse_handler (u, _)
| Focus_area (u, _) | Scroll_area (u, _, _) | Event_filter (u, _)
| Overlay {o_n = u; _} -> f u
| X (u1, u2) | Y (u1, u2) | Z (u1, u2) -> f u1; f u2
@ -372,16 +389,6 @@ struct
in
aux ui
let update_focus ui =
match ui.focus with
| Focus.Empty | Focus.Handle _ -> ()
| Focus.Conflict i -> solve_focus ui i
let update t size ui =
t.size <- size;
t.view <- ui;
update_focus ui
let sort_overlays o = List.sort
(fun o1 o2 -> - compare o1.o_z o2.o_z) o
@ -410,6 +417,48 @@ struct
| `Neutral -> (flex / 2, fixed)
| `Positive -> (flex, fixed)
let rec update_sensors ox oy sw sh ui =
if ui.flags land flag_full_sensor <> 0 then (
match ui.desc with
| Atom _ -> ()
| Overlay _ -> ()
| Size_sensor (t, _) | Mouse_handler (t, _)
| Focus_area (t, _) | Event_filter (t, _) ->
update_sensors ox oy sw sh t
| Full_sensor (t, f) ->
f ox oy sw sh;
update_sensors ox oy sw sh t
| Resize (t, g, _) ->
let open Gravity in
let dx, rw = pack ~fixed:t.w ~stretch:t.sw sw (h (p1 g)) (h (p2 g)) in
let dy, rh = pack ~fixed:t.h ~stretch:t.sh sh (v (p1 g)) (v (p2 g)) in
update_sensors (ox + dx) (oy + dy) rw rh t
| Scroll_area (t, sx, sy) ->
update_sensors (ox - sx) (oy - sy) sw sh t
| X (a, b) ->
let aw, bw = split ~a:a.w ~sa:a.sw ~b:b.w ~sb:b.sw sw in
update_sensors ox oy aw sh a;
update_sensors (ox + aw) oy bw sh b
| Y (a, b) ->
let ah, bh = split ~a:a.h ~sa:a.sh ~b:b.h ~sb:b.sh sh in
update_sensors ox oy sw ah a;
update_sensors ox (oy + ah) sw bh b
| Z (a, b) ->
update_sensors ox oy sw sh a;
update_sensors ox oy sw sh b;
)
let update_focus ui =
match ui.focus with
| Focus.Empty | Focus.Handle _ -> ()
| Focus.Conflict i -> solve_focus ui i
let update t size ui =
t.size <- size;
t.view <- ui;
update_sensors 0 0 (fst size) (snd size) ui;
update_focus ui
let dispatch_mouse st x y btn w h t =
let handle ox oy f =
match f ~x:(x - ox) ~y:(y - oy) btn with
@ -439,9 +488,7 @@ struct
assert (_offsetx = 0 && _offsety = 0);
(x - ox >= 0 && x - ox <= rw && y - oy >= 0 && y - oy <= rh) &&
(aux ox oy sw sh t || handle ox oy f)
| Size_sensor (desc, _) ->
aux ox oy sw sh desc
| Focus_area (desc, _) ->
| Size_sensor (desc, _) | Full_sensor (desc, _) | Focus_area (desc, _) ->
aux ox oy sw sh desc
| Scroll_area (desc, sx, sy) ->
aux (ox - sx) (oy - sy) sw sh desc
@ -530,6 +577,8 @@ struct
| Size_sensor (desc, handler) ->
handler sw sh;
render_node vx1 vy1 vx2 vy2 sw sh desc
| Full_sensor (desc, _) ->
render_node vx1 vy1 vx2 vy2 sw sh desc
| Focus_area (desc, _) | Mouse_handler (desc, _) ->
render_node vx1 vy1 vx2 vy2 sw sh desc
| Scroll_area (t', sx, sy) ->
@ -637,7 +686,7 @@ struct
| `Handled -> `Handled
| `Unhandled -> iter tl
end
| Mouse_handler (t, _) | Size_sensor (t, _)
| Mouse_handler (t, _) | Size_sensor (t, _) | Full_sensor (t, _)
| Scroll_area (t, _, _) | Resize (t, _, _) ->
iter (t :: tl)
| Event_filter (t, f) ->
@ -663,7 +712,7 @@ struct
let rec dispatch_focus t dir =
match t.desc with
| Atom _ | Overlay _ -> false
| Mouse_handler (t, _) | Size_sensor (t, _)
| Mouse_handler (t, _) | Size_sensor (t, _) | Full_sensor (t, _)
| Scroll_area (t, _, _) | Resize (t, _, _) | Event_filter (t, _) ->
dispatch_focus t dir
| Focus_area (t', _) ->

파일 보기

@ -68,6 +68,7 @@ sig
val keyboard_area : ?focus:Focus.status -> (key -> may_handle) -> t -> t
val scroll_area : int -> int -> t -> t
val size_sensor : (int -> int -> unit) -> t -> t
val full_sensor : (int -> int -> int -> int -> unit) -> t -> t
val resize :
?w:int -> ?h:int -> ?sw:int -> ?sh:int ->
?fill:Gravity.t -> ?crop:Gravity.t -> ?bg:attr -> t -> t