1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
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
|
