]> git.donarmstrong.com Git - lilypond.git/blob - Documentation/included/font-table.ly
Doc-it: fix the wrong committishes (bad object) in .texidoc files
[lilypond.git] / Documentation / included / font-table.ly
1 #(set-global-staff-size 16)
2
3 #(begin
4
5   ;; some helper functions
6
7   (use-modules (ice-9 regex))
8
9   (define glyph-list
10     (delete ".notdef"
11             (ly:otf-glyph-list (ly:system-font-load "emmentaler-20"))))
12
13   (define (get-group glyph-list regexp)
14     (let ((r (make-regexp regexp)))
15       (filter (lambda (token) (regexp-exec r token))
16               glyph-list)))
17
18   ;;;;;;;;;
19
20   ;; extract ancient-music groups before extracting default
21   ;; accidentals, rests, etc. to prevent duplication
22
23   ;; make sure "mensural" regexp doesn't match "neomensural"
24   (define neomensural (get-group glyph-list "^.*neomensural.*$"))
25   (define mensural
26     (filter (lambda (x) (not (member x neomensural)))
27             (get-group glyph-list "^.*mensural.*$")))
28
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
36   ;; remove ancient-music groups from the glyph-list
37   (for-each
38     (lambda (x) (set! glyph-list (delete x glyph-list)))
39     (append vaticana
40             medicaea
41             hufnagel
42             mensural
43             neomensural
44             petrucci
45             solesmes))
46
47   ;; define all remaining groups
48   (define numbers
49     '("plus" "comma" "hyphen" "period"
50       "zero" "one"   "two"    "three"  "four"
51       "five" "six"   "seven"  "eight"  "nine"))
52
53   (define dynamics
54     '("space" "f" "m" "p" "r" "s" "z"))
55
56   (define default-noteheads
57     (get-group glyph-list
58       "^noteheads.[dsu]M?[012]$"))
59
60   (define special-noteheads
61     (get-group glyph-list
62       "^noteheads.[dsu]M?[012](double|harmonic|diamond|cross|xcircle|triangle|slash)$"))
63
64   (define shape-note-noteheads
65     (get-group glyph-list
66       "^noteheads.[dsu][012](do|re|mi|fa|sol|la|ti)(Thin|Mirror|Funk|Walker)*$"))
67
68   (define clefs       (get-group glyph-list "^clefs\\."))
69   (define timesig     (get-group glyph-list "^timesig\\."))
70   (define accidentals (get-group glyph-list "^accidentals\\."))
71   (define rests       (get-group glyph-list "^rests\\."))
72   (define flags       (get-group glyph-list "^flags\\."))
73   (define dots        (get-group glyph-list "^dots\\."))
74   (define scripts     (get-group glyph-list "^scripts\\."))
75   (define arrowheads  (get-group glyph-list "^arrowheads\\."))
76   (define brackettips (get-group glyph-list "^brackettips\\."))
77   (define pedal       (get-group glyph-list "^pedal\\."))
78   (define accordion   (get-group glyph-list "^accordion\\."))
79   (define ties   (get-group glyph-list "^ties\\."))
80
81   ;; remove all remaining groups from the glyph-list
82   (for-each
83     (lambda (x) (set! glyph-list (delete x glyph-list)))
84     (append numbers
85             dynamics
86             default-noteheads
87             special-noteheads
88             shape-note-noteheads
89             clefs
90             timesig
91             accidentals
92             rests
93             flags
94             dots
95             scripts
96             arrowheads
97             brackettips
98             pedal
99             accordion
100             ties))
101
102   ;;;;;;;;;
103
104   ;; require all glyphs to appear here
105   (if (pair? glyph-list) ; glyph-list should be empty by now
106       (ly:error
107         (_ "Unlisted glyphs in Documentation/included/font-table.ly: ~A")
108         glyph-list))
109
110 ) % end of (begin ...)
111
112 \paper {
113   %% ugh. text on toplevel is a bit broken...
114
115   oddHeaderMarkup = \markup {}
116   evenHeaderMarkup = \markup {}
117   oddFooterMarkup = \markup {}
118   evenFooterMarkup = \markup {}
119   }
120
121 \version "2.14.0"
122
123 #(define-markup-command (doc-char layout props name) (string?)
124   (interpret-markup layout props
125    (let* ((n (string-length name)))
126      (if (> n 24)
127          ;; split long glyph names near the middle at dots
128          (let* ((middle-pos (round (/ n 2)))
129                 (left-dot-pos (string-rindex name #\. 0 middle-pos))
130                 (right-dot-pos (string-index name #\. middle-pos))
131                 (left-distance (if (number? left-dot-pos)
132                                    (- middle-pos left-dot-pos)
133                                    middle-pos))
134                 (right-distance (if (number? right-dot-pos)
135                                     (- right-dot-pos middle-pos)
136                                     middle-pos))
137                 (split-pos (if (> left-distance right-distance)
138                                right-dot-pos
139                                left-dot-pos))
140                 (left (substring name 0 split-pos))
141                 (right (substring name split-pos)))
142            (markup
143              #:pad-to-box '(0 . 36) '(-2 . 2) #:column (#:typewriter left
144                                                         #:typewriter #:concat ("  " right))
145              #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name))
146          (markup
147            #:pad-to-box '(0 . 36) '(-2 . 2) #:typewriter name
148            #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name)))))
149
150 #(define-markup-list-command (doc-chars layout props names) (list?)
151    (define (min-length lst n)
152      "(min       (length lst) n)"
153      (if (or (null? lst) (<= n 0))
154          0
155          (1+ (min-length (cdr lst) (1- n)))))
156    (define (doc-chars-aux names acc)
157      (let* ((n (min-length names 2))
158             (head (take names n))
159             (tail (drop names n)))
160        (if (null? head)
161            (reverse! acc)
162            (doc-chars-aux tail
163                          (cons (make-line-markup (map make-doc-char-markup head))
164                                acc)))))
165    (interpret-markup-list layout props (doc-chars-aux names (list))))