Browse Source

use scfg, clean code

master
zapashcanon 11 months ago
parent
commit
07d092e473
Signed by: zapashcanon GPG Key ID: 8981C3C62D1D28F1
  1. 86
      src/ccbg.ml
  2. 2
      src/dune

86
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 ()

2
src/dune

@ -1,4 +1,4 @@
(executable
(public_name ccbg)
(modules ccbg)
(libraries bos directories fpath))
(libraries bos directories fpath scfg))

Loading…
Cancel
Save