1 #(set-global-staff-size 16)
5 ;; some helper functions
7 (define (filter-out pred lst)
8 (filter (lambda (x) (not (pred x))) lst))
10 (define (filter-out-group glyph-list substring)
11 (filter-out (lambda (x) (string-contains x substring)) glyph-list))
13 (define (filter-out-groups glyph-list . substrings)
14 (let loop ((new glyph-list) (rem substrings))
17 (loop (filter-out-group new (car rem))
20 (define (get-group glyph-list substring)
21 (filter (lambda (x) (string-contains x substring)) glyph-list))
25 (ly:otf-glyph-list (ly:system-font-load "emmentaler-20"))))
29 ;; define these 3 groups first since they're
30 ;; harder to get with (get-groups ...)
32 '("plus" "comma" "hyphen" "period"
33 "zero" "one" "two" "three" "four"
34 "five" "six" "seven" "eight" "nine"))
36 (define default-noteheads
37 '("noteheads.uM2" "noteheads.dM2" "noteheads.sM1"
38 "noteheads.s0" "noteheads.s1" "noteheads.s2"))
41 '("space" "f" "m" "p" "r" "s" "z"))
43 ;; remove them from the glyph-list
45 (lambda (x) (set! glyph-list (delete x glyph-list)))
52 ;; extract ancient-music groups before extracting default
53 ;; accidentals, rests, etc. to prevent duplication.
54 (define vaticana (get-group glyph-list "vaticana"))
55 (define medicaea (get-group glyph-list "medicaea"))
56 (define hufnagel (get-group glyph-list "hufnagel"))
57 (define neomensural (get-group glyph-list "neomensural"))
59 ;; remove neomensural before defining mensural; otherwise, searching
60 ;; for "mensural" would return "neomensural" matches too.
69 ;; get the rest of the ancient-music groups
70 (define mensural (get-group glyph-list "mensural"))
71 (define petrucci (get-group glyph-list "petrucci"))
72 (define solesmes (get-group glyph-list "solesmes"))
74 ;; remove them from the glyph-list
82 ;; This would only get "rests.2classical".
83 ;; We're leaving it with the other rests for now.
84 ;; (define classical (get-group glyph-list "classical"))
85 ;; (set! glyph-list (filter-out-groups glyph-list "classical"))
89 ;; get everything else except noteheads.
90 ;; * Some accidentals contain "slash" substring, so extract
91 ;; "accidentals" before extracting "slash" (noteheads).
92 ;; * Also use "pedal." not "pedal", for example, to prevent things
93 ;; like "scripts.upedalheel" ending up in the "pedal." list.
94 ;; * This doesn't apply to the ancient stuff because searching for
95 ;; "vaticana." (as an example) would miss things like
97 (define clefs (get-group glyph-list "clefs."))
98 (define timesig (get-group glyph-list "timesig."))
99 (define accidentals (get-group glyph-list "accidentals."))
100 (define rests (get-group glyph-list "rests."))
101 (define flags (get-group glyph-list "flags."))
102 (define dots (get-group glyph-list "dots."))
103 (define scripts (get-group glyph-list "scripts."))
104 (define arrowheads (get-group glyph-list "arrowheads."))
105 (define brackettips (get-group glyph-list "brackettips."))
106 (define pedal (get-group glyph-list "pedal."))
107 (define accordion (get-group glyph-list "accordion."))
109 ;; remove them from the glyph-list
127 ;; get special noteheads
128 (define cross (get-group glyph-list "cross"))
129 (define diamond (get-group glyph-list "diamond"))
130 (define harmonic (get-group glyph-list "harmonic"))
131 (define slash (get-group glyph-list "slash"))
132 (define triangle (get-group glyph-list "triangle"))
133 (define xcircle (get-group glyph-list "xcircle"))
135 (define special-noteheads
143 ;; remove special noteheads from the glyph-list
155 ;; any remaining glyphs containing "noteheads." should be shape-notes.
156 (define shape-note-noteheads (get-group glyph-list "noteheads."))
158 ;; remove shape-note-noteheads from the glyph-list
159 (set! glyph-list (filter-out-group glyph-list "noteheads."))
163 ;; simple debug test for any glyphs that didn't make it.
165 (if (null? glyph-list)
166 (format #t "No glyphs are missing from the table.\n")
167 (format #t "You missed these glyphs: ~a\n" glyph-list)))
169 ) % end of (begin ...)
172 %% ugh. text on toplevel is a bit broken...
174 oddHeaderMarkup = \markup {}
175 evenHeaderMarkup = \markup {}
176 oddFooterMarkup = \markup {}
177 evenFooterMarkup = \markup {}
182 #(define-markup-command (doc-char layout props name) (string?)
183 (interpret-markup layout props
184 (let* ((n (string-length name)))
186 ;; split long glyph names near the middle at dots
187 (let* ((middle-pos (round (/ n 2)))
188 (left-dot-pos (string-rindex name #\. 0 middle-pos))
189 (right-dot-pos (string-index name #\. middle-pos))
190 (left-distance (if (number? left-dot-pos)
191 (- middle-pos left-dot-pos)
193 (right-distance (if (number? right-dot-pos)
194 (- right-dot-pos middle-pos)
196 (split-pos (if (> left-distance right-distance)
199 (left (substring name 0 split-pos))
200 (right (substring name split-pos)))
202 #:pad-to-box '(0 . 36) '(-2 . 2) #:column (#:typewriter left
203 #:typewriter #:concat (" " right))
204 #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name))
206 #:pad-to-box '(0 . 36) '(-2 . 2) #:typewriter name
207 #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name)))))
209 #(define-markup-list-command (doc-chars layout props names) (list?)
210 (define (min-length lst n)
211 "(min (length lst) n)"
212 (if (or (null? lst) (<= n 0))
214 (1+ (min-length (cdr lst) (1- n)))))
215 (define (doc-chars-aux names acc)
216 (let* ((n (min-length names 2))
217 (head (take names n))
218 (tail (drop names n)))
222 (cons (make-line-markup (map make-doc-char-markup head))
224 (interpret-markup-list layout props (doc-chars-aux names (list))))