release: 1.3.81

[lilypond.git] / scm / chord-names.scm

diff --git a/scm/chord-names.scm b/scm/chord-names.scm
index e6d72a9059f32c253576e6c0c9b23feca3a4c4ac..5116a7904fb3587c11d8e7074eb699a382f05083 100644 (file)
--- a/scm/chord-names.scm
+++ b/scm/chord-names.scm
@@ -3,7 +3,17 @@
 ;;;
 
 (use-modules
-   (ice-9 debug))
+   (ice-9 debug)
+   ;; urg, these two only to guess if a '/' is needed to separate
+   ;; user-chord-name and additions/subtractions
+   (ice-9 format)
+   (ice-9 regex)
+   )
+
+;; The regex module may not be available, or may be broken.
+(define use-regex
+  (let ((os (string-downcase (vector-ref (uname) 0))))
+    (not (equal? "cygwin" (substring os 0 (min 6 (string-length os)))))))
 
 ;;
 ;; (octave notename accidental)
@@ -18,7 +28,8 @@
 ;; TODO
 ;;
 ;; * clean split of base/banter/american stuff
-;; * text definition is rather ad-hoc.
+;; * text definition is rather ad-hoc
+;; * do without format module
 ;; * finish and check american names
 ;; * make notename (tonic) configurable from mudela
 ;; * fix append/cons stuff in inner-name-banter
@@ -63,8 +74,14 @@
         (((0 . 0) (4 . 0)) . (("5" (type . "super"))))
         (((0 . 0) (3 . 0) (4 . 0)) . ("sus"))
         (((0 . 0) (2 . -1) (4 . -1)) . (("o" (type . "super"))))
+
         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (("o7" (type . "super"))))
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (("x7" (type . "super"))))
+        ;jazz: the delta, see jazz-chords.ly
+        ;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .  (("N" (type . "super") (style . "msam") (size . -3))))
+
+        ;(((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (("x7" (type . "super"))))
+        ; slashed o
+        (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (("o" (type . "super")) ("/" (size . -2) (offset . (-0.58 . 0.5))) ("7" (type . "super"))))
 
         (((0 . 0) (2 . 0) (4 . 1)) . ("aug"))
         (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . (("aug" ("7" (type . "super")))))
@@ -166,9 +183,9 @@
 ;; word: string + optional list of property
 ;; property: align, kern, font (?), size
 
-;;(define chord::minor-major-vec (list->vector '(0 -1 -1 0 0 -1 -1)))
 (define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
 
+;; compute the relative-to-tonic pitch that goes with 'step'
 (define (chord::step-pitch tonic step)
   ;; urg, we only do this for thirds
   (if (= (modulo step 2) 0)
@@ -236,9 +253,19 @@
              (loop step (cdr pitches) subtractions)))))
        (reverse subtractions)))))
 
+;; combine tonic, user-specified chordname,
+;; additions, subtractions and base or inversion to chord name
+;;
 (define (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)
     (apply append (pitch->text-banter tonic)
           (if user-name user-name '())
+          ;; why does list->string not work, format seems only hope...
+          (if (and use-regex
+                   (string-match "super" (format "~s" user-name))
+                   (or (pair? additions)
+                       (pair? subtractions)))
+              '(("/" (type . "super")))
+              '())
           (let loop ((from additions) (to '()))
             (if (pair? from)
                 (let ((p (car from)))
@@ -281,20 +308,29 @@
        (subtractions (chord::subtractions pitches)))
     (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
 
+;; american chordnames use no "no",
+;; but otherwise very similar to banter for now
 (define (chord::name-american tonic user-name pitches base-and-inversion)
   (let ((additions (chord::additions pitches))
        (subtractions #f))
     (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
 
+;; C++ entry point
+;; 
+;; Check for each subset of chord, full chord first, if there's a
+;; user-override.  Split the chord into user-overridden and to-be-done
+;; parts, complete the missing user-override matched part with normal
+;; chord to be name-calculated.
+;;
 (define (chord::user-name style pitches base-and-inversion)
   ;(display "pitches:") (display  pitches) (newline)
   ;(display "style:") (display  style) (newline)
   ;(display "b&i:") (display  base-and-inversion) (newline)
   (let ((diff (pitch::diff '(0 0 0) (car pitches)))
        (name-func 
-         (eval (string->symbol (string-append "chord::name-" style))))
+         (ly-eval (string->symbol (string-append "chord::name-" style))))
        (names-alist 
-         (eval (string->symbol (string-append "chord::names-alist-" style)))))
+         (ly-eval (string->symbol (string-append "chord::names-alist-" style)))))
   (let loop ((note-names (reverse pitches))
             (chord '())
             (user-name #f))