-;;;; chord-ignatzek-names.scm -- chord name utility functions
+;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 2000--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2000--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
;; jazz-part 2
;;
;; after Klaus Ignatzek, Die Jazzmethode fuer Klavier 1.
-;;
+;;
;; The idea is: split chords into
-;;
+;;
;; ROOT PREFIXES MAIN-NAME ALTERATIONS SUFFIXES ADDITIONS
;;
;; and put that through a layout routine.
-;;
-;; the split is a procedural process, with lots of set!.
+;;
+;; the split is a procedural process, with lots of set!.
;;
;; todo: naming is confusing: steps (0 based) vs. steps (1 based).
(define (pitch-step p)
- "Musicological notation for an interval. Eg. C to D is 2."
+ "Musicological notation for an interval. Eg. C to D is 2."
(+ 1 (ly:pitch-steps p)))
(define (get-step x ps)
(if (null? ps)
#f
(if (= (- x 1) (ly:pitch-steps (car ps)))
- (car ps)
+ (car ps)
(get-step x (cdr ps)))))
(define (replace-step p ps)
(if (< (ly:pitch-steps (car ps)) (- x 1))
(remove-uptil-step x (cdr ps))
ps)))
-
+
(define name-root (ly:context-property context 'chordRootNamer))
- (define name-note
+ (define name-note
(let ((nn (ly:context-property context 'chordNoteNamer)))
(if (eq? nn '())
;; replacing the next line with name-root gives guile-error...? -rz
;; apparently sequence of defines is equivalent to let, not let* ? -hwn
- (ly:context-property context 'chordRootNamer)
+ (ly:context-property context 'chordRootNamer)
;; name-root
nn)))
(define (is-natural-alteration? p)
(= (natural-chord-alteration p) (ly:pitch-alteration p)))
-
+
(define (ignatzek-format-chord-name
root
prefix-modifiers
alteration-pitches
addition-pitches
suffix-modifiers
- bass-pitch)
+ bass-pitch
+ lowercase-root?)
- "Format for the given (lists of) pitches. This is actually more
+ "Format for the given (lists of) pitches. This is actually more
work than classifying the pitches."
-
+
(define (filter-main-name p)
"The main name: don't print anything for natural 5 or 3."
(if
(list (name-step p))))
(define (glue-word-to-step word x)
- (make-line-markup
+ (make-line-markup
(list
(make-simple-markup word)
(name-step x))))
-
+
(define (suffix-modifier->markup mod)
(if (or (= 4 (pitch-step mod))
(= 2 (pitch-step mod)))
(glue-word-to-step "sus" mod)
(glue-word-to-step "huh" mod)))
-
+
(define (prefix-modifier->markup mod)
(if (and (= 3 (pitch-step mod))
(= FLAT (ly:pitch-alteration mod)))
- (make-simple-markup "m")
+ (make-simple-markup (if lowercase-root? "" "m"))
(make-simple-markup "huh")))
-
+
(define (filter-alterations alters)
"Filter out uninteresting (natural) pitches from ALTERS."
-
+
(define (altered? p)
(not (is-natural-alteration? p)))
-
+
(if
(null? alters)
'()
(list (ly:context-property context 'majorSevenSymbol))
args)
(cons (accidental->markup (step-alteration pitch)) args))))
-
+
(make-line-markup total)))
(let* ((sep (ly:context-property context 'chordNameSeparator))
- (root-markup (name-root root))
+ (root-markup (name-root root lowercase-root?))
(add-markups (map (lambda (x) (glue-word-to-step "add" x))
addition-pitches))
(filtered-alterations (filter-alterations alteration-pitches))
suffixes
add-markups) sep))
(base-stuff (if (ly:pitch? bass-pitch)
- (list sep (name-note bass-pitch))
+ (list sep (name-note bass-pitch #f))
'())))
(set! base-stuff
(define (ignatzek-format-exception
root
exception-markup
- bass-pitch)
+ bass-pitch
+ lowercase-root?)
(make-line-markup
`(
- ,(name-root root)
+ ,(name-root root lowercase-root?)
,exception-markup
- .
+ .
,(if (ly:pitch? bass-pitch)
(list (ly:context-property context 'chordNameSeparator)
- (name-note bass-pitch))
+ (name-note bass-pitch #f))
'()))))
(let* ((root (car in-pitches))
(pitches (map (lambda (x) (ly:pitch-diff x root)) (cdr in-pitches)))
+ (lowercase-root?
+ (and (ly:context-property context 'chordNameLowercaseMinor)
+ (let ((third (get-step 3 pitches)))
+ (and third (= (ly:pitch-alteration third) FLAT)))))
(exceptions (ly:context-property context 'chordNameExceptions))
(exception (assoc-get pitches exceptions))
(prefixes '())
inversion
bass))
(alterations '()))
-
+
(if exception
- (ignatzek-format-exception root exception bass-note)
-
+ (ignatzek-format-exception root exception bass-note lowercase-root?)
+
(begin
;; no exception.
;; handle sus4 and sus2 suffix: if there is a 3 together with
(if (and (get-step 3 pitches)
(= (ly:pitch-alteration (get-step 3 pitches)) FLAT))
(set! prefixes (cons (get-step 3 pitches) prefixes)))
-
+
;; lazy bum. Should write loop.
(cond
((get-step 7 pitches) (set! main-name (get-step 7 pitches)))
(set! alterations '())))
(ignatzek-format-chord-name
- root prefixes main-name alterations add-steps suffixes bass-note))))))
+ root prefixes main-name alterations add-steps suffixes bass-note
+ lowercase-root?))))))
projects / lilypond.git / blobdiff