From e418310195c3a0044e355ccd38ea88407af941b2 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Fri, 14 Feb 2003 22:28:02 +0000 Subject: [PATCH] (ignatzek-chord-names): classify pitches for jazz chords. --- ChangeLog | 9 ++ aclocal.m4 | 4 +- lily/pitch.cc | 18 +-- scm/chord-name.scm | 8 +- scm/double-plus-new-chord-name.scm | 197 ++++++++++++++++++++++++++++- 5 files changed, 221 insertions(+), 15 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7c439f1a82..174da66cfc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2003-02-14 Han-Wen Nienhuys + + * scm/double-plus-new-chord-name.scm (ignatzek-chord-names): classify + pitches for jazz chords. + +2003-02-13 Han-Wen Nienhuys + + * lily/pitch.cc (LY_DEFINE): add ly:pitch-steps + 2003-02-05 Heikki Junes * lilypond.words: add 1 diff --git a/aclocal.m4 b/aclocal.m4 index ba3fe26791..f198d4c727 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1,6 +1,6 @@ dnl aclocal.m4 -*-shell-script-*- dnl WARNING WARNING WARNING -dnl do not edit! this is aclocal.m4, generated from /users/hanwen/usr/src/savannah/lilypond/lilypond-1.7/stepmake/aclocal.m4 +dnl do not edit! this is aclocal.m4, generated from /home/hanwen/usr/src/lilypond/stepmake/aclocal.m4 dnl aclocal.m4 -*-shell-script-*- dnl StepMake subroutines for configure.in @@ -681,7 +681,7 @@ AC_DEFUN(STEPMAKE_KPATHSEA, [ if test "$kpathsea_b" = "no"; then warn='kpathsea (libkpathsea-dev or kpathsea-devel package) Else, please specify the location of your kpathsea using - --with-kpathea-include and --with-kpathsea-lib options. You should + --with-kpathsea-include and --with-kpathsea-lib options. You should install kpathsea; see INSTALL.txt. Rerun ./configure --without-kpathsea only if kpathsea is not available for your platform.' diff --git a/lily/pitch.cc b/lily/pitch.cc index b4250900dc..4d1096fcc6 100644 --- a/lily/pitch.cc +++ b/lily/pitch.cc @@ -308,13 +308,22 @@ LY_DEFINE(make_pitch, "ly:make-pitch", 3, 0, 0, return p.smobbed_copy (); } +LY_DEFINE(pitch_steps, "ly:pitch-steps", 1, 0,0, + (SCM p), + "Number of steps counted from central C of the pitch @var{p}.") +{ + Pitch *pp = unsmob_pitch (p); + SCM_ASSERT_TYPE(pp, p, SCM_ARG1, __FUNCTION__, "Pitch"); + + return gh_int2scm (pp->steps()); +} LY_DEFINE(pitch_octave, "ly:pitch-octave", 1, 0, 0, (SCM pp), "extract the octave from pitch @var{p}.") { Pitch *p = unsmob_pitch (pp); - SCM_ASSERT_TYPE(p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); + SCM_ASSERT_TYPE(p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); int q = p->get_octave (); return gh_int2scm (q); @@ -351,13 +360,6 @@ LY_DEFINE(pitch_semitones, "ly:pitch-semitones", 1, 0, 0, int q = p->semitone_pitch (); - // Was : - // - //int q = p->steps (); - // - // As the function is called "pitch_semitones", I assume it was a mistake ! - // Jiba - return gh_int2scm (q); } diff --git a/scm/chord-name.scm b/scm/chord-name.scm index cb364402b5..96ce0d276e 100644 --- a/scm/chord-name.scm +++ b/scm/chord-name.scm @@ -939,7 +939,10 @@ inline use in .ly file" ((american) (chord-name-style-setter chord->markup-american chord::exception-alist-american)) - + + ((ignatzek) + (chord-name-style-setter ignatzek-chord-names + '())) ((double-plus-new-banter) (chord-name-style-setter double-plus-new-chord->markup-banter chord::exception-alist-banter)) @@ -959,6 +962,8 @@ inline use in .ly file" (context-spec-music (make-sequential-music (list (make-property-set 'chordNameFunction function) + + ;; urg , misuse of chordNameExceptions function. (make-property-set 'chordNameExceptions options))) "ChordNames")) @@ -969,3 +974,4 @@ inline use in .ly file" ((jazz) (chord-name-style-setter double-plus-new-chord->markup-jazz))))) + diff --git a/scm/double-plus-new-chord-name.scm b/scm/double-plus-new-chord-name.scm index 0ef705a072..342a315d71 100644 --- a/scm/double-plus-new-chord-name.scm +++ b/scm/double-plus-new-chord-name.scm @@ -25,12 +25,12 @@ (define (write-me message x) "Return X. Display MESSAGE and write X. Handy for debugging, possibly turned off." -;; (display message) (write x) (newline) x) - x) + (display message) (write x) (newline) x) +;; x) (define (tail lst) "Return tail element of LST." - (car (reverse lst))) + (car (last-pair lst))) (define (list-minus a b) "Return list of elements in A that are not in B." @@ -82,8 +82,12 @@ ;; Generic PITCH/MARKUP functions (define (ly:pitch-diff pitch root) - "Return pitch with value PITCH - ROOT, ie, + "Return pitch with value DELTA = PITCH - ROOT, ie, ROOT == (ly:pitch-transpose root delta)." + + + ;; a little kludgy? Do this in C++ ? --hwn + (let ((simple-octave (- (ly:pitch-octave pitch) (ly:pitch-octave root))) (simple-notename (- (ly:pitch-notename pitch) (ly:pitch-notename root)))) @@ -349,3 +353,188 @@ input/test/dpncnt.ly). (else empty-markup)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; jazz-part 2 +;; +;; after Klaus Ignatzek, Die Jazzmethode fuer Klavier 1. +;; + + +(define natural-chord-alterations + '( + (2 . 0) + (3 . 0) + (4 . 0) + (5 . 0) + (6 . 0) + + (7 . -1) + (9 . 0) + (11 . 0) + (13 . 0)) + ) + +(define natural-7-up-alterations + (butfirst-n 5 natural-chord-alterations) ) + +(define-public (ignatzek-chord-names + in-pitches bass inversion options) + + (let* + ( + (root (car in-pitches)) + (pitches (map (lambda (x) (ly:pitch-diff x root)) (cdr in-pitches))) + (suffixes '()) + (add-steps '()) + (body '()) + (7-and-up '()) + (sequential-7-to-13 '()) + (sequential-count 0) + (alterations '()) + (unaltered-count 0) + ) + + (define (get-step x ps) + "Does PS have the X step? Return that step if it does." + (if (null? ps) + #f + (if (= (- x 1) (ly:pitch-steps (car ps))) + (car ps) + (get-step x (cdr ps))) + )) + + (define (name-step pitch) + (define (step-alteration pitch) + (- (ly:pitch-alteration pitch) + (assoc-get-default (+ 1 (ly:pitch-steps pitch)) natural-chord-alterations 0)) + ) + + (make-line-markup + (list + (accidental->markup (step-alteration pitch)) + (make-simple-markup (number->string (+ 1 (ly:pitch-steps pitch))))))) + + + (define (count-leading-true bs) + "For the list of booleans BS, count with how many #t's it starts." + (if (null? bs) + 0 + (if (car bs) + (+ 1 (count-leading-true (cdr bs))) + 0) + )) + + (define (remove-step x ps) + "Copy PS, but leave out the Xth step." + (if (null? ps) + '() + (let* + ( + (t (remove-step x (cdr ps))) + ) + + (if (= (- x 1) (ly:pitch-steps (car ps))) + t + (cons (car ps) t) + )) + + )) + + (define (remove-uptil-step x ps) + "Copy PS, but leave out everything below the Xth step." + (if (null? ps) + '() + (if (< (ly:pitch-steps (car ps)) (- x 1)) + (remove-uptil-step x (cdr ps)) + ps) + ) + ) + + + + (write-me "*****************\nchord " in-pitches) + + ;; handle sus4 suffix. + (if (get-step 4 pitches) + (begin + (if (get-step 3 pitches) + (begin + (set! add-steps (cons (get-step 3 pitches) add-steps)) + (set! pitches (remove-step 3 pitches)) + )) + (set! suffixes (cons "sus4" suffixes)) + ) + ) + + ;; handle sus2 suffix. + (if (get-step 2 pitches) + (begin + (if (get-step 3 pitches) + (begin + (set! add-steps (cons (get-step 3 pitches) add-steps)) + (set! pitches (remove-step 3 pitches)) + )) + (set! suffixes (cons "sus2" suffixes)) + ) + ) + + (if (and (get-step 3 pitches) + (= (ly:pitch-alteration (get-step 3 pitches)) -1)) + (set! body (cons "m" body)) + ) + + (if (get-step 6 pitches) + (set! body (cons "6" body )) + ) + + (if (>= (ly:pitch-steps (tail pitches)) 6) + (begin + + ;; TODO: filter 6, 8, 10, 12, 14 + (set! 7-and-up (remove-uptil-step 7 pitches)) + (set! sequential-count + (count-leading-true + (map + (lambda (x) + (get-step (car x) 7-and-up)) + natural-7-up-alterations + ) + )) + + (set! sequential-7-to-13 + (first-n sequential-count 7-and-up)) + + (set! add-steps (append add-steps + (butfirst-n sequential-count 7-and-up))) + + (set! unaltered-count + (count-leading-true + (map (lambda (x) + (= (ly:pitch-alteration (get-step (car x) sequential-7-to-13)) + (cdr x))) + (first-n (length sequential-7-to-13) natural-7-up-alterations) + ))) + + (write-me "sequential-7-to-13 " sequential-7-to-13) + (if (pair? sequential-7-to-13) + (set! body + (cons (name-step + (list-ref sequential-7-to-13 (max 0 (- unaltered-count 1)))) + body))) + + (set! alterations (butfirst-n unaltered-count sequential-7-to-13)) + )) + + (write-me "alterations " alterations) + (write-me "add-steps " add-steps) + (write-me "body " body) + (write-me "suffixes " suffixes) + + + (make-simple-markup "bla") + + )) + -- 2.39.5