Source file vdom_layout.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
open! Core
module Attr = Virtual_dom.Vdom.Attr
module Node = Virtual_dom.Vdom.Node

let rec wrap_in_element_if_necessary node =
  let wrap_with_div children =
    let div = Node.div children in
    match div with
    | Node.Element e -> e
    | _ -> assert false
  in
  match node with
  | Node.Text _ | Node.Widget _ | Node.None -> wrap_with_div [ node ]
  | Fragment children -> wrap_with_div children
  | Node.Lazy { t; _ } -> wrap_in_element_if_necessary (Lazy.force t)
  | Node.Element e -> e
;;

let add_style node ~style =
  let element = wrap_in_element_if_necessary node in
  Node.Element (Node.Element.add_style element style)
;;

let map_style node ~f =
  let element = wrap_in_element_if_necessary node in
  Node.Element
    (Node.Element.map_attrs element ~f:(fun attrs ->
       Attr.many_without_merge (Attr.Multi.map_style [ attrs ] ~f)))
;;

let grow n = add_style n ~style:Css_gen.(flex_item ~grow:1. ())
let grow_and_shrink n = add_style n ~style:Css_gen.(flex_item ~grow:1. ~shrink:1. ())

let scrollable n =
  add_style
    n
    ~style:
      Css_gen.(flex_item ~grow:1. ~shrink:1. () @> overflow_y `Auto @> overflow_x `Auto)
;;

let spacer ?(attrs = []) ?min_width ?min_height () =
  let style =
    let mw = Option.value_map min_width ~default:Css_gen.empty ~f:Css_gen.min_width in
    let mh = Option.value_map min_height ~default:Css_gen.empty ~f:Css_gen.min_height in
    Css_gen.concat [ mw; mh ]
  in
  Node.span ~attrs:[ Attr.many_without_merge (Attr.style style :: attrs) ] []
;;

let as_box
  (direction : [ `Row | `Column ])
  ?gap
  ?align_items
  (node_creator : Node.Aliases.node_creator)
  ?key
  ?attrs
  nodes
  =
  let nodes =
    match gap with
    | None -> nodes
    | Some gap_len ->
      let gap =
        match direction with
        | `Column -> spacer ~min_height:gap_len ()
        | `Row -> spacer ~min_width:gap_len ()
      in
      List.intersperse nodes ~sep:gap
  in
  let nodes =
    List.map
      nodes
      ~f:
        (map_style ~f:(fun style ->
           let has_flex_shrink_set =
             Css_gen.to_string_list style
             |> List.exists ~f:(fun (f, _) ->
                  String.( = ) f "flex-shrink" || String.( = ) f "flex")
           in
           if has_flex_shrink_set
           then style
           else Css_gen.(style @> create ~field:"flex-shrink" ~value:"0")))
  in
  let node = node_creator ?key ?attrs nodes in
  let direction =
    (direction :> [ `Row | `Column | `Row_reverse | `Column_reverse | `Default ])
  in
  add_style node ~style:Css_gen.(flex_container ~direction ?align_items ())
;;

let as_hbox = as_box `Row
let as_vbox = as_box `Column

let hbox ?gap ?align_items ?key ?attrs children =
  as_hbox ?gap ?align_items Node.div ?key ?attrs children
;;

let vbox ?gap ?align_items ?key ?attrs children =
  as_vbox ?gap ?align_items Node.div ?key ?attrs children
;;

let body ?(direction = `Column) ?gap ?align_items ?key ?attrs nodes =
  let p100 = Percent.of_percentage 100.0 in
  as_box direction ?gap ?align_items Node.body ?key ?attrs nodes
  |> add_style
       ~style:
         Css_gen.(
           width (`Vw p100)
           @> height (`Vh p100)
           @> uniform_margin (`Px 0)
           @> uniform_padding (`Px 0))
;;

let on_grayed_out_background nodes =
  Node.div
    ~attrs:
      [ Attr.style
          Css_gen.(
            position ~left:(`Px 0) ~top:(`Px 0) `Fixed
            @> width Length.percent100
            @> height Length.percent100
            @> overflow `Auto
            @> background_color
                 (`RGBA
                   (Color.RGBA.create ~r:0 ~g:0 ~b:0 ~a:(Percent.of_percentage 40.) ())))
      ]
    nodes
;;

let modal ?(direction = `Row) ?gap ?align_items ?key ?(attrs = []) nodes =
  on_grayed_out_background
    [ as_box
        direction
        Node.div
        ?gap
        ?align_items
        ?key
        ~attrs:
          [ Attr.many_without_merge
              ([ Attr.style
                   Css_gen.(
                     margin_top (`Percent (Percent.of_percentage 15.0))
                     @> margin_left `Auto
                     @> margin_right `Auto
                     @> width (`Percent (Percent.of_percentage 80.0))
                     @> background_color (`Name "#fefefe")
                     @> uniform_padding (`Px 20)
                     @> border ~width:(`Px 2) ~style:`Solid ~color:(`Name "black") ())
               ]
               @ attrs)
          ]
        nodes
    ]
;;