Kitty Graphics Protocol in OCaml
anil.recoil.org
terminal
graphics
ocaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6type action =
7 [ `Transmit
8 | `Transmit_and_display
9 | `Query
10 | `Display
11 | `Delete
12 | `Frame
13 | `Animate
14 | `Compose ]
15
16type t = {
17 action : action;
18 format : Kgp_format.t option;
19 transmission : Kgp_transmission.t option;
20 compression : Kgp_compression.t option;
21 width : int option;
22 height : int option;
23 size : int option;
24 offset : int option;
25 quiet : Kgp_quiet.t option;
26 image_id : int option;
27 image_number : int option;
28 placement : Kgp_placement.t option;
29 delete : Kgp_delete.t option;
30 delete_free : bool;
31 frame : Kgp_frame.t option;
32 animation : Kgp_animation.t option;
33 compose : Kgp_compose.t option;
34}
35
36let make action =
37 {
38 action;
39 format = None;
40 transmission = None;
41 compression = None;
42 width = None;
43 height = None;
44 size = None;
45 offset = None;
46 quiet = None;
47 image_id = None;
48 image_number = None;
49 placement = None;
50 delete = None;
51 delete_free = false;
52 frame = None;
53 animation = None;
54 compose = None;
55 }
56
57let transmit ?image_id ?image_number ?format ?transmission ?compression ?width
58 ?height ?size ?offset ?quiet () =
59 {
60 (make `Transmit) with
61 image_id;
62 image_number;
63 format;
64 transmission;
65 compression;
66 width;
67 height;
68 size;
69 offset;
70 quiet;
71 }
72
73let transmit_and_display ?image_id ?image_number ?format ?transmission
74 ?compression ?width ?height ?size ?offset ?quiet ?placement () =
75 {
76 (make `Transmit_and_display) with
77 image_id;
78 image_number;
79 format;
80 transmission;
81 compression;
82 width;
83 height;
84 size;
85 offset;
86 quiet;
87 placement;
88 }
89
90let query ?format ?transmission ?width ?height ?quiet () =
91 { (make `Query) with format; transmission; width; height; quiet }
92
93let display ?image_id ?image_number ?placement ?quiet () =
94 { (make `Display) with image_id; image_number; placement; quiet }
95
96let delete ?(free = false) ?quiet del =
97 { (make `Delete) with quiet; delete = Some del; delete_free = free }
98
99let frame ?image_id ?image_number ?format ?transmission ?compression ?width
100 ?height ?quiet ~frame () =
101 {
102 (make `Frame) with
103 image_id;
104 image_number;
105 format;
106 transmission;
107 compression;
108 width;
109 height;
110 quiet;
111 frame = Some frame;
112 }
113
114let animate ?image_id ?image_number ?quiet anim =
115 { (make `Animate) with image_id; image_number; quiet; animation = Some anim }
116
117let compose ?image_id ?image_number ?quiet comp =
118 { (make `Compose) with image_id; image_number; quiet; compose = Some comp }
119
120(* Serialization helpers *)
121let apc_start = "\027_G"
122let apc_end = "\027\\"
123
124(* Key-value writer with separator handling *)
125type kv_writer = { mutable first : bool; buf : Buffer.t }
126
127let kv_writer buf = { first = true; buf }
128
129let kv w key value =
130 if not w.first then Buffer.add_char w.buf ',';
131 w.first <- false;
132 Buffer.add_char w.buf key;
133 Buffer.add_char w.buf '=';
134 Buffer.add_string w.buf value
135
136let kv_int w key value = kv w key (string_of_int value)
137let kv_int32 w key value = kv w key (Int32.to_string value)
138let kv_char w key value = kv w key (String.make 1 value)
139
140(* Conditional writers using Option.iter *)
141let kv_int_opt w key = Option.iter (kv_int w key)
142let kv_int32_opt w key = Option.iter (kv_int32 w key)
143
144let kv_int_if w key ~default opt =
145 Option.iter (fun v -> if v <> default then kv_int w key v) opt
146
147let action_char : action -> char = function
148 | `Transmit -> 't'
149 | `Transmit_and_display -> 'T'
150 | `Query -> 'q'
151 | `Display -> 'p'
152 | `Delete -> 'd'
153 | `Frame -> 'f'
154 | `Animate -> 'a'
155 | `Compose -> 'c'
156
157let write_placement w (p : Kgp_placement.t) =
158 kv_int_opt w 'x' (Kgp_placement.source_x p);
159 kv_int_opt w 'y' (Kgp_placement.source_y p);
160 kv_int_opt w 'w' (Kgp_placement.source_width p);
161 kv_int_opt w 'h' (Kgp_placement.source_height p);
162 kv_int_opt w 'X' (Kgp_placement.cell_x_offset p);
163 kv_int_opt w 'Y' (Kgp_placement.cell_y_offset p);
164 kv_int_opt w 'c' (Kgp_placement.columns p);
165 kv_int_opt w 'r' (Kgp_placement.rows p);
166 kv_int_opt w 'z' (Kgp_placement.z_index p);
167 kv_int_opt w 'p' (Kgp_placement.placement_id p);
168 Kgp_placement.cursor p
169 |> Option.iter (fun c ->
170 kv_int_if w 'C' ~default:0 (Some (Kgp_cursor.to_int c)));
171 if Kgp_placement.unicode_placeholder p then kv_int w 'U' 1
172
173let write_delete w ~free (d : Kgp_delete.t) =
174 kv_char w 'd' (Kgp_delete.to_char ~free d);
175 match d with
176 | `By_id (id, pid) ->
177 kv_int w 'i' id;
178 kv_int_opt w 'p' pid
179 | `By_number (n, pid) ->
180 kv_int w 'I' n;
181 kv_int_opt w 'p' pid
182 | `At_cell (x, y) ->
183 kv_int w 'x' x;
184 kv_int w 'y' y
185 | `At_cell_z (x, y, z) ->
186 kv_int w 'x' x;
187 kv_int w 'y' y;
188 kv_int w 'z' z
189 | `By_column c -> kv_int w 'x' c
190 | `By_row r -> kv_int w 'y' r
191 | `By_z_index z -> kv_int w 'z' z
192 | `By_id_range (min_id, max_id) ->
193 kv_int w 'x' min_id;
194 kv_int w 'y' max_id
195 | `All_visible | `At_cursor | `Frames -> ()
196
197let write_frame w (f : Kgp_frame.t) =
198 kv_int_opt w 'x' (Kgp_frame.x f);
199 kv_int_opt w 'y' (Kgp_frame.y f);
200 kv_int_opt w 'c' (Kgp_frame.base_frame f);
201 kv_int_opt w 'r' (Kgp_frame.edit_frame f);
202 kv_int_opt w 'z' (Kgp_frame.gap_ms f);
203 Kgp_frame.composition f
204 |> Option.iter (fun c ->
205 kv_int_if w 'X' ~default:0 (Some (Kgp_composition.to_int c)));
206 kv_int32_opt w 'Y' (Kgp_frame.background_color f)
207
208let write_animation w : Kgp_animation.t -> unit = function
209 | `Set_state (state, loops) ->
210 let s = Kgp_animation_state.to_int state in
211 kv_int w 's' s;
212 kv_int_opt w 'v' loops
213 | `Set_gap (frame, gap_ms) ->
214 kv_int w 'r' frame;
215 kv_int w 'z' gap_ms
216 | `Set_current frame -> kv_int w 'c' frame
217
218let write_compose w (c : Kgp_compose.t) =
219 kv_int w 'r' (Kgp_compose.source_frame c);
220 kv_int w 'c' (Kgp_compose.dest_frame c);
221 kv_int_opt w 'w' (Kgp_compose.width c);
222 kv_int_opt w 'h' (Kgp_compose.height c);
223 kv_int_opt w 'x' (Kgp_compose.dest_x c);
224 kv_int_opt w 'y' (Kgp_compose.dest_y c);
225 kv_int_opt w 'X' (Kgp_compose.source_x c);
226 kv_int_opt w 'Y' (Kgp_compose.source_y c);
227 Kgp_compose.composition c
228 |> Option.iter (fun comp ->
229 kv_int_if w 'C' ~default:0 (Some (Kgp_composition.to_int comp)))
230
231let write_control_data buf cmd =
232 let w = kv_writer buf in
233 (* Action *)
234 kv_char w 'a' (action_char cmd.action);
235 (* Quiet - only if non-default *)
236 cmd.quiet
237 |> Option.iter (fun q ->
238 kv_int_if w 'q' ~default:0 (Some (Kgp_quiet.to_int q)));
239 (* Format *)
240 cmd.format
241 |> Option.iter (fun f -> kv_int w 'f' (Kgp_format.to_int f));
242 (* Transmission - only for transmit/frame actions, always include t=d for compatibility *)
243 (match cmd.action with
244 | `Transmit | `Transmit_and_display | `Frame -> (
245 match cmd.transmission with
246 | Some t -> kv_char w 't' (Kgp_transmission.to_char t)
247 | None -> kv_char w 't' 'd')
248 | _ -> ());
249 (* Compression *)
250 cmd.compression
251 |> Option.iter (fun c ->
252 Kgp_compression.to_char c |> Option.iter (kv_char w 'o'));
253 (* Dimensions *)
254 kv_int_opt w 's' cmd.width;
255 kv_int_opt w 'v' cmd.height;
256 (* File size/offset *)
257 kv_int_opt w 'S' cmd.size;
258 kv_int_opt w 'O' cmd.offset;
259 (* Image ID/number *)
260 kv_int_opt w 'i' cmd.image_id;
261 kv_int_opt w 'I' cmd.image_number;
262 (* Complex options *)
263 cmd.placement |> Option.iter (write_placement w);
264 cmd.delete |> Option.iter (write_delete w ~free:cmd.delete_free);
265 cmd.frame |> Option.iter (write_frame w);
266 cmd.animation |> Option.iter (write_animation w);
267 cmd.compose |> Option.iter (write_compose w);
268 w
269
270(* Use large chunk size to avoid chunking - Kitty animation doesn't handle chunks well *)
271let chunk_size = 1024 * 1024 (* 1MB - effectively no chunking *)
272
273let write buf cmd ~data =
274 Buffer.add_string buf apc_start;
275 let w = write_control_data buf cmd in
276 if String.length data > 0 then begin
277 let encoded = Base64.encode_string data in
278 let len = String.length encoded in
279 if len <= chunk_size then (
280 Buffer.add_char buf ';';
281 Buffer.add_string buf encoded;
282 Buffer.add_string buf apc_end)
283 else begin
284 (* Multiple chunks *)
285 let rec write_chunks pos first =
286 if pos < len then begin
287 let remaining = len - pos in
288 let this_chunk = min chunk_size remaining in
289 let is_last = pos + this_chunk >= len in
290 if first then (
291 kv_int w 'm' 1;
292 Buffer.add_char buf ';';
293 Buffer.add_substring buf encoded pos this_chunk;
294 Buffer.add_string buf apc_end)
295 else (
296 Buffer.add_string buf apc_start;
297 Buffer.add_string buf (if is_last then "m=0" else "m=1");
298 Buffer.add_char buf ';';
299 Buffer.add_substring buf encoded pos this_chunk;
300 Buffer.add_string buf apc_end);
301 write_chunks (pos + this_chunk) false
302 end
303 in
304 write_chunks 0 true
305 end
306 end
307 else Buffer.add_string buf apc_end
308
309let to_string cmd ~data =
310 let buf = Buffer.create 1024 in
311 write buf cmd ~data;
312 Buffer.contents buf
313
314let write_tmux buf cmd ~data =
315 if Kgp_tmux.is_active () then begin
316 let inner_buf = Buffer.create 1024 in
317 write inner_buf cmd ~data;
318 Kgp_tmux.write_wrapped buf (Buffer.contents inner_buf)
319 end else
320 write buf cmd ~data
321
322let to_string_tmux cmd ~data =
323 let buf = Buffer.create 1024 in
324 write_tmux buf cmd ~data;
325 Buffer.contents buf