From 2113b8477cbac5b9b5bb910e3f7b3de282c8d3e0 Mon Sep 17 00:00:00 2001 From: Samuel Mimram Date: Thu, 15 Dec 2022 17:13:34 +0100 Subject: [PATCH 1/2] Add support for canvas video output. --- CHANGES.md | 1 + dune-project | 1 + liquidsoap.opam | 1 + src/config/canvas_option.disabled.ml | 5 ++ src/config/canvas_option.enabled.ml | 2 + src/core/builtins/builtins_optionals.ml | 1 + src/core/dune | 14 +++ src/core/outputs/canvas_out.ml | 109 ++++++++++++++++++++++++ src/runtime/build_config.ml | 1 + 9 files changed, 135 insertions(+) create mode 100644 src/config/canvas_option.disabled.ml create mode 100644 src/config/canvas_option.enabled.ml create mode 100644 src/core/outputs/canvas_out.ml diff --git a/CHANGES.md b/CHANGES.md index 5e94901d12..4d0925164e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -21,6 +21,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. Changed: diff --git a/dune-project b/dune-project index 87afbd6a53..58957f57af 100644 --- a/dune-project +++ b/dune-project @@ -59,6 +59,7 @@ magic memtrace mem_usage + ocaml-canvas ogg opus osc-unix diff --git a/liquidsoap.opam b/liquidsoap.opam index f89bd4e5e3..989a7c4958 100644 --- a/liquidsoap.opam +++ b/liquidsoap.opam @@ -62,6 +62,7 @@ depopts: [ "magic" "memtrace" "mem_usage" + "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 5a87ed392f..9d057f50e9 100644 --- a/src/core/builtins/builtins_optionals.ml +++ b/src/core/builtins/builtins_optionals.ml @@ -17,6 +17,7 @@ let () = ("bjack", Bjack_option.enabled); ("camlimages", Camlimages_option.enabled); ("camomile", Camomile_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 d337567550..bb6afdb8a9 100644 --- a/src/core/dune +++ b/src/core/dune @@ -439,6 +439,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) @@ -704,6 +712,7 @@ builtins_optionals camlimages_option camomile_option + canvas_option dssi_option faad_option fdkaac_option @@ -814,6 +823,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..054cbf8a87 --- /dev/null +++ b/src/core/outputs/canvas_out.ml @@ -0,0 +1,109 @@ +(***************************************************************************** + + 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 + +let events = ref [] +let retain_event e = events := e :: !events + +class output ~infallible ~autostart ~on_start ~on_stop source = + object (self) + inherit + Output.output + ~name:"canvas" ~output_kind:"output.canvas" ~infallible ~on_start + ~on_stop source autostart + + initializer Backend.init () + 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 c = img'.(j).(i) in + let r = (c lsr 16) land 0xff in + let g = (c lsr 8) land 0xff in + let b = c land 0xff 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 ~resizable:false + ~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 + let i = + Video.Canvas.get (VFrame.data buf) 0 + |> Video.Canvas.Image.viewport width height + |> Video.Canvas.Image.render ~transparent:false + |> Image.YUV420.to_int_image + 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 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 ~autostart ~on_start ~on_stop source + :> Output.output)) diff --git a/src/runtime/build_config.ml b/src/runtime/build_config.ml index 9f29bd1630..5401a193b9 100644 --- a/src/runtime/build_config.ml +++ b/src/runtime/build_config.ml @@ -86,6 +86,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} From 091d86a2971bda742f897652a7834a9ba7201366 Mon Sep 17 00:00:00 2001 From: Samuel Mimram Date: Thu, 15 Dec 2022 17:19:11 +0100 Subject: [PATCH 2/2] More efficient. --- CHANGES.md | 2 +- src/core/outputs/canvas_out.ml | 10 +++------- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 4d0925164e..59f370f252 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -21,7 +21,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. +- Add support for canvas video output (#2789). Changed: diff --git a/src/core/outputs/canvas_out.ml b/src/core/outputs/canvas_out.ml index 054cbf8a87..caa313cd1b 100644 --- a/src/core/outputs/canvas_out.ml +++ b/src/core/outputs/canvas_out.ml @@ -47,10 +47,7 @@ class output ~infallible ~autostart ~on_start ~on_stop source = let img = ImageData.create (width, height) in for j = 0 to height - 1 do for i = 0 to width - 1 do - let c = img'.(j).(i) in - let r = (c lsr 16) land 0xff in - let g = (c lsr 8) land 0xff in - let b = c land 0xff in + 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; @@ -63,8 +60,8 @@ class output ~infallible ~autostart ~on_start ~on_stop source = method start = let width, height = self#video_dimensions in let c = - Canvas.createOnscreen ~autocommit:true ~resizable:false - ~title:"Liquidsoap" ~size:(width, height) () + Canvas.createOnscreen ~autocommit:true ~title:"Liquidsoap" + ~size:(width, height) () in canvas <- Some c; Canvas.show c; @@ -77,7 +74,6 @@ class output ~infallible ~autostart ~on_start ~on_stop source = Video.Canvas.get (VFrame.data buf) 0 |> Video.Canvas.Image.viewport width height |> Video.Canvas.Image.render ~transparent:false - |> Image.YUV420.to_int_image in img <- Some i