feat(minttea): supporting ctrl-key modifiers

examples/altscreen-toggle/main.ml

@@ -13,7 +13,7 @@ let initial_model = { altscreen = false; quitting = false }
 
 let update event model =
   match event with
-  | Event.KeyDown (Key "q" | Escape) ->
+  | Event.KeyDown (Key { key = "q"; _ } | Escape) ->
       ({ model with quitting = true }, Command.Quit)
   | Event.KeyDown Space ->
       let cmd =

examples/basic/main.ml

@@ -30,16 +30,16 @@ let init _model = Command.Noop
 let update event model =
   match event with
   (* if we press `q` or the escape key, we exit *)
-  | Event.KeyDown (Key "q" | Escape) -> (model, Command.Quit)
+  | Event.KeyDown (Key { key = "q"; _ } | Escape) -> (model, Command.Quit)
   (* if we press up or `k`, we move up in the list *)
-  | Event.KeyDown (Up | Key "k") ->
+  | Event.KeyDown (Up | Key { key = "k"; _ }) ->
       let cursor =
         if model.cursor = 0 then List.length model.choices - 1
         else model.cursor - 1
       in
       ({ model with cursor }, Command.Noop)
   (* if we press down or `j`, we move down in the list *)
-  | Event.KeyDown (Down | Key "j") ->
+  | Event.KeyDown (Down | Key { key = "j"; _ }) ->
       let cursor =
         if model.cursor = List.length model.choices - 1 then 0
         else model.cursor + 1

examples/border/main.ml

@@ -16,8 +16,8 @@ let initial_model = { text = "" }
 
 let update event model =
   match event with
-  | Event.KeyDown (Key "q" | Escape) -> (model, Command.Quit)
-  | Event.KeyDown (Key k) ->
+  | Event.KeyDown (Key { key = "q"; _ } | Escape) -> (model, Command.Quit)
+  | Event.KeyDown (Key { key = k; _ }) ->
       let model = { text = model.text ^ k } in
       (model, Command.Noop)
   | Event.KeyDown Space ->

examples/counter/main.ml

@@ -14,8 +14,8 @@ let initial_model = { counter = 0; keys = [] }
 
 let update event model =
   match event with
-  | Event.KeyDown (Key "q" | Escape) -> (model, Command.Quit)
-  | Event.KeyDown (Key k) ->
+  | Event.KeyDown (Key { key = "q"; _ } | Escape) -> (model, Command.Quit)
+  | Event.KeyDown (Key { key = k; _ }) ->
       let model = { counter = model.counter + 1; keys = model.keys @ [ k ] } in
       (model, Command.Noop)
   | _ -> (model, Command.Noop)

examples/emoji/main.ml

@@ -70,31 +70,31 @@ let update event m =
           [ (m.player_view, m.player_pos); (Sprite.view monkey, m.monkey_pos) ]
       in
       ({ m with screen; monkey }, Command.Noop)
-  | Event.KeyDown (Down | Key "j") ->
+  | Event.KeyDown (Down | Key { key = "j"; _ }) ->
       let player_pos =
         let x, y = m.player_pos in
         (x, Int.min (Tilemap.h - 1) (y + 1))
       in
       ({ m with player_pos }, Command.Noop)
-  | Event.KeyDown (Up | Key "k") ->
+  | Event.KeyDown (Up | Key { key = "k"; _ }) ->
       let player_pos =
         let x, y = m.player_pos in
         (x, Int.max 0 (y - 1))
       in
       ({ m with player_pos }, Command.Noop)
-  | Event.KeyDown (Right | Key "l") ->
+  | Event.KeyDown (Right | Key { key = "l"; _ }) ->
       let player_pos =
         let x, y = m.player_pos in
         (Int.min (Tilemap.w - 1) (x + 1), y)
       in
       ({ m with player_pos }, Command.Noop)
-  | Event.KeyDown (Left | Key "h") ->
+  | Event.KeyDown (Left | Key { key = "h"; _ }) ->
       let player_pos =
         let x, y = m.player_pos in
         (Int.max 0 (x - 1), y)
       in
       ({ m with player_pos }, Command.Noop)
