diff --git a/src/core/builtins/builtins_ffmpeg_bitstream_filters.ml b/src/core/builtins/builtins_ffmpeg_bitstream_filters.ml index 1daaa83655..f94d342032 100644 --- a/src/core/builtins/builtins_ffmpeg_bitstream_filters.ml +++ b/src/core/builtins/builtins_ffmpeg_bitstream_filters.ml @@ -83,9 +83,7 @@ let process (type a) ~put_data ~(mk_params : a mk_params) } )) packets in - let data = - { Ffmpeg_content_base.params = Some (mk_params params); data; length } - in + let data = { Content.Video.params = Some (mk_params params); data; length } in let data = Ffmpeg_copy_content.lift_data data in put_data generator data @@ -121,7 +119,7 @@ let on_data (type a) a handler) ~put_data ~(get_params : a get_params) ~(get_packet : a get_packet) ~(mk_params : a mk_params) ~(mk_packet : a mk_packet) ~generator - ({ Ffmpeg_content_base.params; data } : Ffmpeg_copy_content.data) = + ({ Content.Video.params; data } : Ffmpeg_copy_content.data) = List.iter (fun (_, { Ffmpeg_copy_content.stream_idx; time_base; packet }) -> let handler = diff --git a/src/core/builtins/builtins_ffmpeg_decoder.ml b/src/core/builtins/builtins_ffmpeg_decoder.ml index 3262b6a0c0..6686724b57 100644 --- a/src/core/builtins/builtins_ffmpeg_decoder.ml +++ b/src/core/builtins/builtins_ffmpeg_decoder.ml @@ -98,7 +98,7 @@ let decode_audio_frame ~field ~mode generator = | `Frame frame -> let data, params = match Ffmpeg_copy_content.get_data frame with - | { Ffmpeg_content_base.data; params = Some (`Audio params) } -> + | { Content.Video.data; params = Some (`Audio params) } -> (data, params) | _ -> assert false in @@ -165,7 +165,7 @@ let decode_audio_frame ~field ~mode generator = function | `Frame frame -> - let { Ffmpeg_content_base.data; params } = + let { Content.Video.data; params } = Ffmpeg_raw_content.Audio.get_data frame in let data = @@ -181,14 +181,14 @@ let decode_audio_frame ~field ~mode generator = let convert : 'a 'b. - get_data:(Content.data -> ('a, 'b) Ffmpeg_content_base.content) -> + get_data:(Content.data -> ('a, 'b) Content_video.Base.content) -> decoder:([ `Frame of Content.data | `Flush ] -> unit) -> [ `Frame of Frame.t | `Flush ] -> unit = fun ~get_data ~decoder -> function | `Frame frame -> let frame = Frame.get frame field in - let { Ffmpeg_content_base.data; _ } = get_data frame in + let { Content.Video.data; _ } = get_data frame in if data = [] then () else decoder (`Frame frame) | `Flush -> decoder `Flush in @@ -253,8 +253,7 @@ let decode_video_frame ~field ~mode generator = Ffmpeg_utils.unpack_image ~width:internal_width ~height:internal_height (InternalScaler.convert scaler data) in - let data = Video.Canvas.single_image img in - let data = Content.Video.lift_data data in + let data = Content.Video.lift_image (Video.Canvas.Image.make img) in Generator.put generator field data in @@ -318,7 +317,7 @@ let decode_video_frame ~field ~mode generator = | `Frame frame -> let data, params = match Ffmpeg_copy_content.get_data frame with - | { Ffmpeg_content_base.data; params = Some (`Video params) } -> + | { Content.Video.data; params = Some (`Video params) } -> (data, params) | _ -> assert false in @@ -364,7 +363,7 @@ let decode_video_frame ~field ~mode generator = let last_params = ref None in function | `Frame frame -> - let { Ffmpeg_content_base.data; _ } = + let { Content.Video.data; _ } = Ffmpeg_raw_content.Video.get_data frame in let data = @@ -385,14 +384,14 @@ let decode_video_frame ~field ~mode generator = let convert : 'a 'b. - get_data:(Content.data -> ('a, 'b) Ffmpeg_content_base.content) -> + get_data:(Content.data -> ('a, 'b) Content_video.Base.content) -> decoder:([ `Frame of Content.data | `Flush ] -> unit) -> [ `Frame of Frame.t | `Flush ] -> unit = fun ~get_data ~decoder -> function | `Frame frame -> let frame = Frame.get frame field in - let { Ffmpeg_content_base.data; _ } = get_data frame in + let { Content.Video.data; _ } = get_data frame in if data = [] then () else decoder (`Frame frame) | `Flush -> decoder `Flush in diff --git a/src/core/builtins/builtins_ffmpeg_encoder.ml b/src/core/builtins/builtins_ffmpeg_encoder.ml index 58b7600a82..32312609ae 100644 --- a/src/core/builtins/builtins_ffmpeg_encoder.ml +++ b/src/core/builtins/builtins_ffmpeg_encoder.ml @@ -110,7 +110,7 @@ let encode_audio_frame ~source_idx ~type_t ~mode ~opts ?codec ~format } )) packets in - let data = { Ffmpeg_content_base.params; data; length } in + let data = { Content.Video.params; data; length } in let data = Ffmpeg_copy_content.lift_data data in Generator.put generator field data | None -> () @@ -160,7 +160,7 @@ let encode_audio_frame ~source_idx ~type_t ~mode ~opts ?codec ~format } )) frames in - let data = { Ffmpeg_content_base.params; data; length } in + let data = { Content.Video.params; data; length } in let data = Ffmpeg_raw_content.Audio.lift_data data in Generator.put generator field data | None -> ()) @@ -294,7 +294,7 @@ let encode_video_frame ~source_idx ~type_t ~mode ~opts ?codec ~format ~field } )) packets in - let data = { Ffmpeg_content_base.params; data; length } in + let data = { Content.Video.params; data; length } in let data = Ffmpeg_copy_content.lift_data data in Generator.put generator field data | None -> () @@ -350,7 +350,7 @@ let encode_video_frame ~source_idx ~type_t ~mode ~opts ?codec ~format ~field } )) frames in - let data = { Ffmpeg_content_base.params; data; length } in + let data = { Content.Video.params; data; length } in let data = Ffmpeg_raw_content.Video.lift_data data in Generator.put generator field data | None -> ()) @@ -368,17 +368,16 @@ let encode_video_frame ~source_idx ~type_t ~mode ~opts ?codec ~format ~field function | `Frame frame -> - let vstart = 0 in - let vstop = VFrame.position frame in let vbuf = VFrame.data frame in - for i = vstart to vstop - 1 do - let f = Video.Canvas.render vbuf i in - let vdata = Ffmpeg_utils.pack_image f in - let frame = InternalScaler.convert (Option.get !scaler) vdata in - Avutil.Frame.set_pts frame (Some !nb_frames); - nb_frames := Int64.succ !nb_frames; - encode_ffmpeg_frame frame - done + List.iter + (fun (_, img) -> + let f = Video.Canvas.Image.render img in + let vdata = Ffmpeg_utils.pack_image f in + let frame = InternalScaler.convert (Option.get !scaler) vdata in + Avutil.Frame.set_pts frame (Some !nb_frames); + nb_frames := Int64.succ !nb_frames; + encode_ffmpeg_frame frame) + vbuf.Content.Video.data | `Flush -> encode_frame `Flush let mk_encoder mode = diff --git a/src/core/decoder/decoder.ml b/src/core/decoder/decoder.ml index 37c146a16c..c5e8014b5b 100644 --- a/src/core/decoder/decoder.ml +++ b/src/core/decoder/decoder.ml @@ -62,7 +62,7 @@ type fps = Decoder_utils.fps = { num : int; den : int } type buffer = { generator : Generator.t; put_pcm : ?field:Frame.field -> samplerate:int -> Content.Audio.data -> unit; - put_yuva420p : ?field:Frame.field -> fps:fps -> Content.Video.data -> unit; + put_yuva420p : ?field:Frame.field -> fps:fps -> Video.Canvas.image -> unit; } type decoder = { @@ -240,7 +240,7 @@ let test_file ?(log = log) ?mimes ?extensions fname = ext_ok || mime_ok) let channel_layout audio = - Lazy.force Content.(Audio.(get_params audio).Content.channel_layout) + Lazy.force Content.(Audio.(get_params audio).Content.Audio.channel_layout) let can_decode_type decoded_type target_type = let map_convertible cur (field, target_field) = @@ -451,16 +451,28 @@ let mk_buffer ~ctype generator = let out_freq = Decoder_utils.{ num = Lazy.force Frame.video_rate; den = 1 } in - fun ~fps (data : Content.Video.data) -> - let data = Array.map video_scale data in - let data = video_resample ~in_freq:fps ~out_freq data in - let len = Video.Canvas.length data in - let data = - Content.Video.lift_data - ~length:(Frame_settings.main_of_video len) - data - in - Generator.put generator field data) + let params = + { + Content.Video.width = Some Frame.video_width; + height = Some Frame.video_height; + } + in + let interval = Frame.main_of_video 1 in + fun ~fps img -> + match video_resample ~in_freq:fps ~out_freq img with + | [] -> () + | data -> + let data = + List.mapi + (fun i img -> (i * interval, video_scale img)) + data + in + let length = List.length data * interval in + let buf = + Content.Video.lift_data + { Content.Video.params; length; data } + in + Generator.put generator field buf) else fun ~fps:_ _ -> () in Hashtbl.add video_handlers field handler; @@ -471,8 +483,8 @@ let mk_buffer ~ctype generator = get_audio_handler ~field ~samplerate data in - let put_yuva420p ?(field = Frame.Fields.video) ~fps data = - get_video_handler ~field ~fps data + let put_yuva420p ?(field = Frame.Fields.video) ~fps img = + get_video_handler ~field ~fps img in { generator; put_pcm; put_yuva420p } diff --git a/src/core/decoder/decoder.mli b/src/core/decoder/decoder.mli index 8531c09229..09b4c9a189 100644 --- a/src/core/decoder/decoder.mli +++ b/src/core/decoder/decoder.mli @@ -49,8 +49,8 @@ type fps = { num : int; den : int } - Implicit content drop *) type buffer = { generator : Generator.t; - put_pcm : ?field:Frame.field -> samplerate:int -> Content.Audio.data -> unit; - put_yuva420p : ?field:Frame.field -> fps:fps -> Content.Video.data -> unit; + put_pcm : ?field:Frame.field -> samplerate:int -> Audio.t -> unit; + put_yuva420p : ?field:Frame.field -> fps:fps -> Video.Canvas.image -> unit; } type decoder = { diff --git a/src/core/decoder/decoder_utils.ml b/src/core/decoder/decoder_utils.ml index 9534da854f..c50eb345a6 100644 --- a/src/core/decoder/decoder_utils.ml +++ b/src/core/decoder/decoder_utils.ml @@ -108,30 +108,29 @@ let video_resample ~in_freq ~out_freq = * which o: nearest neighbour in the currently available buffer. * This is not as good as nearest neighbour in the real stream. * - * Turns out the same code codes for when out_freq>in_freq too. *) + * Turns out the same code codes for when out_freq>in_freq works too. *) let in_pos = ref 0 in let in_freq = in_freq.num * out_freq.den and out_freq = out_freq.num * in_freq.num in let ratio = out_freq / in_freq in - fun input off len -> - let new_in_pos = !in_pos + len in + fun img -> + let new_in_pos = !in_pos + 1 in let already_out_len = !in_pos * ratio in let needed_out_len = new_in_pos * ratio in let out_len = needed_out_len - already_out_len in in_pos := new_in_pos mod in_freq; - Array.init out_len (fun i -> input.(off + (i * ratio))) + List.init out_len (fun _ -> img) let video_resample () = let state = ref None in - let exec resampler data = resampler data 0 (Video.Canvas.length data) in - fun ~in_freq ~out_freq (data : Content.Video.data) : Content.Video.data -> - if in_freq = out_freq then data + fun ~in_freq ~out_freq img -> + if in_freq = out_freq then [img] else ( match !state with | Some (resampler, _in_freq, _out_freq) when in_freq = _in_freq && out_freq = _out_freq -> - exec resampler data + resampler img | _ -> let resampler = video_resample ~in_freq ~out_freq in state := Some (resampler, in_freq, out_freq); - exec resampler data) + resampler img) diff --git a/src/core/decoder/decoder_utils.mli b/src/core/decoder/decoder_utils.mli index e0b780077b..b43b13a473 100644 --- a/src/core/decoder/decoder_utils.mli +++ b/src/core/decoder/decoder_utils.mli @@ -59,5 +59,5 @@ val video_resample : unit -> in_freq:fps -> out_freq:fps -> - Content.Video.data -> - Content.Video.data + Video.Canvas.image -> + Video.Canvas.image list diff --git a/src/core/decoder/ffmpeg_copy_decoder.ml b/src/core/decoder/ffmpeg_copy_decoder.ml index e78d5f13b4..e41171a441 100644 --- a/src/core/decoder/ffmpeg_copy_decoder.ml +++ b/src/core/decoder/ffmpeg_copy_decoder.ml @@ -54,7 +54,7 @@ let mk_decoder ~stream_idx ~stream_time_base ~mk_packet ~put_data params = } )) packets in - let data = { Ffmpeg_content_base.params = Some params; data; length } in + let data = { Content.Video.params = Some params; data; length } in let data = Ffmpeg_copy_content.lift_data data in put_data buffer.Decoder.generator data with Empty | Corrupt (* Might want to change that later. *) -> () diff --git a/src/core/decoder/ffmpeg_internal_decoder.ml b/src/core/decoder/ffmpeg_internal_decoder.ml index fee455e26d..50f50e1c8f 100644 --- a/src/core/decoder/ffmpeg_internal_decoder.ml +++ b/src/core/decoder/ffmpeg_internal_decoder.ml @@ -159,10 +159,9 @@ let mk_video_decoder ~width ~height ~stream ~field codec = let pixel_aspect = Av.get_pixel_aspect stream in let cb ~buffer frame = let img = scale frame in - let content = Video.Canvas.single img in buffer.Decoder.put_yuva420p ~field ~fps:{ Decoder.num = target_fps; den = 1 } - content; + img; let metadata = Avutil.Frame.metadata frame in if metadata <> [] then Generator.add_metadata buffer.Decoder.generator diff --git a/src/core/decoder/ffmpeg_raw_decoder.ml b/src/core/decoder/ffmpeg_raw_decoder.ml index 99c447cda6..1554a2a7a9 100644 --- a/src/core/decoder/ffmpeg_raw_decoder.ml +++ b/src/core/decoder/ffmpeg_raw_decoder.ml @@ -45,7 +45,7 @@ let mk_decoder ~stream_idx ~stream_time_base ~mk_params ~lift_data ~put_data frames in let data = - { Ffmpeg_content_base.params = mk_params params; data; length } + { Content.Video.params = mk_params params; data; length } in let data = lift_data data in put_data buffer.Decoder.generator data diff --git a/src/core/decoder/gstreamer_decoder.ml b/src/core/decoder/gstreamer_decoder.ml index df724d88ee..0b78d3a6b7 100644 --- a/src/core/decoder/gstreamer_decoder.ml +++ b/src/core/decoder/gstreamer_decoder.ml @@ -138,9 +138,8 @@ let create_decoder ?(merge_tracks = false) _ ~width ~height ~channels ~mode let y_stride = round4 width in let uv_stride = round4 (width / 2) in let img = Image.YUV420.make_data width height buf y_stride uv_stride in - let stream = Video.Canvas.single_image img in let fps = { Decoder.num = Lazy.force Frame.video_rate; den = 1 } in - buffer.Decoder.put_yuva420p ~fps stream); + buffer.Decoder.put_yuva420p ~fps (Video.Canvas.Image.make img)); GU.flush ~log gst.bin in let seek off = diff --git a/src/core/decoder/image_decoder.ml b/src/core/decoder/image_decoder.ml index eb81c10425..a3724eacc0 100644 --- a/src/core/decoder/image_decoder.ml +++ b/src/core/decoder/image_decoder.ml @@ -119,16 +119,24 @@ let create_decoder ~ctype ~width ~height ~metadata img = let remaining () = if !duration = -1 then -1 else Frame.main_of_video !duration in + let generator = + Content.Video.make_generator + (Content.Video.get_params (Frame.Fields.find Frame.Fields.video ctype)) + in let fread length = - let frame = Frame.create ~length ctype in - let video = Content.Video.get_data (Frame.get frame Frame.Fields.video) in - for i = 0 to Frame.video_of_main length - 1 do - Video.Canvas.set video i img - done; - match Frame.Fields.find_opt Frame.Fields.audio frame with + let frame = Frame.create ~length Frame.Fields.empty in + let video = + Content.Video.generate + ~create:(fun ~pos:_ ~width:_ ~height:_ () -> img) + generator length + in + let frame = + Frame.set_data frame Frame.Fields.video Content.Video.lift_data video + in + match Frame.Fields.find_opt Frame.Fields.audio ctype with | None -> frame - | Some data -> - let pcm = Content.Audio.get_data data in + | Some format -> + let pcm = Content.Audio.get_data (Content.make ~length format) in Audio.clear pcm 0 (Frame.audio_of_main length); Frame.set_data frame Frame.Fields.audio Content.Audio.lift_data pcm in diff --git a/src/core/decoder/liq_ogg_decoder.ml b/src/core/decoder/liq_ogg_decoder.ml index 3060d2a9e0..2a6feda8bb 100644 --- a/src/core/decoder/liq_ogg_decoder.ml +++ b/src/core/decoder/liq_ogg_decoder.ml @@ -170,14 +170,14 @@ let create_decoder ?(merge_tracks = false) source input = in let video_feed track buf = let info, _ = Ogg_decoder.video_info decoder track in - let rgb = video_convert video_scale buf in + let img = video_convert video_scale buf in let fps = { Decoder.num = info.Ogg_decoder.fps_numerator; den = info.Ogg_decoder.fps_denominator; } in - buffer.Decoder.put_yuva420p ~fps (Video.Canvas.single_image rgb) + buffer.Decoder.put_yuva420p ~fps (Video.Canvas.Image.make img) in let decode_audio, decode_video = if decode_audio && decode_video then diff --git a/src/core/decoder/midi_decoder.ml b/src/core/decoder/midi_decoder.ml index 89f0eac4d4..2686d3c989 100644 --- a/src/core/decoder/midi_decoder.ml +++ b/src/core/decoder/midi_decoder.ml @@ -69,7 +69,7 @@ let () = (fun ~metadata:_ ~ctype:_ _ -> Some (Frame.Fields.make - ~midi:Content.(Midi.lift_params { Content.channels = 16 }) + ~midi:Content.(Midi.lift_params { Content.Midi.channels = 16 }) ())); file_decoder = Some (fun ~metadata:_ ~ctype filename -> decoder ~ctype filename); diff --git a/src/core/encoder/encoder.ml b/src/core/encoder/encoder.ml index 3690d7566d..c9b7c8c206 100644 --- a/src/core/encoder/encoder.ml +++ b/src/core/encoder/encoder.ml @@ -96,7 +96,7 @@ let type_of_format f = assert (channels > 0); let params = { - Content.channel_layout = + Content.Audio.channel_layout = lazy (Audio_converter.Channel_layout.layout_of_channels channels); diff --git a/src/core/encoder/encoders/avi_encoder.ml b/src/core/encoder/encoders/avi_encoder.ml index b5470c43df..d2b6856cd6 100644 --- a/src/core/encoder/encoders/avi_encoder.ml +++ b/src/core/encoder/encoders/avi_encoder.ml @@ -46,47 +46,46 @@ let encode_frame ~channels ~samplerate ~width ~height ~converter frame start len in let video = let vbuf = VFrame.data frame in - let vstart = Frame.video_of_main start in - let vlen = Frame.video_of_main len in let data = Strings.Mutable.empty () in let scaler = Video_converter.scaler () in - for i = vstart to vstart + vlen - 1 do - let img = - Video.Canvas.get vbuf i - |> Video.Canvas.Image.resize ~scaler ~proportional:true target_width - target_height - |> Video.Canvas.Image.render ~transparent:false - in - let width = Image.YUV420.width img in - let height = Image.YUV420.height img in - if width <> target_width || height <> target_height then - failwith - (Printf.sprintf - "Resizing is not yet supported by AVI encoder got %dx%d instead \ - of %dx%d" - width height target_width target_height); - let y, u, v = Image.YUV420.data img in - let y = Image.Data.to_string y in - let u = Image.Data.to_string u in - let v = Image.Data.to_string v in - let y_stride = Image.YUV420.y_stride img in - let uv_stride = Image.YUV420.uv_stride img in - if y_stride = width then Strings.Mutable.add data y - else - for j = 0 to height - 1 do - Strings.Mutable.add_substring data y (j * y_stride) width - done; - if uv_stride = width / 2 then ( - Strings.Mutable.add data u; - Strings.Mutable.add data v) - else ( - for j = 0 to (height / 2) - 1 do - Strings.Mutable.add_substring data u (j * uv_stride) (width / 2) - done; - for j = 0 to (height / 2) - 1 do - Strings.Mutable.add_substring data v (j * uv_stride) (width / 2) - done) - done; + List.iter + (fun (_, img) -> + let img = + img + |> Video.Canvas.Image.resize ~scaler ~proportional:true target_width + target_height + |> Video.Canvas.Image.render ~transparent:false + in + let width = Image.YUV420.width img in + let height = Image.YUV420.height img in + if width <> target_width || height <> target_height then + failwith + (Printf.sprintf + "Resizing is not yet supported by AVI encoder got %dx%d instead \ + of %dx%d" + width height target_width target_height); + let y, u, v = Image.YUV420.data img in + let y = Image.Data.to_string y in + let u = Image.Data.to_string u in + let v = Image.Data.to_string v in + let y_stride = Image.YUV420.y_stride img in + let uv_stride = Image.YUV420.uv_stride img in + if y_stride = width then Strings.Mutable.add data y + else + for j = 0 to height - 1 do + Strings.Mutable.add_substring data y (j * y_stride) width + done; + if uv_stride = width / 2 then ( + Strings.Mutable.add data u; + Strings.Mutable.add data v) + else ( + for j = 0 to (height / 2) - 1 do + Strings.Mutable.add_substring data u (j * uv_stride) (width / 2) + done; + for j = 0 to (height / 2) - 1 do + Strings.Mutable.add_substring data v (j * uv_stride) (width / 2) + done)) + vbuf.Content.Video.data; Avi.video_chunk_strings data in Strings.add video audio diff --git a/src/core/encoder/encoders/ffmpeg_copy_encoder.ml b/src/core/encoder/encoders/ffmpeg_copy_encoder.ml index 36429f5955..33ec7993b1 100644 --- a/src/core/encoder/encoders/ffmpeg_copy_encoder.ml +++ b/src/core/encoder/encoders/ffmpeg_copy_encoder.ml @@ -41,7 +41,7 @@ let mk_stream_copy ~get_stream ~remove_stream ~keyframe_opt ~field output = let initialized_stream = Av.new_uninitialized_stream_copy output in let mk_stream frame = - let { Ffmpeg_content_base.params } = + let { Content.Video.params } = Ffmpeg_copy_content.get_data (Frame.get frame field) in let mk_stream params = @@ -165,9 +165,7 @@ let mk_stream_copy ~get_stream ~remove_stream ~keyframe_opt ~field output = let encode frame start len = let content = Content.sub (Frame.get frame field) start len in - let data = - (Ffmpeg_copy_content.get_data content).Ffmpeg_content_base.data - in + let data = (Ffmpeg_copy_content.get_data content).Content.Video.data in was_keyframe := false; diff --git a/src/core/encoder/encoders/ffmpeg_internal_encoder.ml b/src/core/encoder/encoders/ffmpeg_internal_encoder.ml index 9205a15dd5..39c5aabce2 100644 --- a/src/core/encoder/encoders/ffmpeg_internal_encoder.ml +++ b/src/core/encoder/encoders/ffmpeg_internal_encoder.ml @@ -221,7 +221,7 @@ let mk_audio ~pos ~mode ~codec ~params ~options ~field output = fun frame start len -> let frames = Ffmpeg_raw_content.Audio.(get_data (Frame.get frame field)) - .Ffmpeg_content_base.data + .Content.Video.data in let frames = List.filter (fun (pos, _) -> start <= pos && pos < start + len) frames @@ -440,23 +440,23 @@ let mk_video ~pos ~mode ~codec ~params ~options ~field output = let time_base = Ffmpeg_utils.liq_video_sample_time_base () in let stream_idx = 1L in - fun frame start len -> - let vstart = Frame.video_of_main start in - let vstop = Frame.video_of_main (start + len) in - let vbuf = VFrame.data ~field frame in - for i = vstart to vstop - 1 do - let f = - Video.Canvas.get vbuf i - (* TODO: we could scale instead of aggressively changing the viewport *) - |> Video.Canvas.Image.viewport src_width src_height - |> Video.Canvas.Image.render ~transparent:false - in - let vdata = Ffmpeg_utils.pack_image f in - let frame = InternalScaler.convert scaler vdata in - Avutil.Frame.set_pts frame (Some !nb_frames); - nb_frames := Int64.succ !nb_frames; - cb ~stream_idx ~time_base frame - done + fun frame offset length -> + let content = Content.sub (Frame.get frame field) offset length in + let buf = Content.Video.get_data content in + List.iter + (fun (_, img) -> + let f = + img + (* TODO: we could scale instead of aggressively changing the viewport *) + |> Video.Canvas.Image.viewport src_width src_height + |> Video.Canvas.Image.render ~transparent:false + in + let vdata = Ffmpeg_utils.pack_image f in + let frame = InternalScaler.convert scaler vdata in + Avutil.Frame.set_pts frame (Some !nb_frames); + nb_frames := Int64.succ !nb_frames; + cb ~stream_idx ~time_base frame) + buf.Content.Video.data in let raw_converter cb = diff --git a/src/core/encoder/encoders/gstreamer_encoder.ml b/src/core/encoder/encoders/gstreamer_encoder.ml index 304a190a39..3715816827 100644 --- a/src/core/encoder/encoders/gstreamer_encoder.ml +++ b/src/core/encoder/encoders/gstreamer_encoder.ml @@ -157,28 +157,33 @@ let encoder ext = ~duration (Option.get gst.audio_src) data 0 (Bytes.length data)); if videochans > 0 then ( (* Put video. *) - let vbuf = VFrame.data frame in - let vstart = Frame.video_of_main start in - let vlen = Frame.video_of_main len in - for i = vstart to vstart + vlen - 1 do - let img = Video.Canvas.render vbuf i in - (* TODO: Gstreamer expects multiples of 4 as strides, convert otherwise *) - assert (Image.YUV420.y_stride img = (Image.YUV420.width img + 3) / 4 * 4); - assert ( - Image.YUV420.uv_stride img - = ((Image.YUV420.width img / 2) + 3) / 4 * 4); - let y, u, v = Image.YUV420.data img in - let presentation_time = - Int64.add !presentation_time (Int64.mul (Int64.of_int i) vduration) - in - let buf = - Gstreamer.Buffer.of_data_list - (List.map (fun d -> (d, 0, Image.Data.length d)) [y; u; v]) - in - Gstreamer.Buffer.set_presentation_time buf presentation_time; - Gstreamer.Buffer.set_duration buf vduration; - Gstreamer.App_src.push_buffer (Option.get gst.video_src) buf - done); + let content = + Content.sub (Frame.get frame Frame.Fields.video) start len + in + let buf = Content.Video.get_data content in + let interval = Frame.main_of_video 1 in + List.iter + (fun (pos, img) -> + let img = Video.Canvas.Image.render img in + (* TODO: Gstreamer expects multiples of 4 as strides, convert otherwise *) + assert ( + Image.YUV420.y_stride img = (Image.YUV420.width img + 3) / 4 * 4); + assert ( + Image.YUV420.uv_stride img + = ((Image.YUV420.width img / 2) + 3) / 4 * 4); + let y, u, v = Image.YUV420.data img in + let presentation_time = + Int64.add !presentation_time + (Int64.mul (Int64.of_int (pos / interval)) vduration) + in + let buf = + Gstreamer.Buffer.of_data_list + (List.map (fun d -> (d, 0, Image.Data.length d)) [y; u; v]) + in + Gstreamer.Buffer.set_presentation_time buf presentation_time; + Gstreamer.Buffer.set_duration buf vduration; + Gstreamer.App_src.push_buffer (Option.get gst.video_src) buf) + buf.Content.Video.data); GU.flush ~log gst.bin; (* Return result. *) diff --git a/src/core/encoder/encoders/ogg_encoder.ml b/src/core/encoder/encoders/ogg_encoder.ml index c91f73519e..6c82f8257b 100644 --- a/src/core/encoder/encoders/ogg_encoder.ml +++ b/src/core/encoder/encoders/ogg_encoder.ml @@ -55,15 +55,22 @@ let encode_audio ~channels ~src_freq ~dst_freq () = (** Helper to encode video. *) let encode_video encoder id frame start len = + let content = Content.sub (Frame.get frame Frame.Fields.video) start len in + let buf = Content.Video.get_data content in let data = - VFrame.data frame |> Array.map (fun img -> Video.Canvas.Image.render img) + List.map + (fun (_, img) -> Video.Canvas.Image.render img) + buf.Content.Video.data in - let start = Frame.video_of_main start in - let len = Frame.video_of_main len in - let data = - Ogg_muxer.Video_data { Ogg_muxer.data; offset = start; length = len } - in - Ogg_muxer.encode encoder id data + match data with + | [] -> () + | data -> + let length = List.length data in + let data = + Ogg_muxer.Video_data + { Ogg_muxer.data = Array.of_list data; offset = 0; length } + in + Ogg_muxer.encode encoder id data let encoder_name = function | Ogg_format.Vorbis _ -> "vorbis" diff --git a/src/core/io/gstreamer_io.ml b/src/core/io/gstreamer_io.ml index bc7eb30e29..4e28c38fe0 100644 --- a/src/core/io/gstreamer_io.ml +++ b/src/core/io/gstreamer_io.ml @@ -282,17 +282,18 @@ class output ~clock_safe ~on_error ~infallible ~register_telnet ~on_start (Option.get el.audio) data 0 (Bytes.length data)); if has_video then ( let buf = VFrame.data frame in - for i = 0 to Video.Canvas.length buf - 1 do - let img = Video.Canvas.render buf i in - let y, u, v = Image.YUV420.data img in - let buf = - Gstreamer.Buffer.of_data_list - (List.map (fun d -> (d, 0, Image.Data.length d)) [y; u; v]) - in - Gstreamer.Buffer.set_duration buf duration; - Gstreamer.Buffer.set_presentation_time buf presentation_time; - Gstreamer.App_src.push_buffer (Option.get el.video) buf - done); + List.iter + (fun (_, img) -> + let img = Video.Canvas.Image.render img in + let y, u, v = Image.YUV420.data img in + let buf = + Gstreamer.Buffer.of_data_list + (List.map (fun d -> (d, 0, Image.Data.length d)) [y; u; v]) + in + Gstreamer.Buffer.set_duration buf duration; + Gstreamer.Buffer.set_presentation_time buf presentation_time; + Gstreamer.App_src.push_buffer (Option.get el.video) buf) + buf.Content.Video.data); presentation_time <- Int64.add presentation_time duration; GU.flush ~log:self#log ~on_error:(fun err -> raise (Flushing_error err)) @@ -605,9 +606,8 @@ class audio_video_input p (pipeline, audio_pipeline, video_pipeline) = Image.YUV420.make_data width height b (Image.Data.round 4 width) (Image.Data.round 4 (width / 2)) in - let stream = Video.Canvas.single_image img in Generator.put self#buffer Frame.Fields.video - (Content.Video.lift_data stream) + (Content.Video.lift_image (Video.Canvas.Image.make img)) done method generate_frame = diff --git a/src/core/operators/add.ml b/src/core/operators/add.ml index 81e1014df4..cd727aaed3 100644 --- a/src/core/operators/add.ml +++ b/src/core/operators/add.ml @@ -71,7 +71,9 @@ class virtual base ~name tracks = (fun ({ weight } as field) -> { field with weight = weight () }) fields in - let data = if source#is_ready then Some source#get_frame else None in + let data = + if source#is_ready then Some (source, source#get_frame) else None + in { fields; data } :: frames) [] tracks @@ -81,8 +83,8 @@ class virtual base ~name tracks = (fun pos { data } -> match (pos, data) with | _, None -> pos - | None, Some frame -> Some (Frame.position frame) - | Some p, Some frame -> Some (max p (Frame.position frame))) + | None, Some (_, frame) -> Some (Frame.position frame) + | Some p, Some (_, frame) -> Some (max p (Frame.position frame))) None frames) method seek_source = @@ -144,7 +146,7 @@ class audio_add ~renorm ~power ~field tracks = (fun { data; fields } -> match data with | None -> () - | Some frame -> + | Some (_, frame) -> List.iter (fun { field; weight } -> let track_pcm = @@ -166,42 +168,54 @@ class video_add ~field ~add tracks = method private generate_frame = let frames = self#generate_frames in - let pos = self#frames_position frames in - let vbuf = - Content.Video.make ~length:pos - (Content.Video.get_params (Frame.Fields.find field self#content_type)) - in - let ( ! ) = Frame.video_of_main in + let length = self#frames_position frames in let frames = List.fold_left (fun frames { data; fields } -> match data with | None -> frames - | Some frame -> + | Some (source, frame) -> frames @ List.map - (fun { position; field } -> (position, field, frame)) + (fun { position; field } -> + ( position, + source#last_image field, + Content.Video.get_data (Frame.get frame field) )) fields) [] frames in let frames = List.sort (fun (p, _, _) (p', _, _) -> Stdlib.compare p p') frames in - List.iteri - (fun rank (position, field, tmp) -> - let vtmp = Content.Video.get_data (Frame.get tmp field) in - for i = 0 to !pos - 1 do - let img = - if rank = 0 then Video.Canvas.get vtmp i - else - add position (Video.Canvas.get vtmp i) (Video.Canvas.get vbuf i) - in - Video.Canvas.set vbuf i img - done) - frames; - let buf = Frame.create ~length:pos Frame.Fields.empty in - let buf = Frame.Fields.add field (Content.Video.lift_data vbuf) buf in - self#set_metadata buf + let create, frames = + match frames with + | [] -> + ( (fun ~pos:_ ~width ~height () -> + Video.Canvas.Image.create width height), + [] ) + | (_, last_image, data) :: rest -> + ( (fun ~pos ~width:_ ~height:_ () -> + self#nearest_image ~pos ~last_image data), + rest ) + in + let buf = self#generate_video ~field ~create length in + let data = + List.map + (fun (pos, img) -> + ( pos, + List.fold_left + (fun img (rank, last_image, data) -> + add rank (self#nearest_image ~pos ~last_image data) img) + img frames )) + buf.Content.Video.data + in + let frame = + Frame.set_data + (Frame.create ~length Frame.Fields.empty) + field Content.Video.lift_data + { buf with Content.Video.data } + in + self#set_metadata frame end let get_tracks ~mk_weight p = diff --git a/src/core/operators/frei0r_op.ml b/src/core/operators/frei0r_op.ml index 1e4b4a3e2b..4a563d5920 100644 --- a/src/core/operators/frei0r_op.ml +++ b/src/core/operators/frei0r_op.ml @@ -46,7 +46,7 @@ let plugin_dirs = class frei0r_filter ~name bgra instance params (source : source) = let fps = Lazy.force Frame.video_rate in let dt = 1. /. float fps in - object + object (self) inherit operator ~name:("frei0r." ^ name) [source] method stype = source#stype method remaining = source#remaining @@ -56,25 +56,30 @@ class frei0r_filter ~name bgra instance params (source : source) = method abort_track = source#abort_track val mutable t = 0. + method private render img = + let img = Video.Canvas.Image.render img in + let img = Image.YUV420.to_RGBA32 img in + if bgra then Image.RGBA32.swap_rb img; + let src = Image.RGBA32.data (Image.RGBA32.copy img) in + let dst = Image.RGBA32.data img in + Frei0r.update1 instance t src dst; + if bgra then Image.RGBA32.swap_rb img; + t <- t +. dt; + Video.Canvas.Image.make (Image.YUV420.of_RGBA32 img) + method private generate_frame = - let rgb = + let buf = Content.Video.get_data (source#get_mutable_content Frame.Fields.video) in params (); - for i = 0 to Video.Canvas.length rgb - 1 do - (* TODO: we could try to be more efficient than converting to/from RGBA32 and swap colors... *) - let img = Video.Canvas.render rgb i in - let img = Image.YUV420.to_RGBA32 img in - if bgra then Image.RGBA32.swap_rb img; - let src = Image.RGBA32.data (Image.RGBA32.copy img) in - let dst = Image.RGBA32.data img in - Frei0r.update1 instance t src dst; - if bgra then Image.RGBA32.swap_rb img; - let img = Image.YUV420.of_RGBA32 img in - Video.Canvas.put rgb i img; - t <- t +. dt - done; - source#set_frame_data Frame.Fields.video Content.Video.lift_data rgb + source#set_frame_data Frame.Fields.video Content.Video.lift_data + { + buf with + Content.Video.data = + List.map + (fun (pos, img) -> (pos, self#render img)) + buf.Content.Video.data; + } end class frei0r_mixer ~name bgra instance params (source : source) source2 = @@ -108,13 +113,29 @@ class frei0r_mixer ~name bgra instance params (source : source) source2 = val mutable t = 0. method private generate_frame = - (* Get content in respective buffers *) - let rgb = - Content.Video.get_data (source#get_mutable_content Frame.Fields.video) + let length = min source#frame_position source2#frame_position in + let c = + Frame.get + (source#get_partial_frame (fun f -> Frame.slice f length)) + Frame.Fields.video + in + let c' = + Frame.get + (source2#get_partial_frame (fun f -> Frame.slice f length)) + Frame.Fields.video in - let rgb' = - Content.Video.get_data (Frame.get source2#get_frame Frame.Fields.video) + + let rgb = Content.Video.get_data c in + let rgb = + self#generate_video ~field:Frame.Fields.video + ~create:(fun ~pos ~width:_ ~height:_ () -> + self#nearest_image ~pos + ~last_image:(source#last_image Frame.Fields.video) + rgb) + length in + let rgb' = Content.Video.get_data c' in + params (); (* Mix content where the two streams are available. @@ -122,26 +143,32 @@ class frei0r_mixer ~name bgra instance params (source : source) source2 = * and/or attempt to get some more data in the buffers... * each solution has its downsides and it'll rarely matter * because there's usually only one image per video frame. *) - let length = min (Video.Canvas.length rgb) (Video.Canvas.length rgb') in - for i = 0 to length - 1 do - (* TODO: we could try to be more efficient than converting to/from RGBA32 and swap colors... *) - let img = Video.Canvas.render rgb i in - let img = Image.YUV420.to_RGBA32 img in - let img' = Video.Canvas.get rgb' i in - let img' = Video.Canvas.Image.render img' in - let img' = Image.YUV420.to_RGBA32 img' in - if bgra then Image.RGBA32.swap_rb img; - if bgra then Image.RGBA32.swap_rb img'; - let src = Image.RGBA32.data (Image.RGBA32.copy img) in - let src' = Image.RGBA32.data img' in - let dst = Image.RGBA32.data img in - Frei0r.update2 instance t src src' dst; - if bgra then Image.RGBA32.swap_rb img; - let img = Image.YUV420.of_RGBA32 img in - Video.Canvas.put rgb i img; - t <- t +. dt - done; - source#set_frame_data Frame.Fields.video Content.Video.lift_data rgb + let data = + List.map + (fun (pos, img) -> + let img = Video.Canvas.Image.render img in + let img = Image.YUV420.to_RGBA32 img in + let img' = + self#nearest_image ~pos + ~last_image:(source2#last_image Frame.Fields.video) + rgb' + in + let img' = Video.Canvas.Image.render img' in + let img' = Image.YUV420.to_RGBA32 img' in + if bgra then Image.RGBA32.swap_rb img; + if bgra then Image.RGBA32.swap_rb img'; + let src = Image.RGBA32.data (Image.RGBA32.copy img) in + let src' = Image.RGBA32.data img' in + let dst = Image.RGBA32.data img in + Frei0r.update2 instance t src src' dst; + if bgra then Image.RGBA32.swap_rb img; + let img = Image.YUV420.of_RGBA32 img in + t <- t +. dt; + (pos, Video.Canvas.Image.make img)) + rgb.Content.Video.data + in + source#set_frame_data Frame.Fields.video Content.Video.lift_data + { rgb with Content.Video.data } end class frei0r_source ~name bgra instance params = @@ -158,6 +185,16 @@ class frei0r_source ~name bgra instance params = method remaining = if must_fail then 0 else -1 val mutable t = 0. + method private render_image img = + let img = Video.Canvas.Image.render img in + let img = Image.YUV420.to_RGBA32 img in + let dst = Image.RGBA32.data img in + Frei0r.update0 instance t dst; + if bgra then Image.RGBA32.swap_rb img; + let img = Image.YUV420.of_RGBA32 img in + t <- t +. dt; + Video.Canvas.Image.make img + method private generate_frame = if must_fail then ( must_fail <- false; @@ -166,18 +203,14 @@ class frei0r_source ~name bgra instance params = params (); let length = Lazy.force Frame.size in let buf = Frame.create ~length self#content_type in - let rgb = Content.Video.get_data (Frame.get buf Frame.Fields.video) in - for i = 0 to Frame.video_of_main length - 1 do - let img = Video.Canvas.render rgb i in - let img = Image.YUV420.to_RGBA32 img in - let dst = Image.RGBA32.data img in - Frei0r.update0 instance t dst; - if bgra then Image.RGBA32.swap_rb img; - let img = Image.YUV420.of_RGBA32 img in - Video.Canvas.put rgb i img; - t <- t +. dt - done; - Frame.set_data buf Frame.Fields.video Content.Video.lift_data rgb) + let rgb = self#generate_video ~field:Frame.Fields.video length in + let data = + List.map + (fun (pos, img) -> (pos, self#render_image img)) + rgb.Content.Video.data + in + Frame.set_data buf Frame.Fields.video Content.Video.lift_data + { rgb with Content.Video.data }) end (** Make a list of parameters. *) diff --git a/src/core/operators/still_frame.ml b/src/core/operators/still_frame.ml index ba72f8b625..c739a67c1a 100644 --- a/src/core/operators/still_frame.ml +++ b/src/core/operators/still_frame.ml @@ -44,24 +44,27 @@ class still_frame ~name (source : source) = .bmp" else fname <- Some f - method private generate_frame = + method private still buf = match fname with - | None -> source#get_frame - | Some f -> - let v = - Content.Video.get_data - (source#get_mutable_content Frame.Fields.video) - in - let i = Video.Canvas.get v 0 in - let i = - i |> Video.Canvas.Image.render |> Image.YUV420.to_RGBA32 - |> Image.RGBA32.to_BMP - in - let oc = open_out f in - output_string oc i; - close_out oc; - fname <- None; - source#set_frame_data Frame.Fields.video Content.Video.lift_data v + | None -> () + | Some f -> ( + let v = Content.Video.get_data (Frame.get buf Frame.Fields.video) in + match v.Content.Video.data with + | [] -> () + | (_, i) :: _ -> + let i = + i |> Video.Canvas.Image.render |> Image.YUV420.to_RGBA32 + |> Image.RGBA32.to_BMP + in + let oc = open_out f in + output_string oc i; + close_out oc; + fname <- None) + + method private generate_frame = + let buf = source#get_frame in + self#still buf; + buf end let _ = diff --git a/src/core/operators/video_effects.ml b/src/core/operators/video_effects.ml index e045348eb1..0ca3d6cd7b 100644 --- a/src/core/operators/video_effects.ml +++ b/src/core/operators/video_effects.ml @@ -80,9 +80,24 @@ class virtual base ~name (source : source) f = method private generate_frame = let c = source#get_mutable_content Frame.Fields.video in - let video = Content.Video.get_data c in - f video 0 (Video.Canvas.length video); - source#set_frame_data Frame.Fields.video Content.Video.lift_data video + let buf = Content.Video.get_data c in + let data = buf.Content.Video.data in + let data = + if data = [] then data + else ( + let positions, images = + List.fold_left + (fun (positions, images) (pos, img) -> + (pos :: positions, img :: images)) + ([], []) buf.Content.Video.data + in + let positions = List.rev positions in + let video = Array.of_list (List.rev images) in + f video 0 (List.length images); + List.mapi (fun i pos -> (pos, Video.Canvas.get video i)) positions) + in + source#set_frame_data Frame.Fields.video Content.Video.lift_data + { buf with Content.Video.data } end class effect ~name (source : source) effect = diff --git a/src/core/operators/video_fade.ml b/src/core/operators/video_fade.ml index d7ad935cc0..02f37b91b9 100644 --- a/src/core/operators/video_fade.ml +++ b/src/core/operators/video_fade.ml @@ -39,8 +39,7 @@ class fade_in ?(meta = "liq_video_fade_in") duration fader fadefun source = val mutable state = `Idle method private process frame = - (* In video frames: [length] of the fade, [count] since beginning. *) - let fade, fadefun, length, count = + let fade, fadefun, duration, position = match state with | `Idle -> let duration = @@ -52,28 +51,30 @@ class fade_in ?(meta = "liq_video_fade_in") duration fader fadefun source = try float_of_string d with _ -> duration) | None -> duration) in - let length = Frame.video_of_seconds duration in - let fade = fader length in + let fade = fader (Frame.video_of_seconds duration) in + let duration = Frame.main_of_seconds duration in let fadefun = fadefun () in - state <- `Play (fade, fadefun, length, 0); - (fade, fadefun, length, 0) - | `Play (fade, fadefun, length, count) -> - (fade, fadefun, length, count) + let v = (fade, fadefun, duration, 0) in + state <- `Play v; + v + | `Play v -> v in - let vlen = Frame.video_of_main length in - if count < length then ( - let data = + if position < duration then ( + let buf = Content.Video.get_data (Content.copy (Frame.get frame Frame.Fields.video)) in - for i = 0 to vlen do - let m = fade (count + i) in - (* TODO @smimram *) - ignore (fadefun (Video.Canvas.get data i) m) - done; - state <- `Play (fade, fadefun, length, count + vlen); - Frame.set frame Frame.Fields.video - (Content.Video.lift_data ~length data)) + let data = + List.mapi + (fun i (pos, img) -> + let m = fade (Frame.video_of_main position + i) in + ignore (fadefun img m); + (pos, img)) + buf.Content.Video.data + in + state <- `Play (fade, fadefun, duration, position + Frame.position frame); + Frame.set_data frame Frame.Fields.video Content.Video.lift_data + { buf with Content.Video.data }) else frame method private generate_frame = @@ -101,10 +102,7 @@ class fade_out ?(meta = "liq_video_fade_out") duration fader fadefun source = method private can_generate_frame = source#is_ready method private process_frame ~remaining frame = - let n = Frame.video_of_main remaining in - let len = Frame.video_of_main (Frame.position frame) in - - (* In video frames: [length] of the fade. *) + (* In main ticks: [length] of the fade. *) let fade, fadefun, length = match cur_length with | Some (f, g, l) -> (f, g, l) @@ -119,25 +117,29 @@ class fade_out ?(meta = "liq_video_fade_out") duration fader fadefun source = | Some d -> ( try float_of_string d with _ -> duration)) in - let l = Frame.video_of_seconds duration in - let f = fader l in + let l = Frame.main_of_seconds duration in + let f = fader (Frame.video_of_seconds duration) in let g = fadefun () in cur_length <- Some (f, g, l); (f, g, l) in - if n < length then ( - let content = Frame.get frame Frame.Fields.video in - let data = Content.Video.get_data content in + if remaining < length then ( + let content = Content.copy (Frame.get frame Frame.Fields.video) in + let buf = Content.Video.get_data content in - for i = 0 to len - 1 do - let m = fade (n - i) in - (* TODO @smimram *) - ignore (fadefun (Video.Canvas.get data i) m) - done; + let data = + List.mapi + (fun i (pos, img) -> + let m = fade (Frame.video_of_main remaining - i) in + (* TODO @smimram *) + ignore (fadefun img m); + (pos, img)) + buf.Content.Video.data + in - Frame.set frame Frame.Fields.video - (Content.Video.lift_data ~length:(Frame.position frame) data)) + Frame.set_data frame Frame.Fields.video Content.Video.lift_data + { buf with Content.Video.data }) else frame method private generate_frame = diff --git a/src/core/outputs/graphics_out.ml b/src/core/outputs/graphics_out.ml index e4f132d2cd..5a30e63460 100644 --- a/src/core/outputs/graphics_out.ml +++ b/src/core/outputs/graphics_out.ml @@ -39,14 +39,17 @@ class output ~infallible ~register_telnet ~autostart ~on_start ~on_stop source = sleep <- false method send_frame buf = - let img = - let width, height = self#video_dimensions in - Video.Canvas.get (VFrame.data buf) 0 - |> Video.Canvas.Image.viewport width height - |> Video.Canvas.Image.render ~transparent:false - |> Image.YUV420.to_int_image |> Graphics.make_image - in - Graphics.draw_image img 0 0 + match (VFrame.data buf).Content.Video.data with + | [] -> () + | (_, img) :: _ -> + let width, height = self#video_dimensions in + let img = + img + |> Video.Canvas.Image.viewport width height + |> Video.Canvas.Image.render ~transparent:false + |> Image.YUV420.to_int_image |> Graphics.make_image + in + Graphics.draw_image img 0 0 method! reset = () end diff --git a/src/core/outputs/sdl_out.ml b/src/core/outputs/sdl_out.ml index 5e819c1f63..3e10e7d800 100644 --- a/src/core/outputs/sdl_out.ml +++ b/src/core/outputs/sdl_out.ml @@ -87,15 +87,18 @@ class output ~infallible ~register_telnet ~on_start ~on_stop ~autostart source = self#process_events; let window = Option.get window in let surface = Sdl_utils.check Sdl.get_window_surface window in - let img = - let width, height = self#video_dimensions in - (* We only display the first image of each frame *) - Video.Canvas.get (VFrame.data buf) 0 - |> Video.Canvas.Image.viewport width height - |> Video.Canvas.Image.render ~transparent:false - in - Sdl_utils.Surface.of_img surface img; - Sdl_utils.check Sdl.update_window_surface window + let width, height = self#video_dimensions in + match (VFrame.data buf).Content.Video.data with + | [] -> () + | (_, img) :: _ -> + (* We only display the first image of each frame *) + let img = + img + |> Video.Canvas.Image.viewport width height + |> Video.Canvas.Image.render ~transparent:false + in + Sdl_utils.Surface.of_img surface img; + Sdl_utils.check Sdl.update_window_surface window end let output_sdl = diff --git a/src/core/source.ml b/src/core/source.ml index 533874800e..6825807418 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -21,6 +21,7 @@ *****************************************************************************) open Liquidsoap_lang.Error +open Mm (** In this module we define the central streaming concepts: sources, active sources and clocks. @@ -598,7 +599,7 @@ class virtual operator ?pos ?(name = "src") sources = else _cache <- Some (Frame.chunk ~start:n ~stop:(pos - n) buf) | _ -> ()) - method get_partial_frame cb = + method peek_frame = self#has_ticked; match streaming_state with | `Unavailable -> @@ -606,11 +607,13 @@ class virtual operator ?pos ?(name = "src") sources = raise Unavailable | `Ready fn -> fn (); - self#get_partial_frame cb - | `Done data -> - let data = cb data in - consumed <- max consumed (Frame.position data); - data + self#peek_frame + | `Done data -> data + + method get_partial_frame cb = + let data = cb self#peek_frame in + consumed <- max consumed (Frame.position data); + data method get_frame = self#get_partial_frame (fun f -> f) @@ -698,9 +701,77 @@ class virtual operator ?pos ?(name = "src") sources = self#log#debug "calling on_track handlers.."; List.iter (fun fn -> fn m) on_track) + val mutable last_images = Hashtbl.create 0 + + method last_image field = + match Hashtbl.find_opt last_images field with + | Some i -> i + | None -> + let width, height = self#video_dimensions in + let i = Video.Canvas.Image.create width height in + Hashtbl.replace last_images field i; + i + + method private set_last_image ~field img = + Hashtbl.replace last_images field img + + val mutable video_generators = Hashtbl.create 0 + + method private video_generator ~priv field = + match Hashtbl.find_opt video_generators (priv, field) with + | Some g -> g + | None -> + let params = + Content.Video.get_params + (Frame.Fields.find field self#content_type) + in + let g = Content.Video.make_generator params in + Hashtbl.add video_generators (priv, field) g; + g + + method private internal_generate_video ?create ~priv ~field length = + Content.Video.generate ?create (self#video_generator ~priv field) length + + method private generate_video = self#internal_generate_video ~priv:false + + method private nearest_image ~pos ~last_image buf = + let nearest = + List.fold_left + (fun current (p, img) -> + match current with + | Some (p', _) when abs (p' - pos) < abs (p - pos) -> current + | _ -> Some (p, img)) + None buf.Content.Video.data + in + match nearest with Some (_, img) -> img | None -> last_image + + method private normalize_video ~field content = + let buf = Content.Video.get_data content in + let data = buf.Content.Video.data in + let last_image = + match List.rev data with + | (_, img) :: _ -> + self#set_last_image ~field img; + img + | [] -> self#last_image field + in + Content.Video.lift_data + (self#internal_generate_video ~field ~priv:true + ~create:(fun ~pos ~width:_ ~height:_ () -> + self#nearest_image ~pos ~last_image buf) + (Content.length content)) + + method private normalize_video_content = + Frame.Fields.mapi (fun field content -> + if + Content.Video.is_data content + && Frame.Fields.mem field self#content_type + then self#normalize_video ~field content + else content) + method private instrumented_generate_frame = let start_time = Unix.gettimeofday () in - let buf = self#generate_frame in + let buf = self#normalize_video_content self#generate_frame in let end_time = Unix.gettimeofday () in let length = Frame.position buf in let track_marks = Frame.track_marks buf in diff --git a/src/core/source.mli b/src/core/source.mli index f6006ed386..02e772ae5d 100644 --- a/src/core/source.mli +++ b/src/core/source.mli @@ -20,6 +20,8 @@ *****************************************************************************) +open Mm + type clock_variable (** In [`CPU] mode, synchronization is governed by the CPU clock. @@ -173,6 +175,21 @@ class virtual source : (** A buffer that can be used by the source. *) method buffer : Generator.t + method private generate_video : + ?create: + (pos:int -> width:int -> height:int -> unit -> Video.Canvas.image) -> + field:Frame.Fields.field -> + int -> + Content.Video.data + + method last_image : Frame.Fields.field -> Video.Canvas.image + + method private nearest_image : + pos:int -> + last_image:Video.Canvas.image -> + Content.Video.data -> + Video.Canvas.image + (** An empty frame that can be used by the source. *) method empty_frame : Frame.t @@ -244,6 +261,9 @@ class virtual source : is the same as the partial chunk returned for the callback for easy method call chaining. *) method get_partial_frame : (Frame.t -> Frame.t) -> Frame.t + (** Check a frame without consuming any of its data. *) + method peek_frame : Frame.t + (** This method requests a specific field of the frame that can be mutated. It is used by a consumer of the source that will modify the source's data (e.g. [amplify]). The source will do its best to minimize data copy according to the streaming context. Typically, diff --git a/src/core/sources/blank.ml b/src/core/sources/blank.ml index 30a94b329a..f4ce55f1e8 100644 --- a/src/core/sources/blank.ml +++ b/src/core/sources/blank.ml @@ -44,35 +44,45 @@ class blank duration = let was_first = is_first in is_first <- false; let length = Lazy.force Frame.size in - let frame = Frame.create ~length self#content_type in let audio_len = Frame.audio_of_main length in - let video_len = Frame.video_of_main length in let frame = - Frame.Fields.map - (fun c -> - match c with - | _ when Content.Audio.is_data c -> - let data = Content.Audio.get_data c in + Frame.Fields.fold + (fun field format frame -> + match format with + | _ when Content.Audio.is_format format -> + let data = + Content.Audio.get_data (Content.make ~length format) + in Audio.clear data 0 audio_len; - Content.Audio.lift_data ~length data - | _ when Content_pcm_s16.is_data c -> - let data = Content_pcm_s16.get_data c in + Frame.set_data frame field Content.Audio.lift_data data + | _ when Content_pcm_s16.is_format format -> + let data = + Content_pcm_s16.get_data (Content.make ~length format) + in Content_pcm_s16.clear data 0 audio_len; - Content_pcm_s16.lift_data ~length data - | _ when Content_pcm_f32.is_data c -> - let data = Content_pcm_f32.get_data c in + Frame.set_data frame field Content_pcm_s16.lift_data data + | _ when Content_pcm_f32.is_format format -> + let data = + Content_pcm_f32.get_data (Content.make ~length format) + in Content_pcm_f32.clear data 0 audio_len; - Content_pcm_f32.lift_data ~length data - | _ when Content.Video.is_data c -> - let data = Content.Video.get_data c in - Video.Canvas.blank data 0 video_len; - Content.Video.lift_data ~length data + Frame.set_data frame field Content_pcm_f32.lift_data data + | _ when Content.Video.is_format format -> + let data = + self#generate_video ~field + ~create:(fun ~pos:_ ~width ~height () -> + let img = Video.Canvas.Image.create width height in + Video.Canvas.Image.iter Video.Image.blank img) + length + in + Frame.set_data frame field Content.Video.lift_data data | _ - when Content.Metadata.is_data c || Content.Track_marks.is_data c - -> - c + when Content.Metadata.is_format format + || Content.Track_marks.is_format format -> + frame | _ -> failwith "Invalid content type!") - frame + self#content_type + (Frame.create ~length Frame.Fields.empty) in match (was_first, remaining) with | true, _ -> Frame.add_track_mark frame 0 diff --git a/src/core/sources/external_input_video.ml b/src/core/sources/external_input_video.ml index ac8a66456d..814b4202eb 100644 --- a/src/core/sources/external_input_video.ml +++ b/src/core/sources/external_input_video.ml @@ -169,7 +169,7 @@ let _ = (width * height * 3)); let data = (Option.get !video_converter) data in Generator.put buffer Frame.Fields.video - (Content.Video.lift_data (Video.Canvas.single data)) + (Content.Video.lift_image data) | `Frame (`Audio, _, data) -> let converter = Option.get !audio_converter in let data, ofs, len = @@ -234,8 +234,7 @@ let _ = (* Img.swap_rb data; *) (* Img.Effect.flip data; *) Generator.put buffer Frame.Fields.video - (Content.Video.lift_data - (Video.Canvas.single (Video.Canvas.Image.make data))) + (Content.Video.lift_image (Video.Canvas.Image.make data)) in let bufferize = Lang.to_float (List.assoc "buffer" p) in let restart = Lang.to_bool (List.assoc "restart" p) in diff --git a/src/core/sources/noise.ml b/src/core/sources/noise.ml index e5b19b8987..284772524f 100644 --- a/src/core/sources/noise.ml +++ b/src/core/sources/noise.ml @@ -30,35 +30,49 @@ class noise duration = method private synthesize length = let audio_len = Frame.audio_of_main length in - let video_len = Frame.video_of_main length in Frame.Fields.fold - (fun field typ frame -> - match typ with - | _ when Content.Audio.is_format typ -> - let data = Content.Audio.get_data (Frame.get frame field) in + (fun field format frame -> + match format with + | _ when Content.Audio.is_format format -> + let data = + Content.Audio.get_data (Content.make ~length format) + in Audio.Generator.white_noise data 0 audio_len; - Frame.set frame field (Content.Audio.lift_data ~length data) + Frame.set_data frame field Content.Audio.lift_data data (* This is not optimal. *) - | _ when Content_pcm_s16.is_format typ -> - let pcm = Content_pcm_s16.get_data (Frame.get frame field) in + | _ when Content_pcm_s16.is_format format -> + let pcm = + Content_pcm_s16.get_data (Content.make ~length format) + in let audio = Content_pcm_s16.to_audio pcm in Audio.Generator.white_noise audio 0 audio_len; Content_pcm_s16.blit_audio audio 0 pcm 0 audio_len; - Frame.set frame field (Content_pcm_s16.lift_data ~length pcm) - | _ when Content_pcm_f32.is_format typ -> - let pcm = Content_pcm_f32.get_data (Frame.get frame field) in + Frame.set_data frame field Content_pcm_s16.lift_data pcm + | _ when Content_pcm_f32.is_format format -> + let pcm = + Content_pcm_f32.get_data (Content.make ~length format) + in let audio = Content_pcm_f32.to_audio pcm in Audio.Generator.white_noise audio 0 audio_len; Content_pcm_f32.blit_audio audio 0 pcm 0 audio_len; Frame.set frame field (Content_pcm_f32.lift_data ~length pcm) - | _ when Content.Video.is_format typ -> - let data = Content.Video.get_data (Frame.get frame field) in - Video.Canvas.iter Image.YUV420.randomize data 0 video_len; - Frame.set frame field (Content.Video.lift_data ~length data) + | _ when Content.Video.is_format format -> + let data = + self#generate_video ~field + ~create:(fun ~pos:_ ~width ~height () -> + let img = Video.Canvas.Image.create width height in + Video.Canvas.Image.iter Image.YUV420.randomize img) + length + in + Frame.set_data frame field Content.Video.lift_data data + | _ + when Content.Metadata.is_format format + || Content.Track_marks.is_format format -> + frame | _ -> failwith "Invalid content type!") self#content_type - (Frame.create ~length self#content_type) + (Frame.create ~length Frame.Fields.empty) end let _ = diff --git a/src/core/sources/video_board.ml b/src/core/sources/video_board.ml index 22bf431a75..ef9c399cd3 100644 --- a/src/core/sources/video_board.ml +++ b/src/core/sources/video_board.ml @@ -52,14 +52,11 @@ class board ?duration img0 () = last_point <- Some (x, y) method private synthesize length = - let frame = Frame.create ~length self#content_type in - let frame_width, frame_height = self#video_dimensions in - let len = Frame.video_of_main length in - let buf = Content.Video.get_data (Frame.get frame Frame.Fields.video) in - for i = 0 to len - 1 do - buf.(i) <- - Video.Canvas.Image.make ~width:frame_width ~height:frame_height img - done; + let frame = Frame.create ~length Frame.Fields.empty in + let create ~pos:_ ~width ~height () = + Video.Canvas.Image.make ~width ~height img + in + let buf = self#generate_video ~field:Frame.Fields.video ~create length in Frame.set_data frame Frame.Fields.video Content.Video.lift_data buf end diff --git a/src/core/sources/video_testsrc.ml b/src/core/sources/video_testsrc.ml index 6808a685de..427207e516 100644 --- a/src/core/sources/video_testsrc.ml +++ b/src/core/sources/video_testsrc.ml @@ -39,13 +39,10 @@ class testsrc ?(duration = None) ~width ~height () = val mutable dvy' = 2 method private synthesize length = - let frame = Frame.create ~length self#content_type in - let frame_width, frame_height = self#video_dimensions in - let width = if width < 0 then frame_width else width in - let height = if height < 0 then frame_height else height in - let len = Frame.video_of_main length in - let buf = VFrame.data frame in - for i = 0 to len - 1 do + let frame = Frame.create ~length Frame.Fields.empty in + let create ~pos:_ ~width:frame_width ~height:frame_height () = + let width = if width < 0 then frame_width else width in + let height = if height < 0 then frame_height else height in let img = Image.YUV420.create width height in u0 <- u0 + u0'; if u0 < 0 then u0' <- abs u0'; @@ -68,9 +65,9 @@ class testsrc ?(duration = None) ~width ~height () = Image.YUV420.gradient_uv img (u0, v0) (u0 + dux, v0 + dvx) (u0 + duy, v0 + dvy); - buf.(i) <- - Video.Canvas.Image.make ~width:frame_width ~height:frame_height img - done; + Video.Canvas.Image.make ~width:frame_width ~height:frame_height img + in + let buf = self#generate_video ~field:Frame.Fields.video ~create length in Frame.set_data frame Frame.Fields.video Content.Video.lift_data buf end diff --git a/src/core/sources/video_text.ml b/src/core/sources/video_text.ml index b5d85d0844..edce2bf715 100644 --- a/src/core/sources/video_text.ml +++ b/src/core/sources/video_text.ml @@ -58,8 +58,7 @@ class text init render_text ttf ttf_size color duration text = Option.get text_frame method private synthesize length = - let frame = Frame.create ~length self#content_type in - let len = Frame.video_of_main length in + let frame = Frame.create ~length Frame.Fields.empty in let ttf = ttf () in let ttf_size = ttf_size () in let color = color () in @@ -74,14 +73,11 @@ class text init render_text ttf ttf_size color duration text = cur_text <- text; self#render_text); let tf = self#get_text_frame in - let buf = VFrame.data frame in - for i = 0 to len - 1 do - let img = buf.(i) in - let width = Video.Canvas.Image.width img in - let height = Video.Canvas.Image.height img in - buf.(i) <- Video.Canvas.Image.viewport width height tf - done; - Frame.set frame Frame.Fields.video (Content.Video.lift_data ~length buf) + let create ~pos:_ ~width ~height () = + Video.Canvas.Image.viewport width height tf + in + let buf = self#generate_video ~field:Frame.Fields.video ~create length in + Frame.set_data frame Frame.Fields.video Content.Video.lift_data buf end let register name init render_text = diff --git a/src/core/stream/content.ml b/src/core/stream/content.ml index af2273b606..f90fb4a7c3 100644 --- a/src/core/stream/content.ml +++ b/src/core/stream/content.ml @@ -20,6 +20,7 @@ *****************************************************************************) +open Mm include Content_base module MkContent (C : ContentSpecs) = struct @@ -35,17 +36,101 @@ end include Content_timed -type audio_params = Content_audio.Specs.params = { - channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.t; -} +module Audio = struct + include Content_audio -type video_params = Content_video.Specs.params = { - width : int Lazy.t option; - height : int Lazy.t option; -} + type audio_params = Content_audio.Specs.params = { + channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.t; + } +end + +module Video = struct + include Content_video + + type ('a, 'b) video_content = ('a, 'b) Content_video.Base.content = { + length : int; + mutable params : 'a; + mutable data : (int * 'b) list; + } + + type video_params = Content_video.Specs.params = { + width : int Lazy.t option; + height : int Lazy.t option; + } + + let lift_image img = + let width = Video.Canvas.Image.width img in + let height = Video.Canvas.Image.height img in + lift_data + { + length = Frame_settings.main_of_video 1; + params = { height = Some (lazy height); width = Some (lazy width) }; + data = [(0, img)]; + } + + let get_data content = + let buf = get_data content in + { + buf with + data = List.sort (fun (p, _) (p', _) -> Int.compare p p') buf.data; + } -type midi_params = Content_midi.Specs.params = { channels : int } + type generator = { + interval : int; + params : params; + width : int; + height : int; + mutable position : int64; + mutable next_sample : int64; + } -module Audio = Content_audio -module Video = Content_video -module Midi = Content_midi + let make_generator params = + let width = + Lazy.force + (Option.value ~default:Frame_settings.video_width + params.Content_video.Specs.width) + in + let height = + Lazy.force + (Option.value ~default:Frame_settings.video_height + params.Content_video.Specs.height) + in + { + params = + { + Content_video.Specs.width = Some (lazy width); + height = Some (lazy height); + }; + width; + height; + interval = Frame_settings.main_of_video 1; + position = 0L; + next_sample = 0L; + } + + let generate + ?(create = + fun ~pos:_ ~width ~height () -> + Mm.Video.Canvas.Image.create width height) gen length = + let initial_pos = gen.position in + gen.position <- Int64.add gen.position (Int64.of_int length); + let rec f data pos = + if length <= pos then List.rev data + else ( + let data = + if gen.next_sample <= Int64.add initial_pos (Int64.of_int pos) then ( + gen.next_sample <- + Int64.add gen.next_sample (Int64.of_int gen.interval); + (pos, create ~pos ~width:gen.width ~height:gen.height ()) :: data) + else List.rev data + in + f data (pos + gen.interval)) + in + { params = gen.params; length; data = f [] 0 } +end + +module Midi = struct + include Content_midi + + type midi_params = Content_midi.Specs.params = { channels : int } +end diff --git a/src/core/stream/content.mli b/src/core/stream/content.mli index 44aadbe1e4..c451fd9ddb 100644 --- a/src/core/stream/content.mli +++ b/src/core/stream/content.mli @@ -43,17 +43,6 @@ exception Invalid (* Raised when calling [merge] below. *) exception Incompatible_format of Contents.format * Contents.format -type audio_params = Content_audio.Specs.params = { - channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.t; -} - -type video_params = Content_video.Specs.params = { - width : int Lazy.t option; - height : int Lazy.t option; -} - -type midi_params = Content_midi.Specs.params = { channels : int } - module type ContentSpecs = sig type kind type params @@ -150,11 +139,15 @@ val kind_of_string : string -> kind (** Internal content types. *) module Audio : sig + type audio_params = Content_audio.Specs.params = { + channel_layout : [ `Mono | `Stereo | `Five_point_one ] Lazy.t; + } + include Content with type kind = [ `Pcm ] and type params = audio_params - and type data = Audio.Mono.buffer array + and type data = Audio.t val kind : Contents.kind val channels_of_format : Contents.format -> int @@ -162,17 +155,41 @@ module Audio : sig end module Video : sig + type ('a, 'b) video_content = ('a, 'b) Content_video.Base.content = { + length : int; + mutable params : 'a; + mutable data : (int * 'b) list; + } + + type video_params = Content_video.Specs.params = { + width : int Lazy.t option; + height : int Lazy.t option; + } + include Content with type kind = [ `Canvas ] and type params = video_params - and type data = Video.Canvas.t + and type data = (video_params, Video.Canvas.image) video_content val kind : Contents.kind val dimensions_of_format : Contents.format -> int * int + val lift_image : Video.Canvas.image -> Contents.data + + type generator + + val make_generator : params -> generator + + val generate : + ?create:(pos:int -> width:int -> height:int -> unit -> Video.Canvas.image) -> + generator -> + int -> + data end module Midi : sig + type midi_params = Content_midi.Specs.params = { channels : int } + include Content with type kind = [ `Midi ] diff --git a/src/core/stream/content_video.ml b/src/core/stream/content_video.ml index 56ec94c5eb..166145e40e 100644 --- a/src/core/stream/content_video.ml +++ b/src/core/stream/content_video.ml @@ -23,25 +23,69 @@ open Mm open Content_base +module Base = struct + type ('a, 'b) content = { + length : int; + mutable params : 'a; + mutable data : (int * 'b) list; + } + + let make ?(length = 0) params = { length; params; data = [] } + let length { length } = length + + let blit : + 'a 'b. + copy:('b -> 'b) -> + ('a, 'b) content -> + int -> + ('a, 'b) content -> + int -> + int -> + unit = + fun ~copy src src_pos dst dst_pos len -> + (* No compatibility check here, it's + assumed to have been done beforehand. *) + dst.params <- src.params; + let data = + List.filter + (fun (pos, _) -> pos < dst_pos || dst_pos + len <= pos) + dst.data + in + let src_end = src_pos + len in + let data = + List.fold_left + (fun data (pos, p) -> + if src_pos <= pos && pos < src_end then ( + let pos = dst_pos + (pos - src_pos) in + (pos, copy p) :: data) + else data) + data src.data + in + dst.data <- List.sort (fun (pos, _) (pos', _) -> compare pos pos') data + + let fill : + 'a 'b. ('a, 'b) content -> int -> ('a, 'b) content -> int -> int -> unit + = + fun src src_pos dst dst_pos len -> + blit ~copy:(fun x -> x) src src_pos dst dst_pos len + + let copy ~copy { length; data; params } = + { length; data = List.map (fun (pos, x) -> (pos, copy x)) data; params } + + let params { params } = params +end + module Specs = struct open Frame_settings + include Base type kind = [ `Canvas ] type params = { width : int Lazy.t option; height : int Lazy.t option } - type data = Video.Canvas.t + type data = (params, Video.Canvas.image) content let internal_content_type = Some `Video let string_of_kind = function `Canvas -> "canvas" - let make ?(length = 0) (p : params) : data = - let width = !!(Option.value ~default:video_width p.width) in - let height = !!(Option.value ~default:video_height p.height) in - (* We need to round off to make sure we always have room *) - let length = int_of_float (Float.ceil (video_of_main_f length)) in - Video.Canvas.make length (width, height) - - let length d = main_of_video (Video.Canvas.length d) - let string_of_params { width; height } = print_optional [ @@ -49,6 +93,16 @@ module Specs = struct ("height", Option.map (fun x -> string_of_int !!x) height); ] + let make ?(length = 0) params = + let width = !!(Option.value ~default:video_width params.width) in + let height = !!(Option.value ~default:video_height params.height) in + let interval = main_of_video 1 in + let img = Video.Canvas.Image.create width height in + let data = + List.init (video_of_main length) (fun i -> (i * interval, img)) + in + { length; params; data } + let parse_param label value = match label with | "width" -> @@ -77,23 +131,10 @@ module Specs = struct in compare (p.width, p'.width) && compare (p.height, p'.height) - let blit src src_pos dst dst_pos len = - let ( ! ) = Frame_settings.video_of_main in - let len = !(dst_pos + len) - !dst_pos in - let src_pos = !src_pos in - let dst_pos = !dst_pos in - Video.Canvas.blit src src_pos dst dst_pos len + let blit = fill - let copy = Video.Canvas.copy - - let params data = - if Array.length data = 0 then { width = None; height = None } - else ( - let i = data.(0) in - { - width = Some (lazy (Video.Canvas.Image.width i)); - height = Some (lazy (Video.Canvas.Image.height i)); - }) + let copy : 'a. ('a, 'b) content -> ('a, 'b) content = + fun src -> copy ~copy:(fun x -> x) src let kind = `Canvas let default_params _ = { width = None; height = None } @@ -102,9 +143,6 @@ end include MkContentBase (Specs) -(* Internal video chunks are rounded off to the nearest integer - so we do need to make sure length is always specified. *) -let make ?(length = 0) = make ~length let kind = lift_kind `Canvas let dimensions_of_format p = @@ -116,3 +154,27 @@ let dimensions_of_format p = Lazy.force (Option.value ~default:Frame_settings.video_height p.height) in (width, height) + +let lift_canvas ?(offset = 0) ?length data = + let interval = Frame_settings.main_of_video 1 in + let data = Array.(to_list (mapi (fun pos d -> (pos * interval, d)) data)) in + let params = + match data with + | [] -> { Specs.width = None; height = None } + | (_, i) :: _ -> + { + Specs.width = Some (lazy (Video.Canvas.Image.width i)); + height = Some (lazy (Video.Canvas.Image.height i)); + } + in + let length = + match length with Some l -> l | None -> List.length data * interval + in + let data = + List.filter (fun (pos, _) -> offset <= pos && pos < offset + length) data + in + lift_data ~length { length; params; data } + +let get_canvas data = + let { Base.data } = get_data data in + Array.of_list (List.map snd data) diff --git a/src/core/stream/ffmpeg_content_base.ml b/src/core/stream/ffmpeg_content_base.ml index a4328a75d5..4fd7b38cf9 100644 --- a/src/core/stream/ffmpeg_content_base.ml +++ b/src/core/stream/ffmpeg_content_base.ml @@ -20,61 +20,13 @@ *****************************************************************************) -type ('a, 'b) content = { - length : int; - mutable params : 'a; - mutable data : (int * 'b) list; -} - let conf_ffmpeg_content = Dtools.Conf.void ~p:(Ffmpeg_utils.conf_ffmpeg#plug "content") "FFmpeg content configuration" -let make ?(length = 0) params = { length; params; data = [] } -let length { length } = length let stream_idx = ref 0L let new_stream_idx () = stream_idx := Int64.succ !stream_idx; !stream_idx - -let compare (x : int) (y : int) = x - y [@@inline always] - -let blit : - 'a 'b. - copy:('b -> 'b) -> - ('a, 'b) content -> - int -> - ('a, 'b) content -> - int -> - int -> - unit = - fun ~copy src src_pos dst dst_pos len -> - (* No compatibility check here, it's - assumed to have been done beforehand. *) - dst.params <- src.params; - let data = - List.filter (fun (pos, _) -> pos < dst_pos || dst_pos + len <= pos) dst.data - in - let src_end = src_pos + len in - let data = - List.fold_left - (fun data (pos, p) -> - if src_pos <= pos && pos < src_end then ( - let pos = dst_pos + (pos - src_pos) in - (pos, copy p) :: data) - else data) - data src.data - in - dst.data <- List.sort (fun (pos, _) (pos', _) -> compare pos pos') data - -let fill : - 'a 'b. ('a, 'b) content -> int -> ('a, 'b) content -> int -> int -> unit = - fun src src_pos dst dst_pos len -> - blit ~copy:(fun x -> x) src src_pos dst dst_pos len - -let copy ~copy { length; data; params } = - { length; data = List.map (fun (pos, x) -> (pos, copy x)) data; params } - -let params { params } = params diff --git a/src/core/stream/ffmpeg_copy_content.ml b/src/core/stream/ffmpeg_copy_content.ml index eee1688fca..2c94f68c46 100644 --- a/src/core/stream/ffmpeg_copy_content.ml +++ b/src/core/stream/ffmpeg_copy_content.ml @@ -47,7 +47,7 @@ type packet_payload = { } module Specs = struct - include Ffmpeg_content_base + include Content_video.Base type kind = [ `Copy ] type params = params_payload option diff --git a/src/core/stream/ffmpeg_raw_content.ml b/src/core/stream/ffmpeg_raw_content.ml index a8ccf04405..e5edcdfed3 100644 --- a/src/core/stream/ffmpeg_raw_content.ml +++ b/src/core/stream/ffmpeg_raw_content.ml @@ -30,7 +30,7 @@ type 'a frame = { } module BaseSpecs = struct - include Ffmpeg_content_base + include Content_video.Base type kind = [ `Raw ] diff --git a/src/core/stream/frame_settings.ml b/src/core/stream/frame_settings.ml index b8768d612f..089f8dacf2 100644 --- a/src/core/stream/frame_settings.ml +++ b/src/core/stream/frame_settings.ml @@ -208,42 +208,19 @@ let size = let audio = !!audio_rate in let video = !!video_rate in let main = !!main_rate in - let granularity = - match (audio, video) with - | 0, 0 -> assert false (* main_rate would error before this. *) - | audio, 0 -> main / audio - | 0, video -> main / video - | audio, video -> lcm (main / audio) (main / video) - in - let target = - log#important "Using %dHz audio, %dHz video, %dHz main." audio video - main; - log#important "Video frame size set to: %dx%d" conf_video_width#get - conf_video_height#get; + log#important "Using %dHz audio, %dHz video, %dHz main." audio video main; + log#important "Video frame size set to: %dx%d" conf_video_width#get + conf_video_height#get; + try + let size = main_of_audio conf_audio_size#get in log#important - "Frame size must be a multiple of %d ticks = %d audio samples = %d \ - video samples." - granularity - (audio_of_main granularity) - (video_of_main granularity); - try - let d = conf_audio_size#get in - log#important - "Targeting 'frame.audio.size': %d audio samples = %d ticks." d - (main_of_audio d); - main_of_audio d - with Conf.Undefined _ -> - log#important - "Targeting 'frame.duration': %.2fs = %d audio samples = %d ticks." - conf_duration#get - (audio_of_seconds conf_duration#get) - (main_of_seconds conf_duration#get); - main_of_seconds conf_duration#get - in - let s = upper_multiple granularity (max 1 target) in - log#important - "Frames last %.2fs = %d audio samples = %d video samples = %d ticks." - (seconds_of_main s) (audio_of_main s) (video_of_main s) s; - s) + "Targeting 'frame.audio.size': %d audio samples = %d ticks = %.2fs." + conf_audio_size#get size (seconds_of_main size); + size + with Conf.Undefined _ -> + let size = main_of_seconds conf_duration#get in + log#important "Targeting 'frame.duration': %.2fs = %d ticks." + conf_duration#get size; + size) let duration = delayed (fun () -> float !!size /. float !!main_rate) diff --git a/src/core/visualization/video_volume.ml b/src/core/visualization/video_volume.ml index 73a3c9e403..fffd0acc58 100644 --- a/src/core/visualization/video_volume.ml +++ b/src/core/visualization/video_volume.ml @@ -65,6 +65,37 @@ class visu source = done; pos <- (pos + 1) mod backpoints) + method private create_image ~pos:_ ~volwidth ~volheight ~width ~height () = + let img = ref (Video.Canvas.Image.create width height) in + let line c p q = + img := Video.Canvas.Image.add (Video.Canvas.Image.Draw.line c p q) !img + in + for i = 0 to self#audio_channels - 1 do + let y = int_of_float (volheight *. float i) in + line (90, 90, 90, 0xff) (0, y) (width - 1, y); + for chan = 0 to self#audio_channels - 1 do + let vol = vol.(chan) in + let chan_height = int_of_float (volheight *. float chan) in + let x0 = 0 in + let y0 = + height - (int_of_float (volheight *. vol.(pos)) + chan_height) - 1 + in + let pt0 = ref (x0, y0) in + for i = 1 to backpoints - 1 do + let pt1 = + ( int_of_float (volwidth *. float i), + height + - (chan_height + + int_of_float (volheight *. vol.((i + pos) mod backpoints))) + - 1 ) + in + line (0, 0xff, 0, 0xff) !pt0 pt1; + pt0 := pt1 + done + done + done; + !img + method private generate_frame = let frame = source#get_frame in @@ -85,44 +116,11 @@ class visu source = let width, height = self#video_dimensions in let volwidth = float width /. float backpoints in let volheight = float height /. float self#audio_channels in - let content = - Content.make ~length:(Frame.position frame) - (Frame.Fields.find Frame.Fields.video self#content_type) + let buf = + self#generate_video ~field:Frame.Fields.video + ~create:(self#create_image ~volwidth ~volheight) + (Frame.position frame) in - let buf = Content.Video.get_data content in - for f = 0 to Video.Canvas.length buf - 1 do - let img = ref (Video.Canvas.Image.create width height) in - let line c p q = - img := - Video.Canvas.Image.add (Video.Canvas.Image.Draw.line c p q) !img - in - for i = 0 to self#audio_channels - 1 do - let y = int_of_float (volheight *. float i) in - line (90, 90, 90, 0xff) (0, y) (width - 1, y); - for chan = 0 to self#audio_channels - 1 do - let vol = vol.(chan) in - let chan_height = int_of_float (volheight *. float chan) in - let x0 = 0 in - let y0 = - height - (int_of_float (volheight *. vol.(pos)) + chan_height) - 1 - in - let pt0 = ref (x0, y0) in - for i = 1 to backpoints - 1 do - let pt1 = - ( int_of_float (volwidth *. float i), - height - - (chan_height - + int_of_float (volheight *. vol.((i + pos) mod backpoints)) - ) - - 1 ) - in - line (0, 0xff, 0, 0xff) !pt0 pt1; - pt0 := pt1 - done - done - done; - Video.Canvas.set buf f !img - done; Frame.set_data frame Frame.Fields.video Content.Video.lift_data buf end diff --git a/tests/core/content_test.ml b/tests/core/content_test.ml index 3db44c5a46..e96473ae47 100644 --- a/tests/core/content_test.ml +++ b/tests/core/content_test.ml @@ -29,10 +29,12 @@ let () = let frame = Frame.add_metadata frame 123 m in assert (Frame.get_all_metadata frame = [(123, m)]) +let compare_image (p, img) (p', img') = p = p' && img == img' + (* Test content boundaries. We create 3 content chunk and make sure that the consolidated content - contains the last one's data. *) + contains the first one's data. *) let () = let length = Lazy.force Frame.size in let chunk_len = length / 3 in @@ -41,8 +43,8 @@ let () = let fst = Content.sub fst 0 chunk_len in let snd = Content.make ~length Content.(default_format Video.kind) in let snd = Content.sub snd chunk_len chunk_len in - let thrd_d = Content.make ~length Content.(default_format Video.kind) in - let thrd = Content.sub thrd_d (2 * chunk_len) (length - (2 * chunk_len)) in + let thrd = Content.make ~length Content.(default_format Video.kind) in + let thrd = Content.sub thrd (2 * chunk_len) (length - (2 * chunk_len)) in let data = Content.append fst snd in let data = Content.append data thrd in assert (Content.length data = length); @@ -50,12 +52,18 @@ let () = Content.fill data 0 final 0 length; let data = Content.Video.get_data data in let final = Content.Video.get_data final in - assert (Array.length data = 1); - assert (Array.length final = 1); - assert (data.(0) == final.(0)); - let thrd_d = Content.Video.get_data thrd_d in - assert (Array.length thrd_d = 1); - assert (thrd_d.(0) == final.(0)) + assert (List.length data.Content.Video.data = 1); + assert (List.length final.Content.Video.data = 1); + assert ( + compare_image + (List.hd data.Content.Video.data) + (List.hd final.Content.Video.data)); + let fst = Content.Video.get_data fst in + assert (List.length fst.Content.Video.data = 1); + assert ( + compare_image + (List.hd fst.Content.Video.data) + (List.hd final.Content.Video.data)) (* Another content test boundary. We create a source of 1 and a source of length 2 * Frame.size - 1 @@ -76,5 +84,9 @@ let () = Content.fill src 0 dst 0 (2 * size); let src = Content.Video.get_data src in let dst = Content.Video.get_data dst in - assert (Array.length src = Array.length dst); - Array.iteri (fun pos d -> assert (d == dst.(pos))) src + assert ( + List.length src.Content.Video.data = List.length dst.Content.Video.data); + List.iteri + (fun pos d -> + assert (compare_image d (List.nth dst.Content.Video.data pos))) + src.Content.Video.data diff --git a/tests/core/decoder_test.ml b/tests/core/decoder_test.ml index 4f8d4deb12..849222068f 100644 --- a/tests/core/decoder_test.ml +++ b/tests/core/decoder_test.ml @@ -4,17 +4,17 @@ let () = let () = let mono = - Content.(Audio.lift_params { Content.channel_layout = lazy `Mono }) + Content.(Audio.lift_params { Content.Audio.channel_layout = lazy `Mono }) in let stereo = - Content.(Audio.lift_params { Content.channel_layout = lazy `Stereo }) + Content.(Audio.lift_params { Content.Audio.channel_layout = lazy `Stereo }) in let five_point_one = Content.( - Audio.lift_params { Content.channel_layout = lazy `Five_point_one }) + Audio.lift_params { Content.Audio.channel_layout = lazy `Five_point_one }) in let canvas = Content.default_format Content_video.kind in - let midi = Content.(Midi.lift_params { Content.channels = 1 }) in + let midi = Content.(Midi.lift_params { Content.Midi.channels = 1 }) in assert ( Decoder.can_decode_type (Frame.Fields.make ~audio:stereo ())