···
(* Kitty Terminal Graphics Protocol - Implementation *)
+
(* Polymorphic variant types *)
+
type format = [ `Rgba32 | `Rgb24 | `Png ]
+
type transmission = [ `Direct | `File | `Tempfile ]
+
type compression = [ `None | `Zlib ]
+
type quiet = [ `Noisy | `Errors_only | `Silent ]
+
type cursor = [ `Move | `Static ]
+
type composition = [ `Alpha_blend | `Overwrite ]
+
| `All_visible_and_free
+
| `By_id of int * int option
+
| `By_id_and_free of int * int option
+
| `By_number of int * int option
+
| `By_number_and_free of int * int option
+
| `At_cell of int * int
+
| `At_cell_and_free of int * int
+
| `At_cell_z of int * int * int
+
| `At_cell_z_and_free of int * int * int
+
| `By_column_and_free of int
+
| `By_row_and_free of int
+
| `By_z_index_and_free of int
+
| `By_id_range of int * int
+
| `By_id_range_and_free of int * int
+
type animation_state = [ `Stop | `Loading | `Run ]
+
(* Modules re-export the types with conversion functions *)
+
let to_int : t -> int = function
module Transmission = struct
+
let to_char : t -> char = function
module Compression = struct
+
let to_char : t -> char option = function
+
let to_int : t -> int = function
+
let to_int : t -> int = function
module Composition = struct
+
let to_int : t -> int = function
module Placement = struct
···
placement_id : int option;
+
cursor : cursor option;
unicode_placeholder : bool;
···
+
composition : composition option;
background_color : int32 option;
···
module Animation = struct
+
type state = animation_state
+
[ `Set_state of state * int option
+
| `Set_gap of int * int
+
| `Set_current of int ]
+
let set_state ?loops state = `Set_state (state, loops)
+
let set_gap ~frame ~gap_ms = `Set_gap (frame, gap_ms)
+
let set_current_frame frame = `Set_current frame
···
+
composition : composition option;
let make ~source_frame ~dest_frame ?width ?height ?source_x ?source_y ?dest_x
···
+
| `Transmit_and_display
+
format : format option;
+
transmission : transmission option;
+
compression : compression option;
image_number : int option;
placement : Placement.t option;
+
delete : delete option;
animation : Animation.t option;
compose : Compose.t option;
···
let transmit ?image_id ?image_number ?format ?transmission ?compression ?width
?height ?size ?offset ?quiet () =
···
let transmit_and_display ?image_id ?image_number ?format ?transmission
?compression ?width ?height ?size ?offset ?quiet ?placement () =
+
(make `Transmit_and_display) with
···
let query ?format ?transmission ?width ?height ?quiet () =
+
{ (make `Query) with format; transmission; width; height; quiet }
let display ?image_id ?image_number ?placement ?quiet () =
+
{ (make `Display) with image_id; image_number; placement; quiet }
+
let delete ?quiet del = { (make `Delete) with quiet; delete = Some del }
let frame ?image_id ?image_number ?format ?transmission ?compression ?width
?height ?quiet ~frame () =
···
let animate ?image_id ?image_number ?quiet anim =
+
{ (make `Animate) with image_id; image_number; quiet; animation = Some anim }
let compose ?image_id ?image_number ?quiet comp =
+
{ (make `Compose) with image_id; image_number; quiet; compose = Some comp }
+
(* Serialization helpers *)
+
(* Key-value writer with separator handling *)
+
type kv_writer = { mutable first : bool; buf : Buffer.t }
+
let kv_writer buf = { first = true; buf }
+
if not w.first then Buffer.add_char w.buf ',';
+
Buffer.add_char w.buf key;
+
Buffer.add_char w.buf '=';
+
Buffer.add_string w.buf value
+
let kv_int w key value = kv w key (string_of_int value)
+
let kv_int32 w key value = kv w key (Int32.to_string value)
+
let kv_char w key value = kv w key (String.make 1 value)
+
(* Conditional writers using Option.iter *)
+
let kv_int_opt w key = Option.iter (kv_int w key)
+
let kv_int32_opt w key = Option.iter (kv_int32 w key)
+
let kv_int_if w key ~default opt =
+
Option.iter (fun v -> if v <> default then kv_int w key v) opt
+
let action_char : action -> char = function
+
| `Transmit_and_display -> 'T'
+
let delete_char : delete -> char = function
+
| `All_visible_and_free -> 'A'
+
| `By_id_and_free _ -> 'I'
+
| `By_number_and_free _ -> 'N'
+
| `At_cursor_and_free -> 'C'
+
| `At_cell_and_free _ -> 'P'
+
| `At_cell_z_and_free _ -> 'Q'
+
| `By_column_and_free _ -> 'X'
+
| `By_row_and_free _ -> 'Y'
+
| `By_z_index_and_free _ -> 'Z'
+
| `By_id_range _ -> 'r'
+
| `By_id_range_and_free _ -> 'R'
+
| `Frames_and_free -> 'F'
+
let write_placement w (p : Placement.t) =
+
kv_int_opt w 'x' p.source_x;
+
kv_int_opt w 'y' p.source_y;
+
kv_int_opt w 'w' p.source_width;
+
kv_int_opt w 'h' p.source_height;
+
kv_int_opt w 'X' p.cell_x_offset;
+
kv_int_opt w 'Y' p.cell_y_offset;
+
kv_int_opt w 'c' p.columns;
+
kv_int_opt w 'r' p.rows;
+
kv_int_opt w 'z' p.z_index;
+
kv_int_opt w 'p' p.placement_id;
+
p.cursor |> Option.iter (fun c -> kv_int_if w 'C' ~default:0 (Some (Cursor.to_int c)));
+
if p.unicode_placeholder then kv_int w 'U' 1
+
let write_delete w (d : delete) =
+
kv_char w 'd' (delete_char d);
+
| `By_id (id, pid) | `By_id_and_free (id, pid) ->
+
| `By_number (n, pid) | `By_number_and_free (n, pid) ->
+
| `At_cell (x, y) | `At_cell_and_free (x, y) ->
+
| `At_cell_z (x, y, z) | `At_cell_z_and_free (x, y, z) ->
+
| `By_column c | `By_column_and_free c -> kv_int w 'x' c
+
| `By_row r | `By_row_and_free r -> kv_int w 'y' r
+
| `By_z_index z | `By_z_index_and_free z -> kv_int w 'z' z
+
| `By_id_range (min_id, max_id) | `By_id_range_and_free (min_id, max_id) ->
+
| `All_visible | `All_visible_and_free | `At_cursor | `At_cursor_and_free
+
| `Frames | `Frames_and_free ->
+
let write_frame w (f : Frame.t) =
+
kv_int_opt w 'c' f.base_frame;
+
kv_int_opt w 'r' f.edit_frame;
+
kv_int_opt w 'z' f.gap_ms;
+
|> Option.iter (fun c -> kv_int_if w 'X' ~default:0 (Some (Composition.to_int c)));
+
kv_int32_opt w 'Y' f.background_color
+
let write_animation w : Animation.t -> unit = function
+
| `Set_state (state, loops) ->
+
let s = match state with `Stop -> 1 | `Loading -> 2 | `Run -> 3 in
+
| `Set_gap (frame, gap_ms) ->
+
| `Set_current frame -> kv_int w 'c' frame
+
let write_compose w (c : Compose.t) =
+
kv_int w 'r' c.source_frame;
+
kv_int w 'c' c.dest_frame;
+
kv_int_opt w 'w' c.width;
+
kv_int_opt w 'h' c.height;
+
kv_int_opt w 'x' c.dest_x;
+
kv_int_opt w 'y' c.dest_y;
+
kv_int_opt w 'X' c.source_x;
+
kv_int_opt w 'Y' c.source_y;
+
|> Option.iter (fun comp -> kv_int_if w 'C' ~default:0 (Some (Composition.to_int comp)))
let write_control_data buf cmd =
+
let w = kv_writer buf in
+
kv_char w 'a' (action_char cmd.action);
+
(* Quiet - only if non-default *)
+
cmd.quiet |> Option.iter (fun q -> kv_int_if w 'q' ~default:0 (Some (Quiet.to_int q)));
+
cmd.format |> Option.iter (fun f -> kv_int w 'f' (Format.to_int f));
+
(* Transmission - only if non-default *)
+
|> Option.iter (fun t ->
+
let c = Transmission.to_char t in
+
if c <> 'd' then kv_char w 't' c);
+
cmd.compression |> Option.iter (fun c -> Compression.to_char c |> Option.iter (kv_char w 'o'));
+
kv_int_opt w 's' cmd.width;
+
kv_int_opt w 'v' cmd.height;
+
kv_int_opt w 'S' cmd.size;
+
kv_int_opt w 'O' cmd.offset;
+
kv_int_opt w 'i' cmd.image_id;
+
kv_int_opt w 'I' cmd.image_number;
+
cmd.placement |> Option.iter (write_placement w);
+
cmd.delete |> Option.iter (write_delete w);
+
cmd.frame |> Option.iter (write_frame w);
+
cmd.animation |> Option.iter (write_animation w);
+
cmd.compose |> Option.iter (write_compose w);
let write buf cmd ~data =
Buffer.add_string buf apc_start;
+
let w = write_control_data buf cmd in
if String.length data > 0 then begin
let encoded = Base64.encode_string data in
let len = String.length encoded in
···
Buffer.add_string buf apc_end)
+
let rec write_chunks pos first =
+
if pos < len then begin
+
let remaining = len - pos in
+
let this_chunk = min chunk_size remaining in
+
let is_last = pos + this_chunk >= len in
+
Buffer.add_char buf ';';
+
Buffer.add_substring buf encoded pos this_chunk;
+
Buffer.add_string buf apc_end)
+
Buffer.add_string buf apc_start;
+
Buffer.add_string buf (if is_last then "m=0" else "m=1");
+
Buffer.add_char buf ';';
+
Buffer.add_substring buf encoded pos this_chunk;
+
Buffer.add_string buf apc_end);
+
write_chunks (pos + this_chunk) false
else Buffer.add_string buf apc_end
···
+
else String.index_opt t.message ':' |> Option.fold ~none:(Some t.message) ~some:(fun i -> Some (String.sub t.message 0 i))
let image_id t = t.image_id
let image_number t = t.image_number
let placement_id t = t.placement_id
+
let ( let* ) = Option.bind in
let len = String.length s in
+
let* () = if len >= 5 && s.[0] = esc && s.[1] = '_' && s.[2] = 'G' then Some () else None in
+
let* semi_pos = String.index_from_opt s 3 ';' in
+
if pos + 1 < len && s.[pos] = esc && s.[pos + 1] = '\\' then Some pos
+
else if pos + 1 < len then find_end (pos + 1)
+
let* end_pos = find_end (semi_pos + 1) in
+
let keys_str = String.sub s 3 (semi_pos - 3) in
+
let message = String.sub s (semi_pos + 1) (end_pos - semi_pos - 1) in
+
if String.length part >= 3 && part.[1] = '=' then
+
Some (part.[0], String.sub part 2 (String.length part - 2))
+
let keys = String.split_on_char ',' keys_str |> List.filter_map parse_kv in
+
let find_int key = List.assoc_opt key keys |> Fun.flip Option.bind int_of_string_opt in
+
image_id = find_int 'i';
+
image_number = find_int 'I';
+
placement_id = find_int 'p';
module Unicode_placeholder = struct
let placeholder_char = Uchar.of_int 0x10EEEE
0x0305; 0x030D; 0x030E; 0x0310; 0x0312; 0x033D; 0x033E; 0x033F;
···
0x1D1AA; 0x1D1AB; 0x1D1AC; 0x1D1AD; 0x1D242; 0x1D243; 0x1D244;
+
Uchar.of_int diacritics.(n mod Array.length diacritics)
+
let row_diacritic = diacritic
+
let column_diacritic = diacritic
+
let id_high_byte_diacritic = diacritic
let code = Uchar.to_int u in
+
let put = Buffer.add_char buf in
+
if code < 0x80 then put (Char.chr code)
else if code < 0x800 then (
+
put (Char.chr (0xC0 lor (code lsr 6)));
+
put (Char.chr (0x80 lor (code land 0x3F))))
else if code < 0x10000 then (
+
put (Char.chr (0xE0 lor (code lsr 12)));
+
put (Char.chr (0x80 lor ((code lsr 6) land 0x3F)));
+
put (Char.chr (0x80 lor (code land 0x3F))))
+
put (Char.chr (0xF0 lor (code lsr 18)));
+
put (Char.chr (0x80 lor ((code lsr 12) land 0x3F)));
+
put (Char.chr (0x80 lor ((code lsr 6) land 0x3F)));
+
put (Char.chr (0x80 lor (code land 0x3F))))
let write buf ~image_id ?placement_id ~rows ~cols () =
+
(* Set foreground color *)
+
Printf.bprintf buf "\027[38;2;%d;%d;%dm"
+
((image_id lsr 16) land 0xFF)
+
((image_id lsr 8) land 0xFF)
+
(* Optional placement ID in underline color *)
+
|> Option.iter (fun pid ->
+
Printf.bprintf buf "\027[58;2;%d;%d;%dm"
+
((pid lsr 16) land 0xFF)
+
((pid lsr 8) land 0xFF)
+
(* High byte diacritic *)
let high_byte = (image_id lsr 24) land 0xFF in
+
let high_diac = if high_byte > 0 then Some (id_high_byte_diacritic high_byte) else None in
for row = 0 to rows - 1 do
for col = 0 to cols - 1 do
add_uchar buf placeholder_char;
add_uchar buf (row_diacritic row);
add_uchar buf (column_diacritic col);
+
high_diac |> Option.iter (add_uchar buf)
if row < rows - 1 then Buffer.add_string buf "\n\r"
Buffer.add_string buf "\027[39m";
+
if Option.is_some placement_id then Buffer.add_string buf "\027[59m"
+
let cmd = Command.query ~format:`Rgb24 ~transmission:`Direct ~width:1 ~height:1 () in
+
Command.to_string cmd ~data:"\x00\x00\x00" ^ "\027[c"
let supports_graphics response ~da1_received =
+
response |> Option.map Response.is_ok |> Option.value ~default:(not da1_received)
anil.recoil.org