Files
lilypond-common-includes/private_includes/base/data_extractor.ily
T

83 lines
3.7 KiB
LilyPond

%%% Extrahiert Informationen aus einem ly:music-Objekt und liefert eine alist
%%% mit String-Werten zurueck (z.B. ((time . "4/4") (key . "d minor"))).
%%% Benoetigt LilyPond >= 2.26.
%% note-name->lily-string liegt im Modul (lily display-lily).
#(use-modules (lily display-lily))
#(begin
;; --- Taktangabe --------------------------------------------------------
;; Numerator einer Taktangabe kann eine Zahl oder eine Liste sein.
(define (numerator->string num)
(if (list? num)
(string-join (map number->string num) "+")
(number->string num)))
;; Liefert die Taktangabe als String (z.B. "4/4" oder "7/8") oder #f.
;; time-signature ist ein Paar (numerator . denominator).
(define (time-music->string m)
(let ((ts (ly:music-property m 'time-signature)))
(and (pair? ts)
(string-append (numerator->string (car ts)) "/"
(number->string (cdr ts))))))
;; --- Tonart ------------------------------------------------------------
;; Liefert die Tonart als String (z.B. "d minor" oder "c major") oder #f.
;; Vorgehen wie in LilyPonds eigenem \displayMusic (define-music-display-
;; methods.scm): pitch-alist nach c zuruecktransponieren und mit den
;; bekannten Modus-Definitionen vergleichen. note-name->lily-string liefert
;; den Grundton in der aktuell eingestellten Notensprache.
(define (key-music->string m)
(let ((tonic (ly:music-property m 'tonic))
(alist (ly:music-property m 'pitch-alist)))
(and (ly:pitch? tonic) (pair? alist)
(let* ((c-alist (ly:transpose-key-alist alist (- tonic)))
(mode (any (lambda (mode)
(and (equal? (ly:parser-lookup mode) c-alist)
(symbol->string mode)))
'(major minor))))
(and mode
(string-append (symbol->string (note-name->lily-string tonic))
" " mode))))))
;; --- Header-Metadaten ----------------------------------------------------
;; Nimmt einen Bookpart entgegen (wie HEADER aus pool_bottom.ily) und
;; liefert dessen Header-Felder als alist, z.B.
;; ((title . "Ako umram") (authors . (("..." text melody))) ...).
;; Die Werte bleiben unveraendert, wie sie im \header definiert wurden
;; (Strings, Listen, Markups ...).
(define (bookpart->header-alist bookpart)
(let ((header (ly:book-header bookpart)))
(if (module? header)
(sort
(filter-map (lambda (entry)
(and (variable-bound? (cdr entry))
(cons (car entry) (variable-ref (cdr entry)))))
(module-map cons header))
(lambda (a b)
(string<? (symbol->string (car a))
(symbol->string (car b)))))
'())))
;; --- Hauptfunktion -----------------------------------------------------
;; Liefert das erste Music-Objekt mit gegebenem Namen (oder #f).
(define (first-named-music music music-name)
(let ((matches (extract-named-music music music-name)))
(and (pair? matches) (car matches))))
;; Nimmt ly:music entgegen und liefert eine alist mit String-Werten.
(define (music->data-alist music)
(let* ((time-m (first-named-music
music '(TimeSignatureMusic ReferenceTimeSignatureMusic)))
(key-m (first-named-music music 'KeyChangeEvent))
(time-s (and time-m (time-music->string time-m)))
(key-s (and key-m (key-music->string key-m))))
(append
(if time-s (list (cons 'time time-s)) '())
(if key-s (list (cons 'key key-s)) '())))))