tuiano/lib/widgets.ml

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