diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | README.md | 2 | ||||
| -rwxr-xr-x | Wallgen.fsx | 220 |
3 files changed, 223 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f5bd37c --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +core diff --git a/README.md b/README.md new file mode 100644 index 0000000..7de10c6 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +# Wallgen +Generate wallpapers with centered text from existing images. diff --git a/Wallgen.fsx b/Wallgen.fsx new file mode 100755 index 0000000..24e72ad --- /dev/null +++ b/Wallgen.fsx @@ -0,0 +1,220 @@ +#!/usr/bin/env -S dotnet fsi +#r "nuget: Argu, 6.2.5" +#r "nuget: Tommy, 3.1.2" +open Argu +open System +open System.IO +open Tommy +open System.Diagnostics +open System.Threading.Tasks + +type Argument = + | [<Mandatory; AltCommandLine("-i")>] Inputs of input: string list + | [<Mandatory; AltCommandLine("-t")>] Texts of text: string list + | [<Mandatory; Unique; AltCommandLine("-o")>] Output of output: string + | [<Unique; AltCommandLine("-c")>] Config of config: string + | [<Unique; AltCommandLine("-f")>] Format of format: string + + interface IArgParserTemplate with + member s.Usage : string = + match s with + | Inputs _ -> "input images" + | Texts _ -> "texts to apply to input images" + | Output _ -> "directory to place output images" + | Config _ -> "configuration file location (default: config.toml)" + | Format _ -> "output image format (file extension; by default reuse format of input image)" + +type TextOption = + | Font of string + | FontSize of uint + | MaxWidth of uint + | Color of string + | Background of string + +let generateImage + (input : string) + (text : string) + (options : TextOption list) + (output : string) + = + let args = + [ input ] + @ (options + |> List.map (fun o -> + match o with + | Font font -> "font", font + | FontSize ps -> "pointsize", string(ps) + | MaxWidth w -> "size", string(w) + | Color color -> "fill", color + | Background bg -> "undercolor", bg + ) + |> List.map (fun (param, value) -> [ sprintf "-%s" param; value ]) + |> List.concat) + @ [ "-background"; "transparent" ] + @ [ "-gravity"; "center" ] + @ [ "caption:@-" ] + @ [ "-composite" ] + @ [ output ] + printf "%s" (sprintf "magick %s\n" (args |> String.concat " ")) // There's a race for stdout + let startInfo = + ProcessStartInfo("magick", args, + RedirectStandardInput = true, + UseShellExecute = false, + CreateNoWindow = true + ) + use p = Process.Start(startInfo) + + text.Split('\n') + |> Array.map (fun s -> + match s.Trim() with + | "" -> "" + | s -> " " + s + " " + ) + |> fun parts -> String.Join('\n', parts) + |> p.StandardInput.Write + p.StandardInput.Close() + p.WaitForExit() + +let parser = ArgumentParser.Create<Argument>() +let results = + try + parser.ParseCommandLine(Environment.GetCommandLineArgs() |> Array.skip 2) + with + | :? ArguParseException as exn -> + printfn "%s" exn.Message + exit 1 + +let inputs = + results.GetResults(Inputs) + |> List.reduce (fun a b -> List.append a b) + +let texts = + results.GetResults(Texts) + |> List.reduce (fun a b -> List.append a b) + +let output = results.GetResult(Output) + +let configFile = results.TryGetResult(Config) |> Option.defaultValue "config.toml" + +let format = results.TryGetResult(Format) + +let readConfig file : TextOption list * Map<string, TextOption list> = + let parseSection (defaults : Map<string, TextOption> option) (table : TomlTable) : Map<string, TextOption> * string list = + let values = defaultArg defaults (Map []) + + ((values, []), table.RawTable |> Seq.filter (fun kvp -> not kvp.Value.IsTable)) + ||> Seq.fold (fun (values, errors) kvp -> + let key, value = kvp.Key, kvp.Value + + let str f = + if value.IsString then + values.Add(key, (f value.AsString.Value)), errors + else + values, [ sprintf "'%s' must be string" key ] @ errors + let uint f = + if value.IsInteger then + let i = value.AsInteger.Value + if i >= 0 then + values.Add(key, f ((uint)i)), errors + else + values, [ sprintf "'%s' must be positive integer" key ] @ errors + else + values, [ sprintf "'%s' must be positive integer" key ] @ errors + + let key = kvp.Key + match key with + | "font" -> str (fun s -> Font s) + | "font_size" -> uint (fun i -> FontSize i) + | "max_width" -> uint (fun i -> MaxWidth i) + | "color" -> str (fun s -> Color s) + | "background" -> str (fun s -> Background s) + | k -> values, [ sprintf "unrecognized key '%s'" k ] @ errors + ) + + let convert (s : Map<string, TextOption>) : TextOption list = + s + |> Seq.map (fun x -> x.Value) + |> Seq.rev + |> List.ofSeq + + let toml = + try + use reader = File.OpenText(file) + TOML.Parse(reader) + with + | :? FileNotFoundException -> + printfn "config file %s not found" file + exit 1 + | :? TomlParseException as ex -> + for se in ex.SyntaxErrors do + printfn "%s:%d:%d: %s" file se.Line se.Column se.Message + exit 1 + + let def : Map<string, TextOption> = + match parseSection None toml with + | def, [] -> def + | _, errors -> + for error in errors do + printfn "%s: failed to parse default configuration: %s" file error + exit 1 + + let images = + (([], []), toml.RawTable |> Seq.filter (fun kvp -> kvp.Value.IsTable)) + ||> Seq.fold (fun state kvp -> + match parseSection (Some def) kvp.Value.AsTable with + | values, [] -> [ (kvp.Key, values) ] @ fst state, snd state + | _, errors -> fst state, [ (kvp.Key, errors) ] @ snd state + ) + |> function + | images, [] -> + Seq.map (fun (section, values) -> section, convert values) images |> Map + | _, errors -> + for (section, errors) in errors do + for error in errors do + printfn "%s: failed to parse section %s: %s" file section error + exit 1 + + convert def, images + +let defaultConfig, imageConfigs = readConfig configFile + +match List.filter (fun i -> not (File.Exists i)) inputs with +| [] -> () +| notFound -> + for f in notFound do + printfn "input file '%s' not found" f + exit 1 + +match List.filter (fun t -> not (File.Exists t)) texts with +| [] -> () +| notFound -> + for f in notFound do + printfn "text source '%s' not found" f + exit 1 + +try + Directory.CreateDirectory(output) |> ignore +with + | ex -> + printfn "failed to create output directory '%s': %s" output ex.Message + exit 1 + +let taggedTexts = + texts + |> List.map (fun t -> + Path.GetFileName(t), File.ReadAllText(t) + ) + +Parallel.ForEach( + (inputs |> List.map (fun i -> taggedTexts |> List.map (fun t -> i, t)) |> List.concat), + (fun (input : string, (tag, text)) -> + let name = Path.GetFileNameWithoutExtension(input) + let options = + imageConfigs.TryFind(name) + |> Option.defaultValue defaultConfig + let format = format |> Option.defaultValue (Path.GetExtension(input)) + let output = sprintf "%s/%s-%s%s" output name (tag) format + + generateImage input text options output + )) +|> ignore |