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 |> Option.iter (fun f -> kv_int w 'f' (Kgp_format.to_int f));
241 (* Transmission - only for transmit/frame actions, always include t=d for compatibility *)
242 (match cmd.action with
243 | `Transmit | `Transmit_and_display | `Frame -> (
244 match cmd.transmission with
245 | Some t -> kv_char w 't' (Kgp_transmission.to_char t)
246 | None -> kv_char w 't' 'd')
247 | _ -> ());
248 (* Compression *)
249 cmd.compression
250 |> Option.iter (fun c ->
251 Kgp_compression.to_char c |> Option.iter (kv_char w 'o'));
252 (* Dimensions *)
253 kv_int_opt w 's' cmd.width;
254 kv_int_opt w 'v' cmd.height;
255 (* File size/offset *)
256 kv_int_opt w 'S' cmd.size;
257 kv_int_opt w 'O' cmd.offset;
258 (* Image ID/number *)
259 kv_int_opt w 'i' cmd.image_id;
260 kv_int_opt w 'I' cmd.image_number;
261 (* Complex options *)
262 cmd.placement |> Option.iter (write_placement w);
263 cmd.delete |> Option.iter (write_delete w ~free:cmd.delete_free);
264 cmd.frame |> Option.iter (write_frame w);
265 cmd.animation |> Option.iter (write_animation w);
266 cmd.compose |> Option.iter (write_compose w);
267 w
268
269(* Use large chunk size to avoid chunking - Kitty animation doesn't handle chunks well *)
270let chunk_size = 1024 * 1024 (* 1MB - effectively no chunking *)
271
272let write buf cmd ~data =
273 Buffer.add_string buf apc_start;
274 let w = write_control_data buf cmd in
275 if String.length data > 0 then begin
276 let encoded = Base64.encode_string data in
277 let len = String.length encoded in
278 if len <= chunk_size then (
279 Buffer.add_char buf ';';
280 Buffer.add_string buf encoded;
281 Buffer.add_string buf apc_end)
282 else begin
283 (* Multiple chunks *)
284 let rec write_chunks pos first =
285 if pos < len then begin
286 let remaining = len - pos in
287 let this_chunk = min chunk_size remaining in
288 let is_last = pos + this_chunk >= len in
289 if first then (
290 kv_int w 'm' 1;
291 Buffer.add_char buf ';';
292 Buffer.add_substring buf encoded pos this_chunk;
293 Buffer.add_string buf apc_end)
294 else (
295 Buffer.add_string buf apc_start;
296 Buffer.add_string buf (if is_last then "m=0" else "m=1");
297 Buffer.add_char buf ';';
298 Buffer.add_substring buf encoded pos this_chunk;
299 Buffer.add_string buf apc_end);
300 write_chunks (pos + this_chunk) false
301 end
302 in
303 write_chunks 0 true
304 end
305 end
306 else Buffer.add_string buf apc_end
307
308let to_string cmd ~data =
309 let buf = Buffer.create 1024 in
310 write buf cmd ~data;
311 Buffer.contents buf
312
313let write_tmux buf cmd ~data =
314 if Kgp_tmux.is_active () then begin
315 let inner_buf = Buffer.create 1024 in
316 write inner_buf cmd ~data;
317 Kgp_tmux.write_wrapped buf (Buffer.contents inner_buf)
318 end
319 else write buf cmd ~data
320
321let to_string_tmux cmd ~data =
322 let buf = Buffer.create 1024 in
323 write_tmux buf cmd ~data;
324 Buffer.contents buf