hackin on the layout and window management
This commit is contained in:
172
ogui.ml
172
ogui.ml
@ -3,6 +3,14 @@ module Gv = Graphv_gles2_native
|
||||
module F = Fmt
|
||||
module Str = Re.Str
|
||||
|
||||
let pp_box2 ppf b =
|
||||
F.(
|
||||
pf ppf "[%a %a]"
|
||||
(pair ~sep:(any " ") float float)
|
||||
Gg.(Box2.min b |> V2.to_tuple)
|
||||
(pair ~sep:(any " ") float float)
|
||||
Gg.(Box2.max b |> V2.to_tuple))
|
||||
|
||||
let pair a b = (a, b)
|
||||
|
||||
module Lwd = struct
|
||||
@ -129,13 +137,14 @@ module Margin = struct
|
||||
let sum t : size2 = Size2.v (t.left +. t.right) (t.top +. t.bottom)
|
||||
|
||||
let inner t b : box2 =
|
||||
Box2.of_pts
|
||||
(V2.v (Box2.minx b +. t.left) (Box2.miny b +. t.top))
|
||||
(V2.v (Box2.maxx b -. t.right) (Box2.maxy b -. t.bottom))
|
||||
Box2.(
|
||||
of_pts
|
||||
(V2.v (minx b +. t.left) (miny b +. t.top))
|
||||
(V2.v (maxx b -. t.right) (maxy b -. t.bottom)))
|
||||
|
||||
let outer t b =
|
||||
Box2.(
|
||||
v
|
||||
of_pts
|
||||
(V2.v (minx b -. t.left) (miny b -. t.top))
|
||||
(V2.v (maxx b +. t.right) (maxy b +. t.bottom)))
|
||||
|
||||
@ -1222,8 +1231,8 @@ module Layout = struct
|
||||
|
||||
and t =
|
||||
[ `Join of dir * (frame * frame)
|
||||
| `String of string
|
||||
| `Buffer of TextBuffer.t
|
||||
| `String of string * TextLayout.format
|
||||
| `Buffer of TextBuffer.t * TextLayout.format
|
||||
| `TextEdit of TextEdit.t * TextLayout.layout
|
||||
| `None ]
|
||||
|
||||
@ -1239,7 +1248,7 @@ module Layout = struct
|
||||
{ t; size; style }
|
||||
|
||||
let none = frame `None
|
||||
let join d ?style a b = frame ?style (`Join (d, (a, b)))
|
||||
let join ?size ?style d a b = frame ?size ?style (`Join (d, (a, b)))
|
||||
|
||||
(* let hbox, vbox, zbox = (box `X, box `Y, box `Z) *)
|
||||
let pack ?style d = (none, join d ?style)
|
||||
@ -1261,6 +1270,8 @@ module Layout = struct
|
||||
margin = Margin.symmetric 10. 10.;
|
||||
}
|
||||
|
||||
let string ?size ?style s = frame ?size ?style (`String s)
|
||||
|
||||
let textedit_s ?size ?(style = textedit_style)
|
||||
(t : TextEdit.t Lwd.t) : frame Lwd.t Lwt.t =
|
||||
let open TextLayout in
|
||||
@ -1298,7 +1309,7 @@ module Layout = struct
|
||||
| `Join (d, _) -> F.str "`Join %a" pp_dir d
|
||||
| `Buffer _ -> "`Buffer"
|
||||
| `TextEdit _ -> "`TextEdit"
|
||||
| `String s -> F.str "`String %s" s
|
||||
| `String (s, _) -> F.str "`String %s" s
|
||||
| `None -> "`None")
|
||||
|
||||
let pp_dim ppf = function
|
||||
@ -1326,7 +1337,7 @@ module Layout = struct
|
||||
p
|
||||
| `Buffer _ -> pf ppf "`Buffer"
|
||||
| `TextEdit _ -> pf ppf "`TextEdit"
|
||||
| `String s -> pf ppf "`String @[<h 1>%s@]" s
|
||||
| `String (s, _) -> pf ppf "`String @[<h 1>%s@]" s
|
||||
| `None -> pf ppf "`None"
|
||||
|
||||
and pp_frame_rec ppf t =
|
||||
@ -1342,56 +1353,70 @@ module Layout = struct
|
||||
end
|
||||
|
||||
module WindowManager = struct
|
||||
type dir = Layout.dir
|
||||
open Layout
|
||||
|
||||
type t =
|
||||
[ `T of dir * t list
|
||||
| `TextEdit of TextEdit.t * Layout.dim
|
||||
| `Frame of Layout.frame ]
|
||||
[ `T of dir * (t * dim) list
|
||||
| `TextEdit of TextEdit.t
|
||||
| `Frame of frame ]
|
||||
|
||||
let rec length : t -> int = function
|
||||
| `T (_, tl) -> List.fold_left (fun a t' -> a + length t') 0 tl
|
||||
| `T (_, tl) ->
|
||||
List.fold_left (fun a (t', _) -> a + length t') 0 tl
|
||||
| _ -> 1
|
||||
|
||||
let rec fold_left ?(dir = `X)
|
||||
~(f :
|
||||
dir ->
|
||||
'a ->
|
||||
[ `Frame of Layout.frame | `TextEdit of TextEdit.t ] ->
|
||||
[ `Frame of frame | `TextEdit of TextEdit.t ] ->
|
||||
'a) acc = function
|
||||
| `T (dir, tl) ->
|
||||
List.fold_left (fun a' t' -> fold_left ~f ~dir a' t') acc tl
|
||||
| (`Frame _ as tt) | (`TextEdit _ as tt) -> f dir acc tt
|
||||
|
||||
let frame_of_window (ui : Ui.t) (n : int) cursor style
|
||||
(content : Layout.frame Lwd.t) : Layout.frame Lwd.t Lwt.t =
|
||||
let open Layout in
|
||||
textedit
|
||||
~size:(`Ratio 1.0, `Pixels 30.)
|
||||
~style
|
||||
(TextEdit.multiline ui
|
||||
(TextBuffer.of_string
|
||||
~path:[ F.str "window/%d/status" n ]
|
||||
(F.str "window/%d" n)))
|
||||
>>= fun status ->
|
||||
Lwd.map2 (Lwd.map2 content status ~f:pair) (Lwd.get cursor)
|
||||
~f:(fun (tt', status) cursor ->
|
||||
join `Y
|
||||
let color_gray c = Gv.Color.rgbf ~r:c ~g:c ~b:c
|
||||
|
||||
let status_style sel : Style.t =
|
||||
let open Ui.Style in
|
||||
{
|
||||
stroke =
|
||||
Some (3.0, if sel then color_gray 0.6 else color_gray 0.4);
|
||||
fill = (if sel then color_gray 0.8 else color_gray 0.2);
|
||||
margin = Margin.symmetric 2. 2.;
|
||||
}
|
||||
|
||||
let status_format sel : TextLayout.format =
|
||||
{
|
||||
TextLayout.format_default with
|
||||
font_id = FontId ("mono", 18.0);
|
||||
line_height = Some 19.;
|
||||
color = (if sel then color_gray 0.1 else color_gray 0.9);
|
||||
background = Gv.Color.transparent;
|
||||
}
|
||||
|
||||
let frame_of_window (n : int) cursor style (size : dim * dim)
|
||||
(content : frame Lwd.t) : frame Lwd.t =
|
||||
Lwd.map2 content (Lwd.get cursor) ~f:(fun content cursor ->
|
||||
join ~size
|
||||
~style:
|
||||
{
|
||||
tt'.style with
|
||||
style with
|
||||
stroke =
|
||||
Option.map
|
||||
(fun (s, c) ->
|
||||
( s,
|
||||
if n != cursor then Gv.Color.(transf c 0.3)
|
||||
else c ))
|
||||
tt'.style.stroke;
|
||||
content.style.stroke;
|
||||
}
|
||||
tt' status)
|
||||
|> Lwt.return
|
||||
`Y content
|
||||
(string
|
||||
~style:(status_style (n == cursor))
|
||||
~size:(`Ratio 1.0, `Pixels 30.)
|
||||
(F.str "window/%d" n, status_format (n == cursor))))
|
||||
|
||||
let make ui ?(style = Layout.textedit_style)
|
||||
let make ui ?(style = textedit_style)
|
||||
?(_mode : [ `Tiling | `FullScreen | `Floating ] = `Tiling)
|
||||
(telist : t Lwd.var) =
|
||||
let cursor = Lwd.var 0 in
|
||||
@ -1411,7 +1436,7 @@ module WindowManager = struct
|
||||
else 0);
|
||||
(*TextEdit.default_bindings
|
||||
(List.nth (Lwd.peek telist) (Lwd.peek cursor))
|
||||
ui;*)
|
||||
ui; *)
|
||||
Lwt.return_unit );
|
||||
]
|
||||
|> Event.adds
|
||||
@ -1431,26 +1456,33 @@ module WindowManager = struct
|
||||
]);
|
||||
|
||||
Lwd.map_s (Lwd.get telist) ~f:(fun (tl : t) ->
|
||||
let rec fold dir : t -> Layout.frame Lwd.t Lwt.t = function
|
||||
| `T (dir', tl) ->
|
||||
Lwt_list.fold_left_s
|
||||
(fun f t ->
|
||||
fold dir' t >>= fun newf ->
|
||||
Lwd.map2 f newf ~f:(Layout.join dir') |> Lwt.return)
|
||||
(Lwd.pure Layout.none) tl
|
||||
| `Frame f' ->
|
||||
frame_of_window ui 314 cursor style (Lwd.return f')
|
||||
| `TextEdit (t', dim) ->
|
||||
Layout.textedit
|
||||
~size:
|
||||
(match dir with
|
||||
let rec fold dir dim : t -> Layout.frame Lwd.t Lwt.t =
|
||||
let size =
|
||||
match dir with
|
||||
| `X -> (dim, `Ratio 1.)
|
||||
| `Y -> (`Ratio 1., dim)
|
||||
| `Z -> (dim, dim))
|
||||
~style t'
|
||||
>>= fun tt -> frame_of_window ui 314 cursor style tt
|
||||
| `Z -> (dim, dim)
|
||||
in
|
||||
fold `X tl)
|
||||
function
|
||||
| `T ((dir', (t0, dim0) :: trest) as tl) ->
|
||||
fold dir' dim0 t0 >>= fun fst ->
|
||||
Lwt_list.fold_left_s
|
||||
(fun f (t, dim) ->
|
||||
fold dir' dim t >>= fun newf ->
|
||||
Lwd.map2 f newf ~f:(join ~size dir') |> Lwt.return)
|
||||
fst trest
|
||||
| `T (_, []) -> Layout.none |> Lwd.return |> Lwt.return
|
||||
| `Frame f' ->
|
||||
frame_of_window 314 cursor style size (Lwd.return f')
|
||||
|> Lwt.return
|
||||
| `TextEdit t' ->
|
||||
Layout.textedit
|
||||
~size:(`Ratio 1.0, `Fun (fun b -> Gg.Box2.h b -. 30.))
|
||||
t'
|
||||
>>= fun tt ->
|
||||
frame_of_window 314 cursor style size tt |> Lwt.return
|
||||
in
|
||||
fold `X (`Ratio 1.) tl)
|
||||
>>= fun d -> Lwd.join d |> Lwt.return
|
||||
end
|
||||
|
||||
@ -1482,10 +1514,22 @@ module Painter = struct
|
||||
let open Gv in
|
||||
Text.set_font_face t ~name:font_name;
|
||||
Text.set_size t ~size:font_size;
|
||||
Text.set_align t ~align:Align.(left lor top)
|
||||
Text.set_align t ~align:Align.(left lor top);
|
||||
set_fill_color t ~color:format.color
|
||||
|
||||
let string (t : Gv.t) (rect : box2) str : box2 Lwt.t =
|
||||
Lwt.return Gg.Box2.zero
|
||||
let string ?(style = Style.default) (t : Gv.t) (rect : box2)
|
||||
((contents, format) : string * TextLayout.format) : box2 Lwt.t =
|
||||
(* draw_box t ~box:rect ~style; *)
|
||||
F.epr "string";
|
||||
set_text_format t format;
|
||||
let rect' = Margin.inner style.margin rect in
|
||||
V2.v
|
||||
(Gv.Text.text_w t ~x:(Box2.minx rect') ~y:(Box2.miny rect')
|
||||
contents)
|
||||
(Gv.Text.metrics t).line_height
|
||||
|> Box2.v (Box2.o rect')
|
||||
|> Margin.outer style.margin
|
||||
|> Lwt.return
|
||||
|
||||
let text_layout (t : Gv.t) (rect : box2)
|
||||
((te, layout) : TextEdit.t * TextLayout.layout) : box2 Lwt.t =
|
||||
@ -1560,7 +1604,7 @@ module Painter = struct
|
||||
({ t; style; size = sx, sy } : frame) : box2 Lwt.t =
|
||||
let box =
|
||||
Box2.v (Box2.o box)
|
||||
(V2.v
|
||||
(Size2.v
|
||||
(match sx with
|
||||
| `Ratio r -> Box2.w box *. r
|
||||
| `Pixels p -> p
|
||||
@ -1571,32 +1615,36 @@ module Painter = struct
|
||||
| `Fun f -> f box))
|
||||
in
|
||||
let box' = Margin.inner style.margin box in
|
||||
F.epr "@[<hv 3>%a " pp_box2 box;
|
||||
draw_box ui.gv ~box ~style;
|
||||
(match t with
|
||||
| `Join (dir, (a, b)) ->
|
||||
F.epr "`Join %a (@,@[<hv>" pp_dir dir;
|
||||
F.epr "`Join %a @,(@[<hv>" pp_dir dir;
|
||||
layout box' ui a >>= fun ra ->
|
||||
F.epr ",@ ";
|
||||
let c' =
|
||||
Box2.(
|
||||
match dir with
|
||||
| `X -> of_pts (V2.v (maxx ra) (miny box')) (max box')
|
||||
| `Y -> of_pts (V2.v (minx box') (maxy ra)) (max box')
|
||||
| `Z -> box)
|
||||
| `Z -> box')
|
||||
in
|
||||
layout c' ui b >>= fun rb ->
|
||||
F.epr "@])@.";
|
||||
F.epr "@])";
|
||||
Gg.Box2.union ra rb |> Lwt.return
|
||||
| `TextEdit tt ->
|
||||
F.epr "`TextEdit";
|
||||
text_layout ui.gv box' tt
|
||||
| `None ->
|
||||
F.epr "`None";
|
||||
Lwt.return Gg.Box2.zero
|
||||
Lwt.return Gg.Box2.(v (o box') Gg.V2.zero)
|
||||
| `String s -> string ui.gv box' s
|
||||
| _ ->
|
||||
F.epr "Layout not implemented!!@.";
|
||||
F.epr "_ !!Unimplemented!!";
|
||||
Lwt.return Gg.Box2.zero)
|
||||
>>= fun r ->
|
||||
draw_box ui.gv ~box:r ~style;
|
||||
F.epr "@]";
|
||||
|
||||
let r' =
|
||||
(*Box2.add_pt r
|
||||
V2.(Box2.max r + v style.margin.right style.margin.bottom)
|
||||
|
||||
10
oplevel.ml
10
oplevel.ml
@ -126,7 +126,7 @@ let main =
|
||||
(String.concat "/" initial_path))
|
||||
|> Lwt.return
|
||||
>>= fun to_init ->
|
||||
let out_ppf =
|
||||
let _out_ppf =
|
||||
let insert s =
|
||||
Lwt.async (fun () ->
|
||||
TextBuffer.length to_init >>= fun len ->
|
||||
@ -174,15 +174,13 @@ let main =
|
||||
]));
|
||||
|
||||
WindowManager.make ui
|
||||
~style:
|
||||
Layout.Style.
|
||||
{ default with margin = Margin.symmetric 10.0 10.0 }
|
||||
(Lwd.var
|
||||
(`T
|
||||
( `Y,
|
||||
[
|
||||
`TextEdit (TextEdit.multiline ui tb_init, `Ratio 1.0);
|
||||
`TextEdit (TextEdit.multiline ui to_init, `Ratio 0.5);
|
||||
(`TextEdit (TextEdit.multiline ui to_init), `Ratio 0.333);
|
||||
(`TextEdit (TextEdit.multiline ui tb_init), `Ratio 0.5);
|
||||
(`TextEdit (TextEdit.multiline ui to_init), `Ratio 1.0);
|
||||
] )))
|
||||
>>= fun page ->
|
||||
let page_root = Lwd.observe page in
|
||||
|
||||
Reference in New Issue
Block a user