1\header {
2
3  texidoc = "External fonts may be used without being installed on the
4operating system, by loading either a specific font file or a directory
5that contains font files.  In this example two logos should be printed,
6rather than a letter glyph."
7
8}
9
10\version "2.18.0"
11
12%% Create dummy font files in tmp dir (and subdir).
13
14%% Temporarily disable font-export.
15
16#(define previous-export-dir (ly:get-option 'font-export-dir))
17
18#(ly:set-option 'font-export-dir #f)
19
20
21%% tmpnam is deprecated.  We could get away with using mkstemp! only,
22%% but since there’s no mkdtemp in Guile, we need to fiddle with
23%% filename strings anyway:
24
25tmpdir = #(or (getenv "TMPDIR") "/tmp")
26
27dummyname = #(port-filename (mkstemp! (string-append tmpdir "/" "dummyfont-XXXXXX")))
28
29dummyfontfile = #(string-append dummyname "-font.otf")
30dummyfontdir = #(string-append dummyname "-dir")
31dummyfontfileInSubdir = #(string-append dummyfontdir "/" "font.otf")
32
33dummyfont = "
34T1RUTwAKAIAAAwAgQ0ZGIE5UIR0AAAUAAAAD2kZGVE2PvFSrAAAI3AAAABxPUy8yV+hiwAAAARAA
35AABgY21hcAANAugAAAOcAAABQmhlYWQaNWE/AAAArAAAADZoaGVhCBUFxAAAAOQAAAAkaG10eAm0
36AGMAAAj4AAAACG1heHAAAlAAAAABCAAAAAZuYW1lH80HAQAAAXAAAAIrcG9zdP+4ADIAAATgAAAA
37IAABAAAAAQAAnX06cV8PPPUACwPoAAAAANqmcOcAAAAA2qetQwAxAAAFmAIwAAAACAACAAAAAAAA
38AAEAAAIh//UAWgXMAAAAAAWYAAEAAAAAAAAAAAAAAAAAAAACAABQAAACAAAABAXMAZAABQAAAooC
39vAAAAIwCigK8AAAB4AAxAQIAAAIABQkAAAAAAAAAAAABAAAAAAAAAAAAAAAAUGZFZACAAEEAQQMg
40/zgAWgIhAAsAAAABAAAAAAAAAiEAIAAgAAEAAAAOAK4AAQAAAAAAAAA8AHoAAQAAAAAAAQAIAMkA
41AQAAAAAAAgAHAOIAAQAAAAAAAwAcASQAAQAAAAAABAAAAUMAAQAAAAAABQAJAVgAAQAAAAAABgAI
42AXQAAwABBAkAAAB4AAAAAwABBAkAAQAQALcAAwABBAkAAgAOANIAAwABBAkAAwA4AOoAAwABBAkA
43BAAAAUEAAwABBAkABQASAUQAAwABBAkABgAQAWIAUAB1AGIAbABpAGMAIABkAG8AbQBhAGkAbgAs
44ACAAYQBmAHQAZQByACAAdABoAGUAIABGAHIAZQBlACAAUwBvAGYAdAB3AGEAcgBlACAARgBvAHUA
45bgBkAGEAdABpAG8AbgAgACgAZwBuAHUALgBvAHIAZwApAC4AAFB1YmxpYyBkb21haW4sIGFmdGVy
46IHRoZSBGcmVlIFNvZnR3YXJlIEZvdW5kYXRpb24gKGdudS5vcmcpLgAARAB1AG0AbQB5AEcAUABM
47AABEdW1teUdQTAAAUgBlAGcAdQBsAGEAcgAAUmVndWxhcgAARgBvAG4AdABGAG8AcgBnAGUAIAAy
48AC4AMAAgADoAIAAgADoAIAAzADAALQAzAC0AMgAwADIAMAAARm9udEZvcmdlIDIuMCA6ICA6IDMw
49LTMtMjAyMAAAAAAAVgBlAHIAcwBpAG8AbgAgACAAAFZlcnNpb24gIAAARAB1AG0AbQB5AEcAUABM
50AABEdW1teUdQTAAAAAAAAwAAAAMAAAAcAAEAAAAAADwAAwABAAAAHAAEACAAAAAEAAQAAQAAAEH/
51/wAAAEH////AAAEAAAAAAAABBgAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
52AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
53AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
54AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
55AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMAAAAA
56AAD/tQAyAAAAAAAAAAAAAAAAAAAAAAAAAAABAAQEAAEBAQlEdW1teUdQTAABAgABACv4GwD4HAH4
57HQL4HgP4HwS8ixwFmPjEBRwAlw8cAAAQHACaERwAIRwDuRIABQIAAQABAD0APQBFAEVQdWJsaWMg
58ZG9tYWluLCBhZnRlciB0aGUgRnJlZSBTb2Z0d2FyZSBGb3VuZGF0aW9uIChnbnUub3JnKS5EdW1t
59eUdQTAAAAAAiAAICAAEAFgMXvRb6GPip/hgGvfx3FfhF+bT8RQcO9vlR9xMViweFi4WHiYaNkJCP
60kYsI/Kj4LxVj+0Fk+0Bj+0EI+dYGdY12knmYdZyCo4umi6CRopOgm7KirqWst8G/usSzy7jPsNyg
61CER0SmVPX1lmXWBmWHp0fXKDb4mCioOLgwhesnm5HpkGrI6rlKqWvp68preqm5eblpebj5COkYyS
62CIyMBZZ9jIAeiAZ5inmHeoZwg3CAcX+kpKifqZ6ooaejoamSlZKWjJgIjAeVgo6AHoCLfYiEiVp9
63YG9kcazMyLrMqqaXp5WojgiFi4GLBYeL/AqL+/qL+y+LIIsF+F38LRV3zoDVi9OL0ZbPosSLhIqE
64i4SLYpFjk2OUXJhdm11xZnVjhVkI/Lz3uhWgi8eLBZ6LnYqei5OKk4iQhIyJjImLiIuHioiKhwiH
65d4Z4h3cIXosFms37BIsFeTl5N3k5CPcDBpKtk6ySrQhXBo2TjJKNkwjsBoJhgl+BYYN2boxyiwiB
66i1SLBXqLe4t6jIGMf5CLl4uNi46MjZ3end6e3pCZnJGciwj3WRaliwXVBqKLoYqii5OKk4iQhIyJ
67jImLiIuHioeKiIJggmGBYIN2bIxyiwhxi1OLgYsFgmSDZIJkCF8Goe2g7qHtCPdwFrYGdzF3MHcx
68CPMGjIONg4yDCPsxBqHtoe6h7Qj7SXQVgWCCXoFgCPcAi6j3FwX3GPulFYsHj4+Ihx+Li4uMBY+H
69jYce6lkVl2axd7iLCI6LkYsFm4uZjJqOuZO4m7WfwaS9rLqvurC9t6bDkJWPmIuWi5aGloCPCIOO
70fIuLlIuMjIqLjI2WkYyMi6ikqaacr5CVjZaLlgiSB4eidJRxiwiHBmWKYX1ufYqKiYuKi4aLiJCL
71j4uOjY2OjQirmrWatIwIkQaYi5qJl4WfgpN4i3aLf4l9hX+Ac3t2eXmHh3R2i4kIiweehJN6i3mL
72fYZ8hX58a3VwcnJNTj5VOWRgd115W4N7iHuKe4sIhYuHiwV0i3KQdpd3ln2fhKCLjIqLi4yLkJCO
73j4uOi4+KjIcIDvp8FBwFYRV3n/i1iwaLDAqLjJuQp5PElPAMDJsLm5cMDQAAAAAAAQAAAADabjaA
74AAAAANqmcOcAAAAA2qetQwPoADIFzAAx"
75
76dummyfontAlt = "
77T1RUTwAKAIAAAwAgQ0ZGIH4FALoAAAVEAAAEUEZGVE2PvFQcAAAJlAAAABxPUy8yWBlixAAAARAA
78AABgY21hcAANAugAAAPgAAABQmhlYWQaBGDXAAAArAAAADZoaGVhCBsFlwAAAOQAAAAkaG10eAsu
79AHcAAAmwAAAACG1heHAAAlAAAAABCAAAAAZuYW1li6hnNgAAAXAAAAJwcG9zdP+4ADMAAAUkAAAA
80IAABAAAAAQAAY2S57F8PPPUACwPoAAAAANqmcOcAAAAA2qestAAy//wFZQJbAAAACAACAAAAAAAA
81AAEAAAJa//0AWgWXAAAAAAVlAAEAAAAAAAAAAAAAAAAAAAACAABQAAACAAAABAWXAZAABQAAAooC
82vAAAAIwCigK8AAAB4AAxAQIAAAIABQkAAAAAAAAAAAABAAAAAAAAAAAAAAAAUGZFZACAAEEAQQMg
83/zgAWgJaAAMAAAABAAAAAAAAAloAIAAgAAEAAAAOAK4AAQAAAAAAAABRAKQAAQAAAAAAAQAJAQoA
84AQAAAAAAAgAHASQAAQAAAAAAAwAcAWYAAQAAAAAABAAAAYUAAQAAAAAABQAJAZoAAQAAAAAABgAJ
85AbgAAwABBAkAAACiAAAAAwABBAkAAQASAPYAAwABBAkAAgAOARQAAwABBAkAAwA4ASwAAwABBAkA
86BAAAAYMAAwABBAkABQASAYYAAwABBAkABgASAaQAKABjACkAIAAyADAAMAA3ACAARgByAGUAZQAg
87AFMAbwBmAHQAdwBhAHIAZQAgAEYAbwB1AG4AZABhAHQAaQBvAG4AIAAoAGcAbgB1AC4AbwByAGcA
88KQAuAAoARwBOAFUAIABGAHIAZQBlACAARABvAGMAdQBtAGUAbgB0AGEAdABpAG8AbgAgAEwAaQBj
89AGUAbgBzAGUAIAB2ADEALgAzAC4AAChjKSAyMDA3IEZyZWUgU29mdHdhcmUgRm91bmRhdGlvbiAo
90Z251Lm9yZykuCkdOVSBGcmVlIERvY3VtZW50YXRpb24gTGljZW5zZSB2MS4zLgAARAB1AG0AbQB5
91AEcARgBEAEwAAER1bW15R0ZETAAAUgBlAGcAdQBsAGEAcgAAUmVndWxhcgAARgBvAG4AdABGAG8A
92cgBnAGUAIAAyAC4AMAAgADoAIAAgADoAIAAzADAALQAzAC0AMgAwADIAMAAARm9udEZvcmdlIDIu
93MCA6ICA6IDMwLTMtMjAyMAAAAAAAVgBlAHIAcwBpAG8AbgAgACAAAFZlcnNpb24gIAAARAB1AG0A
94bQB5AEcARgBEAEwAAER1bW15R0ZETAAAAAADAAAAAwAAABwAAQAAAAAAPAADAAEAAAAcAAQAIAAA
95AAQABAABAAAAQf//AAAAQf///8AAAQAAAAAAAAEGAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
96AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAA
97AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
98AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
99AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
100AAAAAAAAAwAAAAAAAP+1ADIAAAABAAAAAAAAAAAAAAAAAAAAAAEABAQAAQEBCkR1bW15R0ZETAAB
101AgABAC74GwD4HAH4HQL4HgP4HwSMDAG9hxwFZfjvBRwAsQ8cAAAQHAC0ERwALBwEJBIABQIAAQAB
102AFIAUgBbAFsoYykgMjAwNyBGcmVlIFNvZnR3YXJlIEZvdW5kYXRpb24gKGdudS5vcmcpLgpHTlUg
103RnJlZSBEb2N1bWVudGF0aW9uIExpY2Vuc2UgdjEuMy5EdW1teUdGREwAAAAAIgACAgABABkDaL0W
104HAUz+Kkc+s0Gvfx3FfhFHATP/EUHDvpqthX+JYup96sFgeiB6YHoCPrpg/7gBpUwlDGVMIEwgjKB
105MAj6HAb9GPeEFXOKgYqDi4OLg4xzjAiLdpqKBZeKj4eLfghIB32BgYh/iwhebczr5Ka/uR+li55+
106l3YIjV+WiwWOu4uVjp4IiZEFcZx3kXCLCENfSfsB+wO3Q80fp4ugk62iCN0Hi5iMjJWPCNj3bxWD
107i4uLW40Ii3iXiQWaiYuJi14I+2EHi2yKhImHiYiJiYOKCH+Ji3cFpoyXjJaLlouXiqmKCIuffI0F
108g4yHjYqPiZCKk4unCOkHk4ySi5KLCJwGmIuPh4x9CI1ymIuKwQWLkYuSjLIIfouJcAWKgoiJfYsI
109egZ/i4eMhYwI9w4HoI2QipaLCKKZiIUfjmWXi4/TiY4Ff42Fi36LhItTiX6LCPd9++sVq4upoZ+w
110na2Wt4vBCOB40D8eZooFcIuLiomLh4uLi2ONCIt4lYkFl4mMiYteCPt1B4t5ioWHhgiCggV/B6OM
111loyTiwiWi56Jl4sIfacVhIuGjISNCPeyB5GNkIuSi56LoIWWgaZykmWLTIs5fkhEiwj3lG8VnYuU
112i52NCIyPBZDefosFg1gFi4uKih6BhYKKeYt+i32Le4wI94gHi6mMk42PjY6OjZOMCJeMi6AFZImM
113i3+LgIuKi2WNCIt2l4oFmomLi4tdCPt1B4t6ioSGhgiAgot/BaGMlYyTi6CLrYmdiwj4aTkVYC9u
114IyMwqLYe+GCT/GAHa9tr9vbcq6sei46Kj4mOi/czjvcfi/csCJMGjgRgL24jIzCotrbmqPPz525g
115HoMWqzqrICA7a2tr22v29tyrqx6SSRWH/AUFioqKix56dkh5PotSi06VWqSKjIqMi4wIjIyLix7i
1169xo390mLjAWNjIyNHowGtH7BgcCL14vVn6LDjIyLjIyLCI2NiokfhH4VbVlGeUOLWItXlGKXCN37
117RIuKi4k0+xgFunTGgsGL1YvOm5ueCJL4BBVzUUF3PotVi1SVYpgI4PtKMvsbBbtyyIHDi9eLz52b
118nwj7NfhVFX6LfYx7iwhYUoiCH4sHfuCExh69ypqWH4sHnEOxQh6RB9PaZ3Ifiwd2Q4BcVSuNox6L
119B5u/jrseoYugi5qKCA4cBZcUixV3n/jviwaNDAqTCo6OjZWNjI+NjPe5DAy4C5GNjYyMj6GMjI0M
120DQAAAAEAAAAA2m42gAAAAADapnDnAAAAANqnrLQFlwAyBZcARQ==
121"
122
123% TODO: this should be rewritten (e.g. using rnrs bytevectors, see base64
124% implementations in guile-gnome and guile-gcrypt) as soon as
125% compatibility with Guile v1.8 is no longer needed. -vv
126
127#(define (base64-decode out-port input)
128  (let ((base64-decode-table (make-hash-table 64))
129        (alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
130        (in-port (if (string? input)
131                  (open-input-string input)
132                  input))
133        (current-state 1)
134        (current-char '())
135        (byte #f)
136        (top-bits '())
137        (bottom-bits '()))
138    (map (lambda (item)
139       (hash-set! base64-decode-table item
140        (string-index alphabet item)))
141     (string->list alphabet))
142    ;; inspired by https://sourceware.org/legacy-ml/guile/2000-01/msg00622.html
143    ;; looks clunky but gets the job done.
144    (while
145     (not (eof-object? current-char))
146     (set! current-char (read-char in-port))
147     (case current-state
148       ((1) (begin
149             (set! byte
150              (hashv-ref base64-decode-table current-char))
151             (if byte
152              (begin
153               (set! top-bits
154                (* (logand byte #b00111111) 4))))))
155       ((2) (if (eof-object? current-char)
156             (begin
157              (set! bottom-bits #b00000000)
158              (write-char (integer->char
159                (logior top-bits bottom-bits))
160               out-port))
161             (begin
162              (set! byte
163               (hashv-ref base64-decode-table current-char))
164              (if byte
165                  (begin
166                   (set! bottom-bits
167                    (/ (logand byte #b00110000) 16))
168                   (write-char (integer->char
169                     (logior top-bits bottom-bits))
170                    out-port)
171                   (set! top-bits
172                    (* (logand byte #b00001111) 16)))))))
173       ((3) (if (eof-object? current-char)
174             (begin
175              (set! bottom-bits #b00000000)
176              (write-char (integer->char
177                (logior top-bits bottom-bits))
178               out-port))
179             (begin
180              (set! byte
181               (hashv-ref base64-decode-table current-char))
182              (if byte
183               (begin
184                (set! bottom-bits
185                 (/ (logand byte #b00111100) 4))
186                (write-char (integer->char
187                  (logior top-bits bottom-bits))
188                 out-port)
189                (set! top-bits
190                 (* (logand byte #b00000011) 64)))))))
191       ((4) (if (eof-object? current-char)
192             (begin
193              (set! bottom-bits #b00000000)
194              (write-char (integer->char
195                (logior top-bits bottom-bits))
196               out-port))
197             (begin
198              (set! byte
199               (hashv-ref base64-decode-table current-char))
200              (if byte
201               (begin
202                (set! bottom-bits
203                 (logand byte #b00111111))
204                (write-char (integer->char
205                  (logior top-bits bottom-bits))
206                 out-port)))))))
207     (if byte
208      (begin
209       (if (eqv? current-state 4)
210           (set! current-state 1)
211           (set! current-state (1+ current-state)))
212       (set! byte #f))))
213    #t))
214
215\header { tagline = #f }
216
217%% Write minimal OTF files.
218
219\book {
220
221#(let* ((port (open-output-file dummyfontfile)))
222  (cond-expand
223    (guile-2 (set-port-encoding! port "ISO-8859-1"))
224    (else))
225  (base64-decode port dummyfont)
226  (close port))
227
228#(ly:font-config-add-font dummyfontfile)
229
230\markup \fontsize #20 \override #'(font-name . "DummyGPL") "A"
231
232#(mkdir dummyfontdir)
233
234#(let* ((port (open-output-file dummyfontfileInSubdir)))
235   (base64-decode port dummyfontAlt)
236   (close port))
237
238#(ly:font-config-add-directory dummyfontdir)
239
240\markup \fontsize #20 \override #'(font-name . "DummyGFDL") "A"
241}
242
243%% This will not appear in collated files:
244
245\book {
246  #(delete-file dummyname)
247  #(delete-file dummyfontfile)
248  %% Cleaning up the whole directory content,
249  %% in case fontconfig or anything else
250  %% may have left behind unwanted files.
251  #(let ((dir (opendir dummyfontdir)))
252     (do ((f (readdir dir) (readdir dir)))
253       ((eof-object? f))
254       (or (equal? "." f) (equal? ".." f)
255           (delete-file (string-append dummyfontdir "/" f)))))
256  #(rmdir dummyfontdir)
257  \markup { These files and directories should have been removed:}
258  \markup \left-column {
259    \line {- #dummyfontfile }
260    \line {- #dummyfontfileInSubdir }
261    \line {- #dummyfontdir }
262  }
263}
264
265#(ly:set-option 'font-export-dir previous-export-dir)
266