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)$"))
  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
  80   ;; remove all remaining groups from the glyph-list
  81   (for-each
  82     (lambda (x) (set! glyph-list (delete x glyph-list)))
  83     (append numbers
  84             dynamics
  85             default-noteheads
  86             special-noteheads
  87             shape-note-noteheads
  88             clefs
  89             timesig
  90             accidentals
  91             rests
  92             flags
  93             dots
  94             scripts
  95             arrowheads
  96             brackettips
  97             pedal
  98             accordion))
  99
 100   ;;;;;;;;;
 101
 102   ;; require all glyphs to appear here
 103   (if (pair? glyph-list) ; glyph-list should be empty by now
 104       (ly:error
 105         (_ "Unlisted glyphs in Documentation/included/font-table.ly: ~A")
 106         glyph-list))
 107
 108 ) % end of (begin ...)
 109
 110 \paper {
 111   %% ugh. text on toplevel is a bit broken...
 112
 113   oddHeaderMarkup = \markup {}
 114   evenHeaderMarkup = \markup {}
 115   oddFooterMarkup = \markup {}
 116   evenFooterMarkup = \markup {}
 117   }
 118
 119 \version "2.12.0"
 120
 121 #(define-markup-command (doc-char layout props name) (string?)
 122   (interpret-markup layout props
 123    (let* ((n (string-length name)))
 124      (if (> n 24)
 125          ;; split long glyph names near the middle at dots
 126          (let* ((middle-pos (round (/ n 2)))
 127                 (left-dot-pos (string-rindex name #\. 0 middle-pos))
 128                 (right-dot-pos (string-index name #\. middle-pos))
 129                 (left-distance (if (number? left-dot-pos)
 130                                    (- middle-pos left-dot-pos)
 131                                    middle-pos))
 132                 (right-distance (if (number? right-dot-pos)
 133                                     (- right-dot-pos middle-pos)
 134                                     middle-pos))
 135                 (split-pos (if (> left-distance right-distance)
 136                                right-dot-pos
 137                                left-dot-pos))
 138                 (left (substring name 0 split-pos))
 139                 (right (substring name split-pos)))
 140            (markup
 141              #:pad-to-box '(0 . 36) '(-2 . 2) #:column (#:typewriter left
 142                                                         #:typewriter #:concat ("  " right))
 143              #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name))
 144          (markup
 145            #:pad-to-box '(0 . 36) '(-2 . 2) #:typewriter name
 146            #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name)))))
 147
 148 #(define-markup-list-command (doc-chars layout props names) (list?)
 149    (define (min-length lst n)
 150      "(min       (length lst) n)"
 151      (if (or (null? lst) (<= n 0))
 152          0
 153          (1+ (min-length (cdr lst) (1- n)))))
 154    (define (doc-chars-aux names acc)
 155      (let* ((n (min-length names 2))
 156             (head (take names n))
 157             (tail (drop names n)))
 158        (if (null? head)
 159            (reverse! acc)
 160            (doc-chars-aux tail
 161                          (cons (make-line-markup (map make-doc-char-markup head))
 162                                acc)))))
 163    (interpret-markup-list layout props (doc-chars-aux names (list))))