X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fchord-ignatzek-names.scm;h=696d02fc7af43ab3ae2383f670a51ecc98afde9d;hb=e90f0536f9be39ada0bef0aeb0d275dec3b2fb5b;hp=2783f32a86970021996b9cc2ee562e9972f7bd6b;hpb=9f3572d98bb948c9689cd1f75401a029451fa001;p=lilypond.git diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm index 2783f32a86..696d02fc7a 100644 --- a/scm/chord-ignatzek-names.scm +++ b/scm/chord-ignatzek-names.scm @@ -1,8 +1,19 @@ -;;;; 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--2006 Han-Wen Nienhuys +;;;; Copyright (C) 2000--2011 Han-Wen Nienhuys +;;;; +;;;; 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 . @@ -12,20 +23,20 @@ ;; 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) @@ -33,7 +44,7 @@ (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) @@ -66,21 +77,21 @@ (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 @@ -88,11 +99,12 @@ 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 @@ -104,29 +116,29 @@ work than classifying the pitches." (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) '() @@ -152,11 +164,11 @@ work than classifying the pitches." (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)) @@ -171,7 +183,7 @@ work than classifying the 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 @@ -188,20 +200,25 @@ work than classifying the pitches." (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 '()) @@ -213,10 +230,10 @@ work than classifying the pitches." 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 @@ -236,7 +253,7 @@ work than classifying the pitches." (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))) @@ -270,4 +287,5 @@ work than classifying the 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?))))))