diff --git a/CHANGES.md b/CHANGES.md index 65a04a411c..97097f2395 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -238,6 +238,7 @@ New: - Added syntactic sugar for record spread: `let {foo, gni, ..y} = x` and `y = { foo = 123, gni = "aabb", ...x}` (#2737) - Added `file.{copy, move}` (#2771) +- Add support for canvas video output (#2789). - Detect functions defining multiple arguments with the same label (#2823). - Added `null.map`. - References of type `'a` are now objects of type `(()->'a).{set : ('a) -> unit}`. This means that you should use `x()` instead of `!x` in order to get diff --git a/dune-project b/dune-project index e8a0ac30ba..48f1089d78 100644 --- a/dune-project +++ b/dune-project @@ -87,6 +87,7 @@ lo mad memtrace + ocaml-canvas ogg opus osc-unix diff --git a/liquidsoap-core.opam b/liquidsoap-core.opam index 9ae6768723..f6daba4719 100644 --- a/liquidsoap-core.opam +++ b/liquidsoap-core.opam @@ -54,6 +54,7 @@ depopts: [ "lo" "mad" "memtrace" + "ocaml-canvas" "ogg" "opus" "osc-unix" diff --git a/src/config/canvas_option.disabled.ml b/src/config/canvas_option.disabled.ml new file mode 100644 index 0000000000..541c35971d --- /dev/null +++ b/src/config/canvas_option.disabled.ml @@ -0,0 +1,5 @@ +let detected = + let dep = Filename.basename (List.hd (String.split_on_char '_' __FILE__)) in + [%string "no (requires %{dep})"] + +let enabled = false diff --git a/src/config/canvas_option.enabled.ml b/src/config/canvas_option.enabled.ml new file mode 100644 index 0000000000..30a018cb83 --- /dev/null +++ b/src/config/canvas_option.enabled.ml @@ -0,0 +1,2 @@ +let detected = "yes" +let enabled = true diff --git a/src/core/builtins/builtins_optionals.ml b/src/core/builtins/builtins_optionals.ml index 65a6f6ba7d..81c59da703 100644 --- a/src/core/builtins/builtins_optionals.ml +++ b/src/core/builtins/builtins_optionals.ml @@ -15,6 +15,7 @@ let () = ("ao", Ao_option.enabled); ("bjack", Bjack_option.enabled); ("camlimages", Camlimages_option.enabled); + ("canvas", Canvas_option.enabled); ("dssi", Dssi_option.enabled); ("faad", Faad_option.enabled); ("fdkaac", Fdkaac_option.enabled); diff --git a/src/core/dune b/src/core/dune index 18b79aec9f..9d0109af30 100644 --- a/src/core/dune +++ b/src/core/dune @@ -432,6 +432,14 @@ (optional) (modules graphics_out)) +(library + (name liquidsoap_canvas) + (libraries ocaml-canvas liquidsoap_core) + (library_flags -linkall) + (wrapped false) + (optional) + (modules canvas_out)) + (library (name liquidsoap_gstreamer) (libraries gstreamer liquidsoap_core) @@ -734,6 +742,7 @@ bjack_option builtins_optionals camlimages_option + canvas_option dssi_option faad_option fdkaac_option @@ -846,6 +855,11 @@ from (liquidsoap_graphics -> graphics_option.enabled.ml) (-> graphics_option.disabled.ml)) + (select + canvas_option.ml + from + (liquidsoap_canvas -> canvas_option.enabled.ml) + (-> canvas_option.disabled.ml)) (select gstreamer_option.ml from diff --git a/src/core/outputs/canvas_out.ml b/src/core/outputs/canvas_out.ml new file mode 100644 index 0000000000..92abacd3c4 --- /dev/null +++ b/src/core/outputs/canvas_out.ml @@ -0,0 +1,111 @@ +(***************************************************************************** + + Copyright 2003-2022 Savonet team + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details, fully stated in the COPYING + file at the root of the liquidsoap distribution. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + *****************************************************************************) + +open Mm +open OcamlCanvas.V1 +module Queue = Liquidsoap_lang.Queues.Queue + +let events = Queue.create () +let retain_event e = Queue.push events e +let init = Lazy.from_fun Backend.init + +class output ~infallible ~register_telnet ~autostart ~on_start ~on_stop source = + object (self) + inherit + Output.output + ~name:"canvas" ~output_kind:"output.canvas" ~register_telnet ~infallible + ~on_start ~on_stop source autostart + + val mutable sleep = false + method stop = () + val mutable canvas = None + val mutable img = None + + method update = + match img with + | Some img' -> + let width, height = self#video_dimensions in + (* TODO: directly output a bigarray and use ImageData.of_bigarray *) + let img = + let img = ImageData.create (width, height) in + for j = 0 to height - 1 do + for i = 0 to width - 1 do + let r, g, b, _ = Image.YUV420.get_pixel_rgba img' i j in + ImageData.putPixel img (i, j) (Color.of_rgb r g b) + done + done; + img + in + Canvas.putImageData (Option.get canvas) ~dpos:(0, 0) img + ~spos:(0, 0) ~size:(width, height) + | None -> () + + method start = + let width, height = self#video_dimensions in + let c = + Canvas.createOnscreen ~autocommit:true ~title:"Liquidsoap" + ~size:(width, height) () + in + canvas <- Some c; + Canvas.show c; + React.E.map (fun _ -> self#update) Event.frame |> retain_event; + ignore (Thread.create (fun () -> Backend.run (fun () -> ())) ()) + + method send_frame buf = + let width, height = self#video_dimensions in + match (VFrame.data buf).Content.Video.data with + | [] -> () + | (_, i) :: _ -> + let i = + i + |> Video.Canvas.Image.viewport width height + |> Video.Canvas.Image.render ~transparent:false + in + img <- Some i + + method! reset = () + end + +let _ = + let frame_t = + Lang.frame_t (Lang.univ_t ()) + (Frame.Fields.make ~video:(Format_type.video ()) ()) + in + Lang.add_operator ~base:Modules.output "canvas" + (Output.proto @ [("", Lang.source_t frame_t, None, None)]) + ~return_t:frame_t ~category:`Output ~meth:Output.meth + ~descr:"Display video stream using the Canvas library." + (fun p -> + let autostart = Lang.to_bool (List.assoc "start" p) in + let register_telnet = Lang.to_bool (List.assoc "register_telnet" p) in + let infallible = not (Lang.to_bool (List.assoc "fallible" p)) in + let on_start = + let f = List.assoc "on_start" p in + fun () -> ignore (Lang.apply f []) + in + let on_stop = + let f = List.assoc "on_stop" p in + fun () -> ignore (Lang.apply f []) + in + let source = List.assoc "" p in + (new output + ~infallible ~register_telnet ~autostart ~on_start ~on_stop source + :> Output.output)) diff --git a/src/runtime/build_config.ml b/src/runtime/build_config.ml index 4cf9e6e564..680fa1914f 100644 --- a/src/runtime/build_config.ml +++ b/src/runtime/build_config.ml @@ -105,6 +105,7 @@ let build_config = - DSSI : %{Dssi_option.detected} * Visualization + - Canvas : %{Canvas_option.detected} - GD : %{Gd_option.detected} - Graphics : %{Graphics_option.detected} - SDL : %{Sdl_option.detected}