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