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))))