Documentation/included/font-table.ly

   1 #(set-global-staff-size 16)
   2
   3 #(begin
   4
   5   ;; some helper functions
   6
   7   (define (filter-out pred lst)
   8     (filter (lambda (x) (not (pred x))) lst))
   9
  10   (define (filter-out-group glyph-list substring)
  11     (filter-out (lambda (x) (string-contains x substring)) glyph-list))
  12
  13   (define (filter-out-groups glyph-list . substrings)
  14     (let loop ((new glyph-list) (rem substrings))
  15       (if (null? rem)
  16           new
  17           (loop (filter-out-group new (car rem))
  18                 (cdr rem)))))
  19
  20   (define (get-group glyph-list substring)
  21     (filter (lambda (x) (string-contains x substring)) glyph-list))
  22
  23   (define glyph-list
  24     (delete ".notdef"
  25             (ly:otf-glyph-list (ly:system-font-load "emmentaler-20"))))
  26
  27   ;;;;;;;;;
  28
  29   ;; define these 3 groups first since they're
  30   ;; harder to get with (get-group ...)
  31   (define numbers
  32     '("plus" "comma" "hyphen" "period"
  33       "zero" "one"   "two"    "three"  "four"
  34       "five" "six"   "seven"  "eight"  "nine"))
  35
  36   (define default-noteheads
  37     '("noteheads.uM2" "noteheads.dM2"
  38       "noteheads.sM1" "noteheads.sM1double"
  39       "noteheads.s0"
  40       "noteheads.s1"
  41       "noteheads.s2"))
  42
  43   (define dynamics
  44     '("space" "f" "m" "p" "r" "s" "z"))
  45
  46   ;; remove them from the glyph-list
  47   (for-each
  48     (lambda (x) (set! glyph-list (delete x glyph-list)))
  49     (append numbers
  50             default-noteheads
  51             dynamics))
  52
  53   ;;;;;;;;;
  54
  55   ;; extract ancient-music groups before extracting default
  56   ;; accidentals, rests, etc. to prevent duplication.
  57   (define vaticana    (get-group glyph-list "vaticana"))
  58   (define medicaea    (get-group glyph-list "medicaea"))
  59   (define hufnagel    (get-group glyph-list "hufnagel"))
  60   (define neomensural (get-group glyph-list "neomensural"))
  61
  62   ;; remove neomensural before defining mensural; otherwise, searching
  63   ;; for "mensural" would return "neomensural" matches too.
  64   (set! glyph-list
  65     (filter-out-groups
  66       glyph-list
  67       "vaticana"
  68       "medicaea"
  69       "hufnagel"
  70       "neomensural"))
  71
  72   ;; get the rest of the ancient-music groups
  73   (define mensural (get-group glyph-list "mensural"))
  74   (define petrucci (get-group glyph-list "petrucci"))
  75   (define solesmes (get-group glyph-list "solesmes"))
  76
  77   ;; remove them from the glyph-list
  78   (set! glyph-list
  79     (filter-out-groups
  80       glyph-list
  81       "mensural"
  82       "petrucci"
  83       "solesmes"))
  84
  85   ;; This would only get "rests.2classical".
  86   ;; We're leaving it with the other rests for now.
  87   ;; (define classical (get-group glyph-list "classical"))
  88   ;; (set! glyph-list (filter-out-groups glyph-list "classical"))
  89
  90   ;;;;;;;;;
  91
  92   ;; get everything else except noteheads.
  93   ;; * Some accidentals contain "slash" substring, so extract
  94   ;;   "accidentals" before extracting "slash" (noteheads).
  95   ;; * Also use "pedal." not "pedal", for example, to prevent things
  96   ;;   like "scripts.upedalheel" ending up in the "pedal." list.
  97   ;; * This doesn't apply to the ancient stuff because searching for
  98   ;;   "vaticana." (as an example) would miss things like
  99   ;;   "dots.dotvaticana"
 100   (define clefs       (get-group glyph-list "clefs."))
 101   (define timesig     (get-group glyph-list "timesig."))
 102   (define accidentals (get-group glyph-list "accidentals."))
 103   (define rests       (get-group glyph-list "rests."))
 104   (define flags       (get-group glyph-list "flags."))
 105   (define dots        (get-group glyph-list "dots."))
 106   (define scripts     (get-group glyph-list "scripts."))
 107   (define arrowheads  (get-group glyph-list "arrowheads."))
 108   (define brackettips (get-group glyph-list "brackettips."))
 109   (define pedal       (get-group glyph-list "pedal."))
 110   (define accordion   (get-group glyph-list "accordion."))
 111
 112   ;; remove them from the glyph-list
 113   (set! glyph-list
 114     (filter-out-groups
 115       glyph-list
 116       "clefs."
 117       "timesig."
 118       "accidentals."
 119       "rests."
 120       "flags."
 121       "dots."
 122       "scripts."
 123       "arrowheads."
 124       "brackettips."
 125       "pedal."
 126       "accordion."))
 127
 128   ;;;;;;;;;
 129
 130   ;; get special noteheads
 131   (define cross    (get-group glyph-list "cross"))
 132   (define diamond  (get-group glyph-list "diamond"))
 133   (define harmonic (get-group glyph-list "harmonic"))
 134   (define slash    (get-group glyph-list "slash"))
 135   (define triangle (get-group glyph-list "triangle"))
 136   (define xcircle  (get-group glyph-list "xcircle"))
 137
 138   (define special-noteheads
 139     (append cross
 140             diamond
 141             harmonic
 142             slash
 143             triangle
 144             xcircle))
 145
 146   ;; remove special noteheads from the glyph-list
 147   (set! glyph-list
 148     (filter-out-groups
 149       glyph-list
 150       "cross"
 151       "diamond"
 152       "harmonic"
 153       "slash"
 154       "triangle"
 155       "xcircle"))
 156
 157   ;; (lazy solution)
 158   ;; any remaining glyphs containing "noteheads." should be shape-notes.
 159   (define shape-note-noteheads (get-group glyph-list "noteheads."))
 160
 161   ;; remove shape-note-noteheads from the glyph-list
 162   (set! glyph-list (filter-out-group glyph-list "noteheads."))
 163
 164   ;;;;;;;;;
 165
 166   ;; simple debug test for any glyphs that didn't make it.
 167   (if #f
 168     (if (null? glyph-list)
 169         (format #t "No glyphs are missing from the table.\n")
 170         (format #t "You missed these glyphs: ~a\n" glyph-list)))
 171
 172 ) % end of (begin ...)
 173
 174 \paper {
 175   %% ugh. text on toplevel is a bit broken...
 176
 177   oddHeaderMarkup = \markup {}
 178   evenHeaderMarkup = \markup {}
 179   oddFooterMarkup = \markup {}
 180   evenFooterMarkup = \markup {}
 181   }
 182
 183 \version "2.12.0"
 184
 185 #(define-markup-command (doc-char layout props name) (string?)
 186   (interpret-markup layout props
 187    (let* ((n (string-length name)))
 188      (if (> n 24)
 189          ;; split long glyph names near the middle at dots
 190          (let* ((middle-pos (round (/ n 2)))
 191                 (left-dot-pos (string-rindex name #\. 0 middle-pos))
 192                 (right-dot-pos (string-index name #\. middle-pos))
 193                 (left-distance (if (number? left-dot-pos)
 194                                    (- middle-pos left-dot-pos)
 195                                    middle-pos))
 196                 (right-distance (if (number? right-dot-pos)
 197                                     (- right-dot-pos middle-pos)
 198                                     middle-pos))
 199                 (split-pos (if (> left-distance right-distance)
 200                                right-dot-pos
 201                                left-dot-pos))
 202                 (left (substring name 0 split-pos))
 203                 (right (substring name split-pos)))
 204            (markup
 205              #:pad-to-box '(0 . 36) '(-2 . 2) #:column (#:typewriter left
 206                                                         #:typewriter #:concat ("  " right))
 207              #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name))
 208          (markup
 209            #:pad-to-box '(0 . 36) '(-2 . 2) #:typewriter name
 210            #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name)))))
 211
 212 #(define-markup-list-command (doc-chars layout props names) (list?)
 213    (define (min-length lst n)
 214      "(min       (length lst) n)"
 215      (if (or (null? lst) (<= n 0))
 216          0
 217          (1+ (min-length (cdr lst) (1- n)))))
 218    (define (doc-chars-aux names acc)
 219      (let* ((n (min-length names 2))
 220             (head (take names n))
 221             (tail (drop names n)))
 222        (if (null? head)
 223            (reverse! acc)
 224            (doc-chars-aux tail
 225                          (cons (make-line-markup (map make-doc-char-markup head))
 226                                acc)))))
 227    (interpret-markup-list layout props (doc-chars-aux names (list))))