open Ansi type bounded_constraints = { max_width: int option; min_width: int option; max_height: int option; min_height: int option; } type constraints = | Unbounded | Bounded of bounded_constraints type size = { height: int; width: int } type alignment = | Start | Center | End | Stretch | Even type cross_alignment = | Start | Center | End | Stretch | Even type box_options = { alignment: alignment; cross_alignment: cross_alignment; } type padding_options = { left: int; right: int; bottom: int; top: int; } type widget_options = | Box of box_options | Padding of padding_options let default_padding_opts = { left = 0; right = 0; bottom = 0; top = 0; } let default_column_opts = { alignment = Start; cross_alignment = Center; } let default_row_opts = { alignment = Start; cross_alignment = Center; } type ansi_widget = | Column of box_options * ansi_widget list | Row of box_options * ansi_widget list | Text of string | Padding of padding_options * ansi_widget type widget_element = | ElementColumn of constraints * size ref * box_options * widget_element list | ElementRow of constraints * size ref * box_options * widget_element list | ElementText of constraints * size ref * string | ElementPadding of constraints * size ref * padding_options * widget_element let size_of_widget_element = function | ElementColumn (_, s, _, _) -> !s | ElementRow (_, s, _, _) -> !s | ElementText (_, s, _) -> !s | ElementPadding (_, s, _, _) -> !s (* let descend_widget_tree_list widget_list = *) (* let widgets = List.iter descend_widget_tree widge_list in *) (* List.fold_left (^) widgets *) let rec make_spacer = function | 0 -> "" | n -> " " ^ make_spacer (n - 1) let rec descend_widget_tree depth widget_tree = match widget_tree with | Column (c_opts, widgets) -> let _ = c_opts in let deeper = depth + 1 in let widget_strings = List.map (descend_widget_tree deeper) widgets in let line = String.concat "" widget_strings in let spacer = make_spacer depth in spacer ^ "Column ->\n" ^ line | Row (r_opts, widgets) -> let _ = r_opts in let deeper = depth + 1 in let widget_strings = List.map (descend_widget_tree deeper) widgets in let line = String.concat "" widget_strings in let spacer = make_spacer depth in spacer ^ "Row ->\n" ^ line | Text s -> let spacer = make_spacer depth in spacer ^ Printf.sprintf "Text: \"%s\"\n" s | Padding (_, widget) -> let spacer = make_spacer depth in spacer ^ "Padding ->\n" ^ descend_widget_tree (depth + 1) widget let debug_string_of_widget ansi_widget = (* let {x = term_x; y = term_y} = termsize in *) descend_widget_tree 0 ansi_widget let max_constraints = let {x = term_x; y = term_y} = termsize in Bounded {max_width = Some term_x; max_height = Some term_y; min_height = Some 0; min_width = Some 0} (** 1. Layout - Descend tree, parent passing down constraints, child passing up size 2. Convert ansi_widget tree to widget_element tree **) let layout_tree ansi_widget = let filter_sizes elements = List.map size_of_widget_element elements in let sum_sizes_col = (fun {height = h; width = w} element -> {height = h + element.height; width = max w element.width} ) in let sum_sizes_row = (fun {height = h; width = w} element -> {height = max h element.height; width = w + element.width} ) in let subtract_bound some_x x = match some_x with | Some i -> Some (max (x - i) 0) | None -> Some x in let rec layout_tree_list constraints widgets = let constrained_layout = layout_tree_rec constraints in let elements = List.map constrained_layout widgets in elements and layout_tree_rec constraints widget_tree = let size = ref {height = 0; width = 0} in match widget_tree with | Column (c_opts, widgets) -> let widget_elements = (layout_tree_list constraints widgets) in let sizes = filter_sizes widget_elements in size := List.fold_left sum_sizes_col {height = 0; width = 0} sizes; ElementColumn( constraints, size, c_opts, widget_elements) | Row (r_opts, widgets) -> let widget_elements = (layout_tree_list constraints widgets) in let sizes = filter_sizes widget_elements in size := List.fold_left sum_sizes_row {height = 0; width = 0} sizes; ElementRow( constraints, size, r_opts, widget_elements) | Text (s) -> size := {height = 1; width = String.length s}; ElementText (constraints, size, s) | Padding (p_opts, widget) -> let vertical_padding = p_opts.top + p_opts.bottom in let horizontal_padding = p_opts.left + p_opts.right in let new_constraints = match constraints with | Bounded cons -> Bounded { max_height = (subtract_bound cons.max_height vertical_padding); max_width = (subtract_bound cons.max_width horizontal_padding); min_height = Some vertical_padding; min_width = Some horizontal_padding; } | Unbounded -> Bounded { max_height = None; max_width = None; min_height = Some vertical_padding; min_width = Some horizontal_padding; } in let element = layout_tree_rec new_constraints widget in let element_size = size_of_widget_element element in size := {width = horizontal_padding + element_size.width; height = vertical_padding + element_size.width}; ElementPadding (constraints, size, p_opts, element) in let size = ref {height = 0; width = 0} in layout_tree_rec max_constraints ansi_widget