2 changed files with 59 additions and 29 deletions
@ -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 () |
|||
|
@ -1,4 +1,4 @@ |
|||
(executable |
|||
(public_name ccbg) |
|||
(modules ccbg) |
|||
(libraries bos directories fpath)) |
|||
(libraries bos directories fpath scfg)) |
|||
|
Loading…
Reference in new issue