1 #(set-global-staff-size 16)
5 ;; some helper functions
7 (use-modules (ice-9 regex))
11 (ly:otf-glyph-list (ly:system-font-load "emmentaler-20"))))
13 (define (get-group glyph-list regexp)
14 (let ((r (make-regexp regexp)))
15 (filter (lambda (token) (regexp-exec r token))
20 ;; extract ancient-music groups before extracting default
21 ;; accidentals, rests, etc. to prevent duplication
23 ;; make sure "mensural" regexp doesn't match "neomensural"
24 (define neomensural (get-group glyph-list "^.*neomensural.*$"))
26 (filter (lambda (x) (not (member x neomensural)))
27 (get-group glyph-list "^.*mensural.*$")))
29 ;; get the rest of the ancient-music groups
30 (define vaticana (get-group glyph-list "^.*vaticana.*$"))
31 (define medicaea (get-group glyph-list "^.*medicaea.*$"))
32 (define hufnagel (get-group glyph-list "^.*hufnagel.*$"))
33 (define petrucci (get-group glyph-list "^.*petrucci.*$"))
34 (define solesmes (get-group glyph-list "^.*solesmes.*$"))
35 (define kievan (get-group glyph-list "^.*kievan.*$"))
37 ;; remove ancient-music groups from the glyph-list
39 (lambda (x) (set! glyph-list (delete x glyph-list)))
49 ;; define all remaining groups
51 '("plus" "comma" "hyphen" "period"
52 "zero" "one" "two" "three" "four"
53 "five" "six" "seven" "eight" "nine"))
56 '("space" "f" "m" "p" "r" "s" "z"))
58 (define default-noteheads
60 "^noteheads.[dsu]M?[012]$"))
62 (define special-noteheads
64 "^noteheads.[dsu]M?[012](double|harmonic|diamond|cross|xcircle|triangle|slash)$"))
66 (define shape-note-noteheads
68 "^noteheads.[dsu][012](do|re|mi|fa|sol|la|ti)(Thin|Mirror|Funk|Walker)*$"))
70 (define clefs (get-group glyph-list "^clefs\\."))
71 (define timesig (get-group glyph-list "^timesig\\."))
72 (define accidentals (get-group glyph-list "^accidentals\\."))
73 (define rests (get-group glyph-list "^rests\\."))
74 (define flags (get-group glyph-list "^flags\\."))
75 (define dots (get-group glyph-list "^dots\\."))
76 (define scripts (get-group glyph-list "^scripts\\."))
77 (define arrowheads (get-group glyph-list "^arrowheads\\."))
78 (define brackettips (get-group glyph-list "^brackettips\\."))
79 (define pedal (get-group glyph-list "^pedal\\."))
80 (define accordion (get-group glyph-list "^accordion\\."))
81 (define ties (get-group glyph-list "^ties\\."))
83 ;; remove all remaining groups from the glyph-list
85 (lambda (x) (set! glyph-list (delete x glyph-list)))
106 ;; require all glyphs to appear here
107 (if (pair? glyph-list) ; glyph-list should be empty by now
109 (_ "Unlisted glyphs in Documentation/included/font-table.ly: ~A")
112 ) % end of (begin ...)
115 %% ugh. text on toplevel is a bit broken...
117 oddHeaderMarkup = \markup {}
118 evenHeaderMarkup = \markup {}
119 oddFooterMarkup = \markup {}
120 evenFooterMarkup = \markup {}
125 #(define-markup-command (doc-char layout props name) (string?)
126 (interpret-markup layout props
127 (let* ((n (string-length name)))
129 ;; split long glyph names near the middle at dots
130 (let* ((middle-pos (round (/ n 2)))
131 (left-dot-pos (string-rindex name #\. 0 middle-pos))
132 (right-dot-pos (string-index name #\. middle-pos))
133 (left-distance (if (number? left-dot-pos)
134 (- middle-pos left-dot-pos)
136 (right-distance (if (number? right-dot-pos)
137 (- right-dot-pos middle-pos)
139 (split-pos (if (> left-distance right-distance)
142 (left (substring name 0 split-pos))
143 (right (substring name split-pos)))
145 #:pad-to-box '(0 . 36) '(-2 . 2) #:column (#:typewriter left
146 #:typewriter #:concat (" " right))
147 #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name))
149 #:pad-to-box '(0 . 36) '(-2 . 2) #:typewriter name
150 #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name)))))
152 #(define-markup-list-command (doc-chars layout props names) (list?)
153 (define (min-length lst n)
154 "(min (length lst) n)"
155 (if (or (null? lst) (<= n 0))
157 (1+ (min-length (cdr lst) (1- n)))))
158 (define (doc-chars-aux names acc)
159 (let* ((n (min-length names 2))
160 (head (take names n))
161 (tail (drop names n)))
165 (cons (make-line-markup (map make-doc-char-markup head))
167 (interpret-markup-list layout props (doc-chars-aux names (list))))