···11+(*---------------------------------------------------------------------------
22+ Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
33+ SPDX-License-Identifier: ISC
44+ ---------------------------------------------------------------------------*)
55+66+(* kgpcat - Display images in the terminal using Kitty Graphics Protocol *)
77+88+open Cmdliner
99+1010+module K = Kgp
1111+1212+type align = Center | Left | Right
1313+type fit = Width | Height | Both | None_
1414+1515+type config = {
1616+ files : string list;
1717+ clear : bool;
1818+ clear_all : bool;
1919+ detect_support : bool;
2020+ align : align; [@warning "-69"]
2121+ place : (int * int * int * int) option;
2222+ scale_up : bool; [@warning "-69"]
2323+ fit : fit; [@warning "-69"]
2424+ z_index : int;
2525+ unicode_placeholder : bool;
2626+ no_trailing_newline : bool;
2727+ hold : bool;
2828+ graphics_mode : K.Terminal.graphics_mode;
2929+}
3030+3131+(* Default image size in cells when not using --place *)
3232+let default_rows = 10
3333+let default_cols = 20
3434+3535+(* Read file contents *)
3636+let read_file filename =
3737+ let ic = open_in_bin filename in
3838+ let n = in_channel_length ic in
3939+ let s = really_input_string ic n in
4040+ close_in ic;
4141+ s
4242+4343+(* Read from stdin *)
4444+let read_stdin () =
4545+ let buf = Buffer.create 4096 in
4646+ try
4747+ while true do
4848+ Buffer.add_channel buf stdin 4096
4949+ done;
5050+ assert false
5151+ with End_of_file -> Buffer.contents buf
5252+5353+(* Detect if stdin has data *)
5454+let stdin_has_data () =
5555+ let fd = Unix.descr_of_in_channel stdin in
5656+ not (Unix.isatty fd)
5757+5858+(* Send command to terminal *)
5959+let send ?(tmux = false) cmd ~data =
6060+ let s = if tmux then K.to_string_tmux cmd ~data else K.to_string cmd ~data in
6161+ print_string s;
6262+ flush stdout
6363+6464+(* Check if file is a supported format (PNG only) *)
6565+let is_supported_format filename =
6666+ let ext =
6767+ try
6868+ let dot = String.rindex filename '.' in
6969+ String.lowercase_ascii (String.sub filename (dot + 1) (String.length filename - dot - 1))
7070+ with Not_found -> ""
7171+ in
7272+ ext = "png" || filename = "stdin"
7373+7474+(* Display a single image *)
7575+let display_image config filename data =
7676+ let resolved_mode = K.Terminal.resolve_mode config.graphics_mode in
7777+ match resolved_mode with
7878+ | `Placeholder ->
7979+ (* No graphics support - show placeholder text *)
8080+ Printf.printf "[Image: %s (%d bytes)]\n" filename (String.length data)
8181+ | `Graphics | `Tmux ->
8282+ let use_tmux = resolved_mode = `Tmux in
8383+ (* Use unicode placeholders if requested or if in tmux mode *)
8484+ let use_unicode = config.unicode_placeholder || use_tmux in
8585+ let cols, rows =
8686+ match config.place with
8787+ | Some (w, h, _, _) -> (w, h)
8888+ | None -> (default_cols, default_rows)
8989+ in
9090+ if use_unicode then (
9191+ (* Unicode placeholder mode: transmit image, then output placeholder chars *)
9292+ let image_id = K.next_image_id () in
9393+ let placement =
9494+ match config.place with
9595+ | Some (w, h, x, y) ->
9696+ K.Placement.make ~columns:w ~rows:h ~cell_x_offset:x ~cell_y_offset:y
9797+ ~z_index:config.z_index ~unicode_placeholder:true ~cursor:`Static ()
9898+ | None ->
9999+ let z = if config.z_index <> 0 then Some config.z_index else None in
100100+ K.Placement.make ~columns:cols ~rows ?z_index:z ~unicode_placeholder:true
101101+ ~cursor:`Static ()
102102+ in
103103+ (* Transmit the image data with virtual placement *)
104104+ let cmd =
105105+ K.transmit_and_display ~image_id ~format:`Png ~placement ~quiet:`Errors_only ()
106106+ in
107107+ send ~tmux:use_tmux cmd ~data;
108108+ (* Output unicode placeholder characters that reference the image *)
109109+ let buf = Buffer.create 256 in
110110+ K.Unicode_placeholder.write buf ~image_id ~rows ~cols ();
111111+ print_string (Buffer.contents buf);
112112+ if not config.no_trailing_newline then print_newline ()
113113+ ) else (
114114+ (* Direct graphics mode *)
115115+ let image_id = K.next_image_id () in
116116+ let placement =
117117+ match config.place with
118118+ | Some (w, h, x, y) ->
119119+ Some
120120+ (K.Placement.make ~columns:w ~rows:h ~cell_x_offset:x ~cell_y_offset:y
121121+ ~z_index:config.z_index ~cursor:`Static ())
122122+ | None ->
123123+ let z = if config.z_index <> 0 then Some config.z_index else None in
124124+ Some
125125+ (K.Placement.make ?z_index:z
126126+ ~cursor:(if config.no_trailing_newline then `Static else `Move) ())
127127+ in
128128+ let cmd =
129129+ K.transmit_and_display ~image_id ~format:`Png ?placement ~quiet:`Errors_only ()
130130+ in
131131+ send ~tmux:use_tmux cmd ~data;
132132+ if not config.no_trailing_newline && config.place = None then print_newline ()
133133+ )
134134+135135+(* Clear all images *)
136136+let do_clear () =
137137+ send (K.delete `All_visible) ~data:""
138138+139139+(* Clear all images including scrollback *)
140140+let do_clear_all () =
141141+ (* Delete all images by ID range 1 to max, freeing data *)
142142+ send (K.delete ~free:true (`By_id_range (1, 4294967295))) ~data:""
143143+144144+(* Detect terminal support *)
145145+let do_detect_support () =
146146+ if K.Terminal.is_graphics_terminal () then (
147147+ let mode =
148148+ if K.Terminal.is_tmux () then "tmux"
149149+ else if K.Terminal.is_kitty () then "kitty"
150150+ else if K.Terminal.is_wezterm () then "wezterm"
151151+ else if K.Terminal.is_ghostty () then "ghostty"
152152+ else "stream"
153153+ in
154154+ Printf.eprintf "%s\n" mode;
155155+ 0
156156+ ) else (
157157+ Printf.eprintf "not supported\n";
158158+ 1
159159+ )
160160+161161+(* Main run function *)
162162+let run config =
163163+ (* Handle clear operations first *)
164164+ if config.clear_all then do_clear_all ()
165165+ else if config.clear then do_clear ();
166166+167167+ (* Handle detect support *)
168168+ if config.detect_support then exit (do_detect_support ());
169169+170170+ (* Process files *)
171171+ let files =
172172+ if config.files = [] && stdin_has_data () then [ "-" ] else config.files
173173+ in
174174+ if files = [] && not config.clear && not config.clear_all then (
175175+ Printf.eprintf "Usage: kgpcat [OPTIONS] IMAGE_FILE...\n";
176176+ Printf.eprintf "Try 'kgpcat --help' for more information.\n";
177177+ exit 1);
178178+179179+ List.iter
180180+ (fun file ->
181181+ let name = if file = "-" then "stdin" else file in
182182+ if not (is_supported_format name) then
183183+ Printf.eprintf "Error: %s is not a PNG file (only PNG format is supported)\n" file
184184+ else
185185+ try
186186+ let data =
187187+ if file = "-" then read_stdin () else read_file file
188188+ in
189189+ display_image config name data
190190+ with
191191+ | Sys_error msg ->
192192+ Printf.eprintf "Error reading %s: %s\n" file msg
193193+ | exn ->
194194+ Printf.eprintf "Error processing %s: %s\n" file (Printexc.to_string exn))
195195+ files;
196196+197197+ (* Ensure all output is flushed before exiting *)
198198+ flush stdout;
199199+200200+ if config.hold then (
201201+ Printf.eprintf "Press Enter to exit...";
202202+ flush stderr;
203203+ ignore (read_line ()))
204204+205205+(* Cmdliner argument definitions *)
206206+207207+let files_arg =
208208+ Arg.(value & pos_all file [] & info [] ~docv:"IMAGE" ~doc:"Image files to display.")
209209+210210+let clear_arg =
211211+ let doc = "Remove all images currently displayed on the screen." in
212212+ Arg.(value & flag & info [ "clear" ] ~doc)
213213+214214+let clear_all_arg =
215215+ let doc = "Remove all images from screen and scrollback." in
216216+ Arg.(value & flag & info [ "clear-all" ] ~doc)
217217+218218+let detect_support_arg =
219219+ let doc =
220220+ "Detect support for image display in the terminal. Exits with code 0 if \
221221+ supported, 1 otherwise. Prints the supported transfer mode to stderr."
222222+ in
223223+ Arg.(value & flag & info [ "detect-support" ] ~doc)
224224+225225+let align_arg =
226226+ let doc = "Horizontal alignment for the displayed image." in
227227+ let align_enum = Arg.enum [ ("center", Center); ("left", Left); ("right", Right) ] in
228228+ Arg.(value & opt align_enum Center & info [ "align" ] ~doc ~docv:"ALIGN")
229229+230230+let place_arg =
231231+ let doc =
232232+ "Display image in specified rectangle. Format: WxH@X,Y where W and H are \
233233+ width and height in cells, and X,Y is the position. Example: 40x20@10,5"
234234+ in
235235+ let parse s =
236236+ try
237237+ let at_pos = String.index s '@' in
238238+ let size_part = String.sub s 0 at_pos in
239239+ let pos_part = String.sub s (at_pos + 1) (String.length s - at_pos - 1) in
240240+ let x_pos = String.index size_part 'x' in
241241+ let w = int_of_string (String.sub size_part 0 x_pos) in
242242+ let h = int_of_string (String.sub size_part (x_pos + 1) (String.length size_part - x_pos - 1)) in
243243+ let comma_pos = String.index pos_part ',' in
244244+ let x = int_of_string (String.sub pos_part 0 comma_pos) in
245245+ let y = int_of_string (String.sub pos_part (comma_pos + 1) (String.length pos_part - comma_pos - 1)) in
246246+ Ok (w, h, x, y)
247247+ with _ -> Error (`Msg "Invalid place format. Use WxH@X,Y (e.g., 40x20@10,5)")
248248+ in
249249+ let print ppf (w, h, x, y) = Format.fprintf ppf "%dx%d@%d,%d" w h x y in
250250+ let place_conv = Arg.conv (parse, print) in
251251+ Arg.(value & opt (some place_conv) None & info [ "place" ] ~doc ~docv:"WxH@X,Y")
252252+253253+let scale_up_arg =
254254+ let doc =
255255+ "Scale up images smaller than the specified area to use as much of the \
256256+ area as possible."
257257+ in
258258+ Arg.(value & flag & info [ "scale-up" ] ~doc)
259259+260260+let fit_arg =
261261+ let doc = "Control how the image is scaled relative to the screen." in
262262+ let fit_enum =
263263+ Arg.enum [ ("width", Width); ("height", Height); ("both", Both); ("none", None_) ]
264264+ in
265265+ Arg.(value & opt fit_enum Width & info [ "fit" ] ~doc ~docv:"FIT")
266266+267267+let z_index_arg =
268268+ let doc =
269269+ "Z-index of the image. Negative values display text on top of the image."
270270+ in
271271+ Arg.(value & opt int 0 & info [ "z"; "z-index" ] ~doc ~docv:"Z")
272272+273273+let unicode_placeholder_arg =
274274+ let doc =
275275+ "Use Unicode placeholder method to display images. This allows images to \
276276+ scroll properly with text in terminals and multiplexers. Automatically \
277277+ enabled when using tmux passthrough mode."
278278+ in
279279+ Arg.(value & flag & info [ "unicode-placeholder" ] ~doc)
280280+281281+let no_trailing_newline_arg =
282282+ let doc = "Don't move cursor to next line after displaying an image." in
283283+ Arg.(value & flag & info [ "n"; "no-trailing-newline" ] ~doc)
284284+285285+let hold_arg =
286286+ let doc = "Wait for a key press before exiting after displaying images." in
287287+ Arg.(value & flag & info [ "hold" ] ~doc)
288288+289289+let config_term =
290290+ let combine files clear clear_all detect_support align place scale_up fit z_index
291291+ unicode_placeholder no_trailing_newline hold graphics_mode =
292292+ {
293293+ files;
294294+ clear;
295295+ clear_all;
296296+ detect_support;
297297+ align;
298298+ place;
299299+ scale_up;
300300+ fit;
301301+ z_index;
302302+ unicode_placeholder;
303303+ no_trailing_newline;
304304+ hold;
305305+ graphics_mode;
306306+ }
307307+ in
308308+ Term.(
309309+ const combine
310310+ $ files_arg
311311+ $ clear_arg
312312+ $ clear_all_arg
313313+ $ detect_support_arg
314314+ $ align_arg
315315+ $ place_arg
316316+ $ scale_up_arg
317317+ $ fit_arg
318318+ $ z_index_arg
319319+ $ unicode_placeholder_arg
320320+ $ no_trailing_newline_arg
321321+ $ hold_arg
322322+ $ Kgp_cli.graphics_term)
323323+324324+let cmd =
325325+ let doc = "Display images in the terminal using Kitty Graphics Protocol" in
326326+ let man =
327327+ [
328328+ `S Manpage.s_description;
329329+ `P
330330+ "$(tname) displays images in terminals that support the Kitty Graphics \
331331+ Protocol (Kitty, WezTerm, Konsole, Ghostty, etc.).";
332332+ `P
333333+ "You can specify multiple image files. If no files are given and stdin \
334334+ is not a terminal, image data is read from stdin.";
335335+ `S Manpage.s_examples;
336336+ `P "Display an image:";
337337+ `Pre " $(tname) photo.png";
338338+ `P "Display multiple images:";
339339+ `Pre " $(tname) *.png";
340340+ `P "Display image from stdin:";
341341+ `Pre " curl -s https://example.com/image.png | $(tname)";
342342+ `P "Display image at specific position:";
343343+ `Pre " $(tname) --place 40x20@10,5 photo.png";
344344+ `P "Clear all displayed images:";
345345+ `Pre " $(tname) --clear";
346346+ `S Kgp_cli.graphics_docs;
347347+ ]
348348+ in
349349+ let info = Cmd.info "kgpcat" ~version:"%%VERSION%%" ~doc ~man in
350350+ Cmd.v info Term.(const run $ config_term)
351351+352352+let () = exit (Cmd.eval cmd)