-  | Event.KeyDown (Key "q") -> (m, Command.Quit)
+  | Event.KeyDown (Key { key = "q"; _ }) -> (m, Command.Quit)
   | _ -> (m, Command.Noop)
 
 let view m =

examples/fps/main.ml

@@ -16,8 +16,8 @@ let initial_model = { frames = 0; fps = 30; last_frame = Ptime_clock.now () }
 
 let update event model =
   match event with
-  | Event.KeyDown (Key "q") -> (model, Command.Quit)
-  | Event.KeyDown (Key "s") ->
+  | Event.KeyDown (Key { key = "q"; _ }) -> (model, Command.Quit)
+  | Event.KeyDown (Key { key = "s"; _ }) ->
       sleep 0.5;
       (model, Command.Noop)
   | Event.Frame now ->

examples/fullscreen/main.ml

@@ -6,7 +6,7 @@ let initial_model = 3
 
 let update event model =
   match event with
-  | Event.KeyDown (Key "q" | Escape) -> (model, Command.Quit)
+  | Event.KeyDown (Key { key = "q"; _ } | Escape) -> (model, Command.Quit)
   | Event.Timer _ref ->
       let model = model - 1 in
       if model <= 0 then (model, Command.Quit)

examples/layout/main.ml

@@ -22,14 +22,14 @@ let init _model = Command.Noop
 (* Update function with pattern matching for events *)
 let update event model =
   match event with
-  | Event.KeyDown (Key "q" | Escape) -> (model, Command.Quit)
-  | Event.KeyDown (Up | Key "k") ->
+  | Event.KeyDown (Key { key = "q"; _ } | Escape) -> (model, Command.Quit)
+  | Event.KeyDown (Up | Key { key = "k"; _ }) ->
       let cursor =
         if model.cursor = 0 then List.length model.choices - 1
         else model.cursor - 1
       in
       ({ model with cursor }, Command.Noop)
-  | Event.KeyDown (Down | Key "j") ->
+  | Event.KeyDown (Down | Key { key = "j"; _ }) ->
       let cursor =
         if model.cursor = List.length model.choices - 1 then 0
         else model.cursor + 1

examples/list/main.ml

@@ -77,9 +77,9 @@ let update event model : model * Command.t =
         let elements = FList.get_selection model.elements in
         ({ model with choices = Some elements }, Command.Quit)
     (* Quit right away *)
-    | Event.KeyDown (Key "q" | Escape) -> (model, Command.Quit)
+    | Event.KeyDown (Key { key = "q"; _ } | Escape) -> (model, Command.Quit)
     (* Open the search Text_input *)
-    | Event.KeyDown (Key "/") ->
+    | Event.KeyDown (Key { key = "/"; _ }) ->
         ({ model with edit_filter = true }, Command.Noop)
     (* Delegate the rest to the list *)
     | _ ->

examples/paginator/main.ml

@@ -11,7 +11,7 @@ let init _ = Command.Hide_cursor
 
 let update (event : Event.t) model =
   match event with
-  | Event.KeyDown (Key "q") -> (model, Command.Quit)
+  | Event.KeyDown (Key { key = "q"; _ }) -> (model, Command.Quit)
   | _ ->
       ( { model with paginator = Paginator.update model.paginator event },
         Command.Noop )

examples/progress/main.ml

@@ -30,7 +30,7 @@ let initial_model =
 
 let update event m =
   match event with
-  | Event.KeyDown (Key "q" | Escape) -> (m, Command.Quit)
+  | Event.KeyDown (Key { key = "q"; _ } | Escape) -> (m, Command.Quit)
   | Event.Frame _now ->
       let gray_bar = Progress.increment m.gray_bar 0.001 in
       let color_bar = Progress.increment m.color_bar (Random.float 0.0001) in

examples/spinner/main.ml

