Add SDL log verbosity conf.

CHANGES.md

@@ -1,3 +1,11 @@
+# 2.2.1 (unreleased)
+
+New:
+
+Changed:
+
+- Mute SDL startup messages (#2913).
+
 # 2.2.0 (2023-07-21)
 
 New:

src/core/dune

@@ -613,9 +613,17 @@
  (optional)
  (modules libsamplerate_converter))
 
+(library
+ (name liquidsoap_sdl_log_level)
+ (libraries tsdl)
+ (library_flags -linkall)
+ (wrapped false)
+ (optional)
+ (modules sdl_log_level))
+
 (library
  (name liquidsoap_sdl)
- (libraries tsdl-image tsdl-ttf liquidsoap_core)
+ (libraries liquidsoap_sdl_log_level tsdl-image tsdl-ttf liquidsoap_core)
  (library_flags -linkall)
  (wrapped false)
  (optional)

src/core/tools/sdl_log_level.ml

@@ -0,0 +1,29 @@
+(*****************************************************************************
+
+  Liquidsoap, a programmable audio stream generator.
+  Copyright 2003-2023 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
+
+ *****************************************************************************)
+
+(* We have to do a separate library here do lower the log level before
+   tsdl-image or tsdl-ttf module perform their side-effects and print an
+   obnoxious startup message. *)
+
+open Tsdl
+
+let () = Sdl.log_set_all_priority Sdl.Log.priority_warn

src/core/tools/sdl_utils.ml

@@ -20,10 +20,54 @@
 
  *****************************************************************************)
 
+let log = Log.make ["sdl"]
+
 open Mm
 open Tsdl
 module Gen = Image.Generic
 
+let conf_sdl =
+  Dtools.Conf.void ~p:(Configure.conf#plug "sdl") "SDL configuration"
+
+let conf_log = Dtools.Conf.void ~p:(conf_sdl#plug "log") "Logging configuration"
+
+let categories =
+  [
+    ("application", Sdl.Log.category_application);
+    ("error", Sdl.Log.category_error);
+    ("system", Sdl.Log.category_system);
+    ("audio", Sdl.Log.category_audio);
+    ("video", Sdl.Log.category_video);
+    ("render", Sdl.Log.category_render);
+    ("input", Sdl.Log.category_input);
+  ]
+
+let priorities =
+  [
+    ("verbose", Sdl.Log.priority_verbose);
+    ("debug", Sdl.Log.priority_debug);
+    ("info", Sdl.Log.priority_info);
+    ("warn", Sdl.Log.priority_warn);
+    ("error", Sdl.Log.priority_error);
+    ("critical", Sdl.Log.priority_critical);
+  ]
+
+let logging_conf_list =
+  List.map
+    (fun (label, category) ->
+      ( label,
+        category,
+        Dtools.Conf.string ~p:(conf_log#plug label)
+          (label ^ " logging verbosity.")
+          ~comments:
+            [
+              "Set SDL " ^ label ^ " logging verbosity";
+              "One of: \"verbose\", \"debug\", \"info\", \"warn\", \"error\" \
+               or \"critical\".";
+            ]
+          ~d:"warn" ))
+    categories
+
 type event =
   [ `AUDIO
   | `CDROM
@@ -39,11 +83,20 @@ let options : Sdl.Init.t option ref = ref None
 let check f x =
   match f x with Error (`Msg err) -> failwith err | Ok ans -> ans
 
-let initialized = ref false
+(* This is also done is sdl_log_level, but just in case... *)
+let () = Sdl.log_set_all_priority Sdl.Log.priority_warn
 
 let init l =
   if !options = None then options := Some Sdl.Init.nothing;
-  List.iter (fun e -> options := Some Sdl.Init.(Option.get !options + e)) l
+  List.iter (fun e -> options := Some Sdl.Init.(Option.get !options + e)) l;
+  List.iter
+    (fun (label, category, conf) ->
+      try
+        let priority = List.assoc conf#get priorities in
+        Sdl.log_set_priority category priority
+      with Not_found ->
+        log#important "Invalid log priority %S for category %S!" conf#get label)
+    logging_conf_list
 
 let () =
   Lifecycle.on_start (fun () ->