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