@@ -32,7 +32,7 @@ let update event model =
   | Event.Frame now ->
       let spinners = model.spinners |> List.map (Sprite.update ~now) in
       ({ spinners }, Command.Noop)
-  | Event.KeyDown (Key "q") -> (model, Command.Quit)
+  | Event.KeyDown (Key { key = "q"; _ }) -> (model, Command.Quit)
   | _ -> (model, Command.Noop)
 
 let view model =

examples/stopwatch/main.ml

@@ -25,14 +25,14 @@ let initial_model =
 
 let update event model =
   match event with
-  | Event.KeyDown (Key "r") ->
+  | Event.KeyDown (Key { key = "r"; _ }) ->
       let start_time = Ptime_clock.now () in
       let measured = 0. in
       ({ model with start_time; measured }, Command.Set_timer (ref, 0.01))
-  | Event.KeyDown (Key "s") ->
+  | Event.KeyDown (Key { key = "s"; _ }) ->
       let stopped = not model.stopped in
       ({ model with stopped }, Command.Set_timer (ref, 0.01))
-  | Event.KeyDown (Key "q" | Escape) ->
+  | Event.KeyDown (Key { key = "q"; _ } | Escape) ->
       ({ model with quit = true }, Command.Quit)
   | Event.Timer _ref ->
       let model =

examples/table/main.ml

@@ -128,10 +128,10 @@ let init _ = Command.Noop
 
 let update event model =
   match event with
-  | Event.KeyDown (Key "q") -> (model, Command.Quit)
-  | Event.KeyDown (Key "b") ->
+  | Event.KeyDown (Key { key = "q"; _ }) -> (model, Command.Quit)
+  | Event.KeyDown (Key { key = "b"; _ }) ->
       ({ table = Table.update model.table Table.PageUp }, Command.Noop)
-  | Event.KeyDown (Key "f") | Event.KeyDown Space ->
+  | Event.KeyDown (Key { key = "f"; _ }) | Event.KeyDown Space ->
       ({ table = Table.update model.table Table.PageDown }, Command.Noop)
   | Event.KeyDown Up ->
       ({ table = Table.update model.table Table.Up }, Command.Noop)

examples/views/main.ml

@@ -80,7 +80,8 @@ exception Exit
 
 let update event model =
   try
-    if event = Event.KeyDown (Key "q") then raise Exit
+    if event = Event.KeyDown (Key { key = "q"; modifier = None }) then
+      raise Exit
     else
       let section, cmd =
         match model.section with
@@ -107,9 +108,9 @@ let update event model =
         | Selection_screen screen -> (
             match event with
             | Event.KeyDown Space -> transition model.section
-            | Event.KeyDown (Key "j" | Down) ->
+            | Event.KeyDown (Key { key = "j"; _ } | Down) ->
                 (Selection_screen (select_next screen), Command.Noop)
-            | Event.KeyDown (Key "k" | Up) ->
+            | Event.KeyDown (Key { key = "k"; _ } | Up) ->
                 (Selection_screen (select_prev screen), Command.Noop)
             | Event.Timer ref ->
                 let timeout = screen.timeout - 1 in

leaves/filtered_list.ml

@@ -89,7 +89,7 @@ let next_visible cur shown =
 
 let update event (model : t) =
   match event with
-  | Event.KeyDown (Key "s" | Space) ->
+  | Event.KeyDown (Key { key = "s"; _ } | Space) ->
       (* select current element *)
       {
         model with
@@ -99,7 +99,7 @@ let update event (model : t) =
               if idx = model.cursor then (not s, e) else (s, e))
             model.elements;
       }
-  | Event.KeyDown (Up | Key "k") ->
+  | Event.KeyDown (Up | Key { key = "k"; _ }) ->
       let len = List.length model.elements in
       if len = 0 then model
       else
@@ -110,7 +110,7 @@ let update event (model : t) =
             | None -> (model.cursor + len - 1) mod len
             | Some shown -> prev_visible model.cursor shown);
         }
