diff --git a/src/ccbg.ml b/src/ccbg.ml index b2c46b2..2f270c1 100644 --- a/src/ccbg.ml +++ b/src/ccbg.ml @@ -1,61 +1,91 @@ -module Project_dirs = Directories.Project_dirs (struct - let qualifier = "org" +module App_id = struct + let qualifier = "fr" let organization = "zapashcanon" let application = "ccbg" -end) +end + +module Project_dirs = Directories.Project_dirs (App_id) module User_dirs = Directories.User_dirs () -let err msg = +let error msg = Format.eprintf "error: %s@." msg; exit 1 -let config_dir = - match Project_dirs.config_dir with - | None -> err "can't compute config directory path" - | Some dir -> dir +let some_or_fail msg = function None -> error msg | Some v -> v -let wallpaper_dir = - match User_dirs.picture_dir with - | None -> err "can't compute picture directory path" - | Some dir -> Filename.concat dir "wallpaper" +let ok_or_fail r = Result.fold ~error ~ok:Fun.id r -let time = 600 +let config = + (* we look if there's some configuration *) + let config_dir = + let module Project_dirs = Directories.Project_dirs (App_id) in + some_or_fail "can't compute configuration directory path" + Project_dirs.config_dir + in + let file_name = Filename.concat config_dir "config.scfg" in + (* if the config file doesn't exist, then we use the empty configuration *) + if not @@ Sys.file_exists file_name then [] + else ok_or_fail (Scfg.Parse.from_file file_name) + +let wallpaper_dir = + match Scfg.Query.get_dir "wallpaper_dir" config with + | None -> + some_or_fail "can't compute picture directory path" User_dirs.picture_dir + | Some wallpaper_dir -> ok_or_fail (Scfg.Query.get_param 0 wallpaper_dir) -let time = Format.sprintf "%ds" time +let interval = + let interval = + match Scfg.Query.get_dir "interval" config with + | None -> 600 + | Some interval -> ok_or_fail (Scfg.Query.get_param_pos_int 0 interval) + in + Format.sprintf "%ds" interval -let () = Random.self_init () +let mode = + match Scfg.Query.get_dir "mode" config with + | None -> "fill" + | Some mode -> ( + match ok_or_fail (Scfg.Query.get_param 0 mode) with + | ("center" | "fill" | "fit" | "solid_color" | "stretch" | "tile") as mode + -> + mode + | invalid_mode -> error (Format.sprintf "invalid mode `%s`" invalid_mode) ) let wallpaper_files = match Bos.OS.Dir.contents (Fpath.v wallpaper_dir) with - | Ok cnt -> + | Error (`Msg e) -> error e + | Ok cnt -> ( + (* remove directories from the list... *) let cnt = List.filter (fun path -> - match Bos.OS.Dir.exists path with - | Ok false -> true - | Ok true -> false - | _ -> false ) + match Bos.OS.Dir.exists path with Ok b -> not b | _ -> false ) cnt in - Array.of_list (List.map Fpath.to_string cnt) - | Error (`Msg e) -> err e + match Array.of_list (List.map Fpath.to_string cnt) with + | [||] -> error (Format.sprintf "no wallpaper found in %s" wallpaper_dir) + | wallpaper_files -> wallpaper_files ) let random_wallpaper = let len = Array.length wallpaper_files in fun () -> wallpaper_files.(Random.int len) let rec new_wallpaper () = + let open Bos in match - Bos.OS.Cmd.run - Bos.Cmd.( - v "timeout" % time % "swaybg" % "--mode" % "fill" % "--image" + OS.Cmd.run ~err:OS.Cmd.err_null + Cmd.( + v "timeout" % interval % "swaybg" % "--mode" % mode % "--image" % random_wallpaper () ) with - | _ -> new_wallpaper () + | Ok () -> error "timeout failed" + | Error (`Msg (_s : string)) -> + (* timeout killed the swaybg process, we can launch a new one *) + new_wallpaper () let () = - match Bos.OS.Cmd.run Bos.Cmd.(v "killall" % "swaybg") with - | _ -> new_wallpaper () + Random.self_init (); + new_wallpaper () diff --git a/src/dune b/src/dune index 89d8787..636755d 100644 --- a/src/dune +++ b/src/dune @@ -1,4 +1,4 @@ (executable (public_name ccbg) (modules ccbg) - (libraries bos directories fpath)) + (libraries bos directories fpath scfg))