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   (define kievan (get-group glyph-list "^.*kievan.*$"))
  36
  37   ;; remove ancient-music groups from the glyph-list
  38   (for-each
  39     (lambda (x) (set! glyph-list (delete x glyph-list)))
  40     (append vaticana
  41             medicaea
  42             hufnagel
  43             mensural
  44             neomensural
  45             petrucci
  46             solesmes
  47             kievan))
  48
  49   ;; define all remaining groups
  50   (define numbers
  51     '("plus" "comma" "hyphen" "period"
  52       "zero" "one"   "two"    "three"  "four"
  53       "five" "six"   "seven"  "eight"  "nine"))
  54
  55   (define dynamics
  56     '("space" "f" "m" "p" "r" "s" "z"))
  57
  58   (define default-noteheads
  59     (get-group glyph-list
  60       "^noteheads.[dsu]M?[012]$"))
  61
  62   (define special-noteheads
  63     (get-group glyph-list
  64       "^noteheads.[dsu]M?[012](double|harmonic|diamond|cross|xcircle|triangle|slash)$"))
  65
  66   (define shape-note-noteheads
  67     (get-group glyph-list
  68       "^noteheads.[dsu][012](do|re|mi|fa|sol|la|ti)(Thin|Mirror|Funk|Walker)*$"))
  69
  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\\."))
  82
  83   ;; remove all remaining groups from the glyph-list
  84   (for-each
  85     (lambda (x) (set! glyph-list (delete x glyph-list)))
  86     (append numbers
  87             dynamics
  88             default-noteheads
  89             special-noteheads
  90             shape-note-noteheads
  91             clefs
  92             timesig
  93             accidentals
  94             rests
  95             flags
  96             dots
  97             scripts
  98             arrowheads
  99             brackettips
 100             pedal
 101             accordion
 102             ties))
 103
 104   ;;;;;;;;;
 105
 106   ;; require all glyphs to appear here
 107   (if (pair? glyph-list) ; glyph-list should be empty by now
 108       (ly:error
 109         (_ "Unlisted glyphs in Documentation/included/font-table.ly: ~A")
 110         glyph-list))
 111
 112 ) % end of (begin ...)
 113
 114 \paper {
 115   %% ugh. text on toplevel is a bit broken...
 116
 117   oddHeaderMarkup = \markup {}
 118   evenHeaderMarkup = \markup {}
 119   oddFooterMarkup = \markup {}
 120   evenFooterMarkup = \markup {}
 121   }
 122
 123 \version "2.14.0"
 124
 125 #(define-markup-command (doc-char layout props name) (string?)
 126   (interpret-markup layout props
 127    (let* ((n (string-length name)))
 128      (if (> n 24)
 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)
 135                                    middle-pos))
 136                 (right-distance (if (number? right-dot-pos)
 137                                     (- right-dot-pos middle-pos)
 138                                     middle-pos))
 139                 (split-pos (if (> left-distance right-distance)
 140                                right-dot-pos
 141                                left-dot-pos))
 142                 (left (substring name 0 split-pos))
 143                 (right (substring name split-pos)))
 144            (markup
 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))
 148          (markup
 149            #:pad-to-box '(0 . 36) '(-2 . 2) #:typewriter name
 150            #:pad-to-box '(-2 . 4) '(-3.5 . 3.5) #:huge #:musicglyph name)))))
 151
 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))
 156          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)))
 162        (if (null? head)
 163            (reverse! acc)
 164            (doc-chars-aux tail
 165                          (cons (make-line-markup (map make-doc-char-markup head))
 166                                acc)))))
 167    (interpret-markup-list layout props (doc-chars-aux names (list))))