package miaou-core

  1. Overview
  2. Docs
Miaou core/widgets (no drivers, no SDL)

Install 

dune-project
 Dependency

github.com Edit opam file Versions (1)

Authors

  1. N
    Nomadic Labs <contact@nomadic-labs.com>

Maintainers

  1. N
    Nomadic Labs <contact@nomadic-labs.com>

Sources

v0.5.2.tar.gz
md5=60a3b9f181f24572a06a9492532bfdda
sha512=fcc35a275066be2900e6201782faf47503076fa4640f08cf78067835a6f447b74613009e55b2ac799adb7ca46f1bffa261fc5971753f2cc3c6bef327511c7ef6

doc/src/miaou-core.style/style_context.ml.html

Source file style_context.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
155
156
157
158
159
160
161
162
163
164
165
166
(******************************************************************************)
(*                                                                            *)
(* SPDX-License-Identifier: MIT                                               *)
(* Copyright (c) 2026 Nomadic Labs <contact@nomadic-labs.com>                 *)
(*                                                                            *)
(******************************************************************************)

type _ Effect.t += Get_theme : Theme.t Effect.t

type _ Effect.t += Get_match_context : Selector.match_context Effect.t

(* Effect for updating the theme at runtime *)
type _ Effect.t += Set_theme : Theme.t -> unit Effect.t

let with_theme (theme : Theme.t) (f : unit -> 'a) : 'a =
  Effect.Deep.try_with
    f
    ()
    {
      effc =
        (fun (type a) (eff : a Effect.t) ->
          match eff with
          | Get_theme ->
              Some
                (fun (k : (a, _) Effect.Deep.continuation) ->
                  Effect.Deep.continue k theme)
          | _ -> None);
    }

let with_mutable_theme (initial : Theme.t) (f : unit -> 'a) : 'a =
  let theme_ref = ref initial in
  Effect.Deep.try_with
    f
    ()
    {
      effc =
        (fun (type a) (eff : a Effect.t) ->
          match eff with
          | Get_theme ->
              Some
                (fun (k : (a, _) Effect.Deep.continuation) ->
                  Effect.Deep.continue k !theme_ref)
          | Set_theme new_theme ->
              Some
                (fun (k : (a, _) Effect.Deep.continuation) ->
                  theme_ref := new_theme ;
                  Effect.Deep.continue k ())
          | _ -> None);
    }

let set_theme theme =
  try Effect.perform (Set_theme theme)
  with Effect.Unhandled (Set_theme _) ->
    (* No mutable handler installed, silently ignore *)
    ()

let reload_theme () =
  let theme = Theme_loader.load () in
  set_theme theme ;
  theme

let with_context (theme : Theme.t) (ctx : Selector.match_context)
    (f : unit -> 'a) : 'a =
  Effect.Deep.try_with
    f
    ()
    {
      effc =
        (fun (type a) (eff : a Effect.t) ->
          match eff with
          | Get_theme ->
              Some
                (fun (k : (a, _) Effect.Deep.continuation) ->
                  Effect.Deep.continue k theme)
          | Get_match_context ->
              Some
                (fun (k : (a, _) Effect.Deep.continuation) ->
                  Effect.Deep.continue k ctx)
          | _ -> None);
    }

let current_theme () : Theme.t =
  try Effect.perform Get_theme
  with Effect.Unhandled Get_theme -> Theme.default

let current_context () : Selector.match_context =
  try Effect.perform Get_match_context
  with Effect.Unhandled Get_match_context -> Selector.empty_context

let with_child_context ?widget_name ?focused ?selected ?index ?count ?ancestors
    (f : unit -> 'a) : 'a =
  let theme = current_theme () in
  let parent_ctx = current_context () in
  let new_ctx =
    {
      Selector.widget_name =
        Option.value widget_name ~default:parent_ctx.widget_name;
      focused = Option.value focused ~default:parent_ctx.focused;
      selected = Option.value selected ~default:parent_ctx.selected;
      hover = parent_ctx.hover;
      disabled = parent_ctx.disabled;
      child_index = index;
      child_count = count;
      ancestors =
        (match ancestors with
        | Some a -> a
        | None ->
            if parent_ctx.widget_name <> "" then
              parent_ctx.widget_name :: parent_ctx.ancestors
            else parent_ctx.ancestors);
    }
  in
  with_context theme new_ctx f

let current_style () : Theme.widget_style =
  let theme = current_theme () in
  let ctx = current_context () in
  Theme.resolve_style theme ctx

let primary () = (current_theme ()).primary

let secondary () = (current_theme ()).secondary

let accent () = (current_theme ()).accent

let error () = (current_theme ()).error

let warning () = (current_theme ()).warning

let success () = (current_theme ()).success

let info () = (current_theme ()).info

let text () = (current_theme ()).text

let text_muted () = (current_theme ()).text_muted

let text_emphasized () = (current_theme ()).text_emphasized

let background () = (current_theme ()).background

let background_secondary () = (current_theme ()).background_secondary

let selection () = (current_theme ()).selection

let border ?(focus = false) () =
  let theme = current_theme () in
  if focus then theme.border_focused else theme.border

let default_border_style () = (current_theme ()).default_border_style

let styled s =
  let theme = current_theme () in
  let ws = current_style () in
  let resolved = Style.to_resolved ~dark_mode:theme.dark_mode ws.style in
  Style.apply resolved s

let styled_with style s =
  let theme = current_theme () in
  let resolved = Style.to_resolved ~dark_mode:theme.dark_mode style in
  Style.apply resolved s

let widget_style name =
  let theme = current_theme () in
  let ctx = {(current_context ()) with widget_name = name} in
  Theme.resolve_style theme ctx