diff options
-rwxr-xr-x | blog/dune | 1 | ||||
-rwxr-xr-x | blog/nord.ml | 1 | ||||
-rwxr-xr-x | blog/sidebar.ml | 93 | ||||
-rwxr-xr-x | elements/input.ml | 29 | ||||
-rwxr-xr-x | elements/prop.ml | 15 | ||||
-rwxr-xr-x | layer/svg.ml | 16 | ||||
-rwxr-xr-x | path/point.ml | 6 | ||||
-rwxr-xr-x | path/point.mli | 2 | ||||
-rwxr-xr-x | paths.ml | 2 | ||||
-rwxr-xr-x | script.ml | 342 | ||||
-rwxr-xr-x | state.ml | 221 | ||||
-rwxr-xr-x | theme/dune | 7 | ||||
-rwxr-xr-x | theme/nord.ml | 39 | ||||
-rwxr-xr-x | theme/theme.ml | 1 |
14 files changed, 398 insertions, 377 deletions
@@ -3,6 +3,7 @@ (libraries brr brr.note + color elements ) ) diff --git a/blog/nord.ml b/blog/nord.ml new file mode 100755 index 0000000..78c4c61 --- /dev/null +++ b/blog/nord.ml @@ -0,0 +1 @@ +let nord0 = Jstr.v "#2e3440" diff --git a/blog/sidebar.ml b/blog/sidebar.ml index 83afb13..a1293de 100755 --- a/blog/sidebar.ml +++ b/blog/sidebar.ml @@ -1,7 +1,5 @@ open StdLabels open Brr -open Brr_note -open Note (** Return the sidebar *) let get @@ -24,94 +22,3 @@ let rec clean clean el ) -let click_event el = - Evr.on_el - Ev.click - Evr.unit - el - -let show_value = function - | None -> El.txt' "" - | Some input -> - El.txt (Jstr.of_int input) - -let add_button - : El.t -> unit E.t * unit E.t - = fun element -> - - let open El in - - let delete = - button - [ El.i - ~at:At.[ class' (Jstr.v "fas") - ; class' (Jstr.v "fa-times-circle") ] - [] - ; txt' "Delete "] in - - let delete_event = click_event delete in - - let export = - button - [ El.i - ~at:At.[ class' (Jstr.v "fas") - ; class' (Jstr.v "fa-download") ] - [] - ; txt' "Download"] in - let export_event = click_event export in - - - let nib_size, value = - Elements.Input.slider - ~at:At.[ type' (Jstr.v "range") - ; v (Jstr.v "min") (Jstr.v "0") - ; v (Jstr.v "max") (Jstr.v "50") - ; id (Jstr.v "nib_size") - ] in - - let width = El.div [] in - Elr.def_children - width - (value - |> S.map (fun v -> - [ txt' "Width : " - ; show_value v ] - ) - ); - - let input_angle, angle_event = - Elements.Input.slider - ~at:At.[ type' (Jstr.v "range") - ; v (Jstr.v "min") (Jstr.v "0") - ; v (Jstr.v "max") (Jstr.v "90")] in - let angle = El.div [] in - Elr.def_children - angle - (angle_event - |> S.map (fun v -> - [ txt' "Angle : " - ; show_value v - ; txt' "°" ] - ) - ); - - let click = Evr.on_el Ev.click Evr.unit delete in - let _ = click in - - let () = - El.append_children element - [ hr () - ; delete - ; export - ; hr () - - ; width - ; nib_size - ; El.br () - - ; angle - ; input_angle - - ] - in - delete_event, export_event diff --git a/elements/input.ml b/elements/input.ml index 790b15d..935f34a 100755 --- a/elements/input.ml +++ b/elements/input.ml @@ -3,18 +3,23 @@ open Brr_note open Note (** Create a slider element, and a signal with the value *) -let slider ~at = - let slider = - El.input ~at () in +let slider + : at:Brr.At.t list -> Brr.El.t * float S.t - let event = - Evr.on_el - Ev.input (fun _ -> - let raw_value = El.prop El.Prop.value slider in - Jstr.to_int raw_value) - slider - |> S.hold (Jstr.to_int (El.prop El.Prop.value slider)) - in - slider, event + = fun ~at -> + let slider = + El.input ~at () in + + let init_value = (Jstr.to_float (El.prop El.Prop.value slider)) in + + let event = + Evr.on_el + Ev.input (fun _ -> + let raw_value = El.prop El.Prop.value slider in + Jstr.to_float raw_value) + slider + |> S.hold init_value + in + slider, event diff --git a/elements/prop.ml b/elements/prop.ml new file mode 100755 index 0000000..715adec --- /dev/null +++ b/elements/prop.ml @@ -0,0 +1,15 @@ +open Brr + +include El.Prop + +let offsetWidth + : int t + = El.Prop.int (Jstr.v "offsetWidth") + +let offsetHeight + : int t + = El.Prop.int (Jstr.v "offsetHeight") + +let outerHTML + : Jstr.t t + = El.Prop.jstr (Jstr.v "outerHTML") diff --git a/layer/svg.ml b/layer/svg.ml index f174acc..f7cc670 100755 --- a/layer/svg.ml +++ b/layer/svg.ml @@ -2,10 +2,8 @@ open Brr -module Path = Brr_canvas.C2d.Path module V2 = Gg.V2 - let svg : El.cons = fun ?d ?at childs -> El.v ?d ?at (Jstr.v "svg") childs @@ -26,20 +24,19 @@ let move_to = fun point path -> let x, y = V2.to_tuple point in - Jstr.append path @@ Jstr.concat ~sep:(Jstr.v " ") - [ Jstr.v " M" + [ path + ; Jstr.v "M" ; Jstr.of_float x ; Jstr.of_float y ] - let line_to : Gg.v2 -> 'a t -> 'a t = fun point path -> let x, y = V2.to_tuple point in - Jstr.append path @@ Jstr.concat ~sep:(Jstr.v " ") - [ (Jstr.v " L") + [ path + ; (Jstr.v "L") ; (Jstr.of_float x) ; (Jstr.of_float y) ] @@ -49,9 +46,9 @@ let quadratic_to let cx, cy = V2.to_tuple ctrl0 and cx', cy' = V2.to_tuple ctrl1 and x, y = V2.to_tuple p1 in - Jstr.append path @@ Jstr.concat ~sep:(Jstr.v " ") - [ (Jstr.v " C") + [ path + ; (Jstr.v "C") ; (Jstr.of_float cx) ; (Jstr.of_float cy) ; (Jstr.v ",") @@ -65,4 +62,3 @@ let close : 'a t -> 'a t = fun path -> Jstr.append path (Jstr.v " Z") - diff --git a/path/point.ml b/path/point.ml index 808310c..abb9515 100755 --- a/path/point.ml +++ b/path/point.ml @@ -10,10 +10,10 @@ let empty = ; angle = 0. } -let create x y = +let create ~angle ~width ~x ~y = { p = Gg.V2.v x y - ; size = 10. - ; angle = Float.neg Gg.Float.pi_div_4 + ; size = width + ; angle = Gg.Float.rad_of_deg (180. -. angle ) } let copy point p = diff --git a/path/point.mli b/path/point.mli index 521eced..2c687ab 100755 --- a/path/point.mli +++ b/path/point.mli @@ -6,7 +6,7 @@ val (+): t -> Gg.v2 -> t val get_coord : t -> Gg.v2 -val create: float -> float -> t +val create: angle:float -> width:float -> x:float -> y:float -> t val copy : t -> Gg.v2 -> t diff --git a/paths.ml b/paths.ml new file mode 100755 index 0000000..2db8ab0 --- /dev/null +++ b/paths.ml @@ -0,0 +1,2 @@ +module Path_Builder = Path.Builder.Make(Path.Point) + @@ -1,53 +1,13 @@ open StdLabels open Note open Brr +open Brr_note -module Path_Builder = Path.Builder.Make(Path.Point) module CanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter) -module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg) -module Path_Printer = Path_Builder.Draw(CanvaRepr) -module Fixed_Printer = Path_Builder.DrawFixed(CanvaRepr) - -module SVG_Fixed_Printer = Path_Builder.DrawFixed(SVGRepr) - -let expected_host = [%static_hash ""] - -type mode = - | Edit - | Selection of Path_Builder.fixedPath - | Out - -let timer, tick = Elements.Timer.create () - -type current = Path_Builder.t - -(* - The state cannt hold functionnal values, and thus cannot be used to store - elements like timer - *) -type state = - { mode : mode - ; paths : Path_Builder.fixedPath list - ; current : current - } - -(** Events *) -type canva_events = - [ `Click of float * float - | `Out of float * float - ] - -type button_events = - [ `Delete - | `Export - ] - -type events = - [ canva_events - | button_events - | `Point of float * (float * float) ] +module Path_Printer = Paths.Path_Builder.Draw(CanvaRepr) +module Fixed_Printer = Paths.Path_Builder.DrawFixed(CanvaRepr) type canva_signal = Path.Point.t @@ -55,17 +15,29 @@ module Mouse = Brr_note_kit.Mouse (** Create the element in the page, and the event handler *) let canva - : Brr.El.t -> [> canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t + : Brr.El.t -> [> State.canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t = fun element -> + (* Adapt the width to the window *) El.set_inline_style El.Style.width (Jstr.v "100%") element; + (* See https://stackoverflow.com/a/14855870/13882826 *) + El.set_inline_style + El.Style.height + (Jstr.v "100%") + element; + El.set_prop El.Prop.width - (El.prop (El.Prop.int (Jstr.v "offsetWidth")) element) + (El.prop Elements.Prop.offsetWidth element) + element; + + El.set_prop + El.Prop.height + (El.prop Elements.Prop.offsetHeight element) element; El.set_inline_style @@ -73,7 +45,6 @@ let canva (Jstr.v "") element; - let module C = Brr_canvas.Canvas in let c = C.of_el element in @@ -101,156 +72,99 @@ let canva E.select [click; up], pos, c -let insert_or_replace ((x, y) as p) path = - let point = Path.Point.create x y in - match Path_Builder.peek path with - | None -> - Path_Builder.add_point - point - path - | Some p1 -> - let open Gg.V2 in - - let p1' = Path.Point.get_coord p1 in - - let dist = (norm (p1' - (of_tuple p))) in - if dist < 5. then ( - path, None - ) else ( - Path_Builder.add_point - point - path - ) - -let check_selection position paths = - let point = Gg.V2.of_tuple position in - (* If the user click on a curve, select it *) - List.fold_left paths - ~init:None - ~f:(fun selection path -> - - match selection with - | Some p -> Some p - | None -> - (* TODO : Add a method in the point module *) - begin match Path_Builder.distance point path with - | Some p when p < 20. -> - Some path - | _ -> None - end - ) - -let do_action - : events -> state -> state - = fun event state -> - match event, state.mode with - | `Point (_delay, point), Edit -> - (* Add the point in the list *) - let current, fixed_path = insert_or_replace - point - state.current in - let paths = match fixed_path with - | None -> state.paths - | Some p -> p::state.paths in - { state with current; paths } - - (* Click anywhere while in Out mode, we switch in edition *) - | `Click _, Out -> - Elements.Timer.start timer 0.3; - { state with mode = Edit } - - (* Click anywhere while in selection mode, we either select another path, - or switch to Out mode*) - | `Click position, (Selection _) -> - begin match check_selection position state.paths with - | None -> - { state with - mode = Out } - | Some selected -> - - (* Start the timer in order to handle the mouse moves *) - Elements.Timer.start timer 0.3; - { state with - mode = (Selection selected)} - end - - | `Out point, Edit -> - Elements.Timer.stop timer; - begin match Path_Builder.peek2 state.current with - (* If there is at last two points selected, handle this as a curve - creation *) - | Some _ -> - let current, fixed_path = insert_or_replace point state.current in - let paths = match fixed_path with - | None -> Path_Builder.to_fixed current::state.paths - | Some p -> p::state.paths - and current = Path_Builder.empty in - { mode = Out - ; paths; current } - - (* Else, check if there is a curve undre the cursor, and remove it *) - | None -> - let current = Path_Builder.empty in - begin match check_selection point state.paths with - | None -> - { state with - mode = Out - ; current - } - | Some selected -> - { state with - mode = (Selection selected) - ; current } - end - end - | `Delete, Selection s -> - let id = Path_Builder.id s in - let paths = List.filter state.paths ~f:(fun p -> Path_Builder.id p != id) in - { state with paths ; mode = Out} - - - | `Export, _ -> - - let my_host = Uri.host @@ Window.location @@ G.window in - - if (Hashtbl.hash my_host) = expected_host then ( - (* Convert the path into an sVG element *) - let svg = Layer.Svg.svg - ~at:Brr.At.[ - v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg") - ; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ] - (List.map state.paths - ~f:(fun path -> - let repr = SVGRepr.create_path (fun _ -> ()) in - let path = SVGRepr.get @@ SVG_Fixed_Printer.draw path repr in - - Layer.Svg.path - ~at:Brr.At.[ - v (Jstr.v "fill") (Jstr.v "#000000") - ; v (Jstr.v "stroke") (Jstr.v "#000000") - ; v (Jstr.v "d") path ] - [] - )) in - let content = El.prop (El.Prop.jstr @@ Jstr.v "outerHTML") svg in - - let btoa = Jv.get Jv.global "btoa" in - let base64data = Jv.apply btoa - [| Jv.of_jstr content |] in - - (* Create the link to download the the element, and simulate a click on it *) - let a = El.a - ~at:At.[ - href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data)) - ; v (Jstr.v "download") (Jstr.v "out.svg") - ] - [] in - El.click a +let click_event el = + Evr.on_el + Ev.click + Evr.unit + el + +let show_value input = + El.txt (Jstr.of_float input) + +let set_sidebar + : El.t -> State.state -> unit E.t * float S.t * float S.t *unit E.t + = fun element state -> + + let open El in + + let delete = + button + [ El.i + ~at:At.[ class' (Jstr.v "fas") + ; class' (Jstr.v "fa-times-circle") ] + [] + ; txt' "Delete "] in + + let delete_event = click_event delete in + + let export = + button + [ El.i + ~at:At.[ class' (Jstr.v "fas") + ; class' (Jstr.v "fa-download") ] + [] + ; txt' "Download"] in + let export_event = click_event export in + + let nib_size, nib_size_event = + Elements.Input.slider + ~at:At.[ type' (Jstr.v "range") + ; v (Jstr.v "min") (Jstr.v "1") + ; v (Jstr.v "max") (Jstr.v "50") + ; At.value (Jstr.of_float state.width) + ; id (Jstr.v "nib_size") + ] in + + let width = El.div [] in + Elr.def_children + width + (nib_size_event + |> S.map (fun v -> + [ txt' "Width : " + ; show_value v ] + ) ); - state - | _ -> state + let input_angle, angle_event = + Elements.Input.slider + ~at:At.[ type' (Jstr.v "range") + ; v (Jstr.v "min") (Jstr.v "1") + ; v (Jstr.v "max") (Jstr.v "90") + ; At.value (Jstr.of_float state.angle) + ] in + let angle = El.div [] in + Elr.def_children + angle + (angle_event + |> S.map (fun v -> + [ txt' "Angle : " + ; show_value v + ; txt' "°" ] + ) + ); + + let click = Evr.on_el Ev.click Evr.unit delete in + let _ = click in + + let () = + El.append_children element + [ hr () + ; delete + ; export + ; hr () -let backgroundColor = Jstr.v "#2e3440" + ; width + ; nib_size + ; El.br () + + ; angle + ; input_angle + + ] + in + delete_event, angle_event, nib_size_event, export_event + +let backgroundColor = Blog.Nord.nord0 let white = Jstr.v "#eceff4" let green = Jstr.v "#a3be8c" let nord8 = Jstr.v "#81a1c1" @@ -260,7 +174,6 @@ let on_change canva mouse_position state = let open Brr_canvas.C2d in let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in - let _area = Gg.V2.v w h in let context = create canva in @@ -282,9 +195,9 @@ let on_change canva mouse_position state = *) let pos = S.rough_value mouse_position in let current, paths = - begin match state.mode, pos with + begin match state.State.mode, pos with | Edit, Some point -> - begin match insert_or_replace point state.current with + begin match State.insert_or_replace state point state.current with | current, None -> current, state.paths | current, Some p -> current, p::state.paths end @@ -296,7 +209,8 @@ let on_change canva mouse_position state = let path = CanvaRepr.get @@ Path_Printer.draw current - (CanvaRepr.create_path (fun p -> fill context p)) in + (* (CanvaRepr.create_path (fun p -> fill context p)) in *) + (CanvaRepr.create_path (fun _ -> () )) in stroke context path; List.iter paths @@ -325,24 +239,24 @@ let on_change canva mouse_position state = let page_main id = - let init = - { paths = [] - ; current = Path_Builder.empty - ; mode = Out - } in - let delete_event', export_event' = + let delete_event', angle_signal', width_signal', export_event' = begin match Blog.Sidebar.get () with | None -> Jv.throw (Jstr.v "No sidebar") | Some el -> Blog.Sidebar.clean el; - let event = Blog.Sidebar.add_button el in - event + set_sidebar el State.init end in let delete_event = E.map (fun () -> `Delete) delete_event' - and export_event = E.map (fun () -> `Export) export_event' in + and export_event = E.map (fun () -> `Export) export_event' + and angle_event = S.changes angle_signal' + |> E.map (fun value -> `Angle value) + and width_event = S.changes width_signal' + |> E.map (fun value -> `Width value) + in + (*begin match Document.find_el_by_id G.document id with*) @@ -362,15 +276,21 @@ let page_main id = let tick_event = S.sample_filter mouse_position - ~on:tick + ~on:State.tick (fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in (* The first evaluation is the state. Which is the result of all the successives events to the initial state *) let state = - E.select [canva_events; tick_event; delete_event; export_event] - |> E.map do_action - |> Note.S.accum init in + E.select + [ canva_events + ; tick_event + ; angle_event + ; width_event + ; delete_event + ; export_event ] + |> E.map State.do_action + |> Note.S.accum State.init in (* The seconde evaluation is the canva refresh, which only occurs when the mouse is updated, or on delete events *) @@ -383,7 +303,7 @@ let page_main id = (* Draw the canva for first time *) - on_change canva mouse_position init; + on_change canva mouse_position State.init; (* Hold the state *) let _ = Logr.hold (S.log state (fun _ -> ())) in diff --git a/state.ml b/state.ml new file mode 100755 index 0000000..60796c8 --- /dev/null +++ b/state.ml @@ -0,0 +1,221 @@ +open StdLabels +open Brr + +module Path_Builder = Paths.Path_Builder +module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg) +module SVG_Fixed_Printer = Path_Builder.DrawFixed(SVGRepr) + + +let expected_host = [%static_hash ""] + +let backgroundColor = Blog.Nord.nord0 + +let timer, tick = Elements.Timer.create () + +type mode = + | Edit + | Selection of Path_Builder.fixedPath + | Out + +type current = Path_Builder.t + + +(** Events *) +type canva_events = + [ `Click of float * float + | `Out of float * float + ] + +type button_events = + [ `Delete + | `Export + ] + +type events = + [ canva_events + | button_events + | `Point of float * (float * float) + | `Width of float + | `Angle of float + ] + +(* + The state cannt hold functionnal values, and thus cannot be used to store + elements like timer + *) +type state = + { mode : mode + ; paths : Path_Builder.fixedPath list + ; current : current + ; width : float + ; angle : float + } + +let insert_or_replace state ((x, y) as p) path = + let width = state.width + and angle = state.angle in + let point = Path.Point.create ~x ~y ~angle ~width in + match Path_Builder.peek path with + | None -> + Path_Builder.add_point + point + path + | Some p1 -> + let open Gg.V2 in + + let p1' = Path.Point.get_coord p1 in + + let dist = (norm (p1' - (of_tuple p))) in + if dist < 5. then ( + path, None + ) else ( + Path_Builder.add_point + point + path + ) + +let check_selection + : (float * float) -> Path_Builder.fixedPath list -> Path_Builder.fixedPath option + = fun position paths -> + let point = Gg.V2.of_tuple position in + (* If the user click on a curve, select it *) + List.fold_left paths + ~init:None + ~f:(fun selection path -> + + match selection with + | Some p -> Some p + | None -> + (* TODO : Add a method in the point module *) + begin match Path_Builder.distance point path with + | Some p when p < 20. -> + Some path + | _ -> None + end + ) + + +let do_action + : events -> state -> state + = fun event state -> + match event, state.mode with + | `Point (_delay, point), Edit -> + (* Add the point in the list *) + let current, fixed_path = insert_or_replace + state + point + state.current in + let paths = match fixed_path with + | None -> state.paths + | Some p -> p::state.paths in + { state with current; paths } + + (* Click anywhere while in Out mode, we switch in edition *) + | `Click _, Out -> + Elements.Timer.start timer 0.3; + { state with mode = Edit } + + (* Click anywhere while in selection mode, we either select another path, + or switch to Out mode*) + | `Click position, (Selection _) -> + begin match check_selection position state.paths with + | None -> + { state with + mode = Out } + | Some selected -> + + (* Start the timer in order to handle the mouse moves *) + Elements.Timer.start timer 0.3; + { state with + mode = (Selection selected)} + end + + | `Out point, Edit -> + Elements.Timer.stop timer; + begin match Path_Builder.peek2 state.current with + (* If there is at last two points selected, handle this as a curve + creation *) + | Some _ -> + let current, fixed_path = insert_or_replace state point state.current in + let paths = match fixed_path with + | None -> Path_Builder.to_fixed current::state.paths + | Some p -> p::state.paths + and current = Path_Builder.empty in + { state with + mode = Out + ; paths; current } + + (* Else, check if there is a curve undre the cursor, and remove it *) + | None -> + let current = Path_Builder.empty in + begin match check_selection point state.paths with + | None -> + { state with + mode = Out + ; current + } + | Some selected -> + { state with + mode = (Selection selected) + ; current } + end + end + | `Delete, Selection s -> + let id = Path_Builder.id s in + let paths = List.filter state.paths ~f:(fun p -> Path_Builder.id p != id) in + { state with paths ; mode = Out} + + + | `Export, _ -> + + let my_host = Uri.host @@ Window.location @@ G.window in + + if (Hashtbl.hash my_host) = expected_host then ( + (* Convert the path into an sVG element *) + let svg = Layer.Svg.svg + ~at:Brr.At.[ + v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg") + ; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ] + (List.map state.paths + ~f:(fun path -> + let repr = SVGRepr.create_path (fun _ -> ()) in + let path = SVGRepr.get @@ SVG_Fixed_Printer.draw path repr in + + Layer.Svg.path + ~at:Brr.At.[ + v (Jstr.v "fill") backgroundColor + ; v (Jstr.v "stroke") backgroundColor + ; v (Jstr.v "d") path ] + [] + )) in + let content = El.prop Elements.Prop.outerHTML svg in + + let btoa = Jv.get Jv.global "btoa" in + let base64data = Jv.apply btoa + [| Jv.of_jstr content |] in + + (* Create the link to download the the element, and simulate a click on it *) + let a = El.a + ~at:At.[ + href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data)) + ; v (Jstr.v "download") (Jstr.v "out.svg") + ] + [] in + El.click a + ); + state + + | `Angle angle, _ -> + { state with angle} + | `Width width, _ -> + { state with width} + + | _ -> state + +let init = + { paths = [] + ; current = Path_Builder.empty + ; mode = Out + ; angle = 30. + ; width = 10. + } diff --git a/theme/dune b/theme/dune deleted file mode 100755 index a812bef..0000000 --- a/theme/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name theme) - (libraries - color - gg - ) - ) diff --git a/theme/nord.ml b/theme/nord.ml deleted file mode 100755 index 4748d83..0000000 --- a/theme/nord.ml +++ /dev/null @@ -1,39 +0,0 @@ -open StdLabels - -let default = Color.of_rgb 5 255 255 - -let theme = - [| "#2e3440" - ; "#3b4252" - ; "#434c5e" - ; "#4c566a" - (* Bright *) - ; "#d8dee9" - ; "" - ; "#eceff4" - (* Frost *) - ; "#8fbcbb" - ; "" - ; "" - ; "" - (* Aurora 11 - *) - ; "#bf616a" (* Redd color *) - ; "" - ; "" - ; "#a3be8c" (* Green color *) - - - |] - |> Array.map ~f:(fun f -> - Color.of_hexstring f - |> Option.value ~default - ) - -let set_color t f = - let Color.Rgba'.{r; g; b; _ } = Color.to_rgba' (Array.get theme t) in - f r g b - - -let to_gg t = - let Color.Rgba'.{r; g; b; _ } = Color.to_rgba' (Array.get theme t) in - Gg.Color.of_srgb (Gg.V4.v r g b 1.) diff --git a/theme/theme.ml b/theme/theme.ml deleted file mode 100755 index 39974b1..0000000 --- a/theme/theme.ml +++ /dev/null @@ -1 +0,0 @@ -module Nord = Nord |