-  | Event.KeyDown (Down | Key "j") ->
+  | Event.KeyDown (Down | Key { key = "j"; _ }) ->
       let len = List.length model.elements in
       if len = 0 then model
       else
@@ -121,10 +121,10 @@ let update event (model : t) =
             | None -> (model.cursor + 1) mod len
             | Some shown -> next_visible model.cursor shown);
         }
-  | Event.KeyDown (Left | Key "h") ->
+  | Event.KeyDown (Left | Key { key = "h"; _ }) ->
       (* previous page, not wrapping *)
       { model with cursor = max (model.cursor - model.max_height) 0 }
-  | Event.KeyDown (Right | Key "l") ->
+  | Event.KeyDown (Right | Key { key = "l"; _ }) ->
       (* next page, not wrapping *)
       {
         model with

leaves/paginator.ml

@@ -52,8 +52,8 @@ let make ?(style = Numerals) ?(page = 0) ?(per_page = 1) ?(total_pages = 1)
 
 let update t (e : Minttea.Event.t) =
   match e with
-  | KeyDown (Key "h" | Left) -> prev_page t
-  | KeyDown (Key "l" | Right) -> next_page t
+  | KeyDown (Key { key = "h"; _ } | Left) -> prev_page t
+  | KeyDown (Key { key = "l"; _ } | Right) -> next_page t
   | _ -> t
 
 let dots_view t text_style =

leaves/text_input.ml

@@ -95,7 +95,7 @@ let update t (e : Minttea.Event.t) =
       {
         (match k with
         | Backspace -> backspace t
-        | Key s -> write t s
+        | Key s -> write t s.key
         | Left -> character_backward t
         | Right -> character_forward t
         | Space -> space t

minttea/event.ml

@@ -1,5 +1,8 @@
 open Riot
 
+type modifier = Ctrl
+type key_event = { key : string; modifier : modifier option }
+
 type key =
   | Up
   | Down
@@ -9,7 +12,7 @@ type key =
   | Escape
   | Backspace
   | Enter
-  | Key of string
+  | Key of key_event
 
 let key_to_string key =
   match key with
@@ -21,7 +24,8 @@ let key_to_string key =
   | Escape -> "<esc>"
   | Backspace -> "<backspace>"
   | Enter -> "<enter>"
-  | Key k -> k
+  | Key { key; modifier = Some Ctrl } -> "<c-" ^ key ^ ">"
+  | Key { key; modifier = None } -> key
 
 type t =
   | KeyDown of key

minttea/io_loop.ml

@@ -4,7 +4,8 @@ open Tty
 
 type Message.t += Input of Event.t
 
-let translate : string -> Event.key = function
+let translate ?(modifier = None) key =
+  match key with
   | " " -> Space
   | "\027" -> Escape
   | "\027[A" -> Up
@@ -13,7 +14,7 @@ let translate : string -> Event.key = function
   | "\027[D" -> Left
   | "\127" -> Backspace
   | "\n" -> Enter
-  | key -> Key key
+  | key -> Key { key; modifier }
 
 let rec loop runner =
   yield ();
@@ -28,6 +29,11 @@ let rec loop runner =
                 | `Read key -> KeyDown (translate ("\027[" ^ key))
                 | _ -> KeyDown (translate key))
             | _ -> KeyDown (translate key))
+        | key when key >= "\x01" && key <= "\x1a" ->
+            let key =
+              key.[0] |> Char.code |> ( + ) 96 |> Char.chr |> String.make 1
+            in
+            KeyDown (translate ~modifier:(Some Ctrl) key)
         | key -> KeyDown (translate key)
       in
       send runner (Input msg);

minttea/minttea.mli

@@ -1,6 +1,9 @@
 open Riot
 
 module Event : sig
+  type modifier = Ctrl
+  type key_event = { key : string; modifier : modifier option }
+
   type key =
     | Up
     | Down
@@ -10,7 +13,7 @@ module Event : sig
     | Escape
     | Backspace
     | Enter
-    | Key of string
+    | Key of key_event
 
   type t =
     | KeyDown of key