;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2003--2010 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 2003--2012 Jan Nieuwenhuizen <janneke@gnu.org>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; Naming of the base chord (steps 1-5) is handled by exceptions only
;;;; see input/test/chord-names-dpnj.ly
+
+(define (default-note-namer pitch)
+ (note-name->markup pitch #f))
+
(define (markup-or-empty-markup markup)
"Return MARKUP if markup, else empty-markup"
(if (markup? markup) markup empty-markup))
(define-public (ugh-compat-double-plus-new-chord->markup
style pitches bass inversion context options)
- "Entry point for New_chord_name_engraver.
+ "Entry point for @code{New_chord_name_engraver}.
FIXME: func, options/context have changed
- See
-double-plus-new-chord-name.scm for the signature of STYLE. PITCHES,
-BASS and INVERSION are lily pitches. OPTIONS is an alist-alist (see
-input/test/dpncnt.ly).
- "
+
+See @file{double-plus-new-chord-name.scm} for the signature of @var{style}.
+@var{pitches}, @var{bass}, and @var{inversion} are lily pitches.
+@var{options} is an alist-alist (see @file{input/@/test/@/dpncnt.ly})."
(define (step-nr pitch)
(let* ((pitch-nr (+ (* 7 (ly:pitch-octave pitch))
(list (ly:context-property context 'majorSevenSymbol))
(list (accidental->markup (step-alteration pitch))
(make-simple-markup (number->string (step-nr pitch)))))))
-
+
;; tja, kennok
(define (make-sub->markup step->markup)
(lambda (pitch)
(make-line-markup (list (make-simple-markup "no")
(step->markup pitch)))))
-
+
(define (step-based-sub->markup step->markup pitch)
(make-line-markup (list (make-simple-markup "no") (step->markup pitch))))
-
+
(define (get-full-list pitch)
(if (<= (step-nr pitch) (step-nr (last pitches)))
(cons pitch (get-full-list (next-third pitch)))
;; (all pitches)
(all (append (take full (length partial-pitches))
(drop pitches (length partial-pitches))))
-
+
(highest (last all))
(missing (list-minus full (map pitch-unalter all)))
(consecutive (get-consecutive 1 all))
(altered (filter step-even-or-altered? all))
(cons-alt (filter step-even-or-altered? consecutive))
(base (list-minus consecutive altered)))
-
+
(if #f (begin
(write-me "full:" full)
;; + subs:missing
(let* ((root->markup (assoc-get
- 'root->markup options note-name->markup))
+ 'root->markup options default-note-namer))
(step->markup (assoc-get
'step->markup options step->markup-plusminus))
(sub->markup (assoc-get
(step-based-sub->markup step->markup x))))
(sep (assoc-get
'separator options (make-simple-markup "/"))))
-
+
(if
(pair? full-markup)
(make-line-markup (list (root->markup root) full-markup))
-
+
(make-line-markup
(list
(root->markup root)
;; + 'add'
;; + steps:rest
(let* ((root->markup (assoc-get
- 'root->markup options note-name->markup))
+ 'root->markup options default-note-namer))
(step->markup
(assoc-get
;; FIXME: ignatzek
'separator options (make-simple-markup " ")))
(add-prefix (assoc-get 'add-prefix options
(make-simple-markup " add"))))
-
+
(if
(pair? full-markup)
(make-line-markup (list (root->markup root) full-markup))
-
+
(make-line-markup
(list
(root->markup root)
(make-normal-size-super-markup
(make-line-markup
(list
-
+
;; kludge alert: omit <= 5
;;(markup-join (map step->markup
;; (cons (last base) cons-alt)) sep)
-
+
;; This fixes:
;; c C5 -> C
;; c:2 C5 2 -> C2
(if (> (step-nr tb) 5)
(cons tb cons-alt)
cons-alt))) sep)
-
+
(if (pair? rest)
add-prefix
empty-markup)