* scm/chord-name.scm (natural-chord-alteration): replace old

[lilypond.git] / scm / chords-ignatzek.scm

diff --git a/scm/chords-ignatzek.scm b/scm/chords-ignatzek.scm
index 5ef42c0a69da2e906eeb5dba2df3f863ef0c5c70..05508c06efe2d34db06ea99d41beaf080e73005d 100644 (file)
--- a/scm/chords-ignatzek.scm
+++ b/scm/chords-ignatzek.scm
@@ -1,130 +1,9 @@
-;; implement Ignatzek chord naming
-;; 
-;;  source file of the GNU LilyPond music typesetter
-;;
-;; (c) 2003 Han-Wen Nienhuys
-
-(define (natural-chord-alteration p)
-  "Return the natural alteration for step P."
-  (if (= (ly:pitch-steps p) 6)
-      -1
-      0))
-
-
-(define-public (alteration->text-accidental-markup alteration)
-  (make-smaller-markup
-   (make-raise-markup
-    (if (= alteration -1)
-       0.3
-       0.6)
-    (make-musicglyph-markup
-     (string-append "accidentals-" (number->string alteration))))))
-  
-(define (accidental->markup alteration)
-  "Return accidental markup for ALTERATION."
-  (if (= alteration 0)
-      (make-line-markup (list empty-markup))
-      (conditional-kern-before
-       (alteration->text-accidental-markup alteration)
-       (= alteration -1) 0.2
-       )))
-
-
-(define-public (note-name->markup pitch)
-  "Return pitch markup for PITCH."
-  (make-line-markup
-   (list
-    (make-simple-markup
-     (vector-ref #("C" "D" "E" "F" "G" "A" "B") (ly:pitch-notename pitch)))
-    (make-normal-size-super-markup
-     (accidental->markup (ly:pitch-alteration pitch))))))
-
-
-(define-public ((chord-name->german-markup B-instead-of-Bb) pitch)
-  "Return pitch markup for PITCH, using german note names.
-   If B-instead-of-Bb is set to #t real german names are returned.
-   Otherwise semi-german names (with Bb and below keeping the british names)
-"
-  (let* ((name (ly:pitch-notename pitch))
-         (alt (ly:pitch-alteration pitch))
-        (n-a (if (member (cons name alt) '((6 . -1) (6 . -2)))
-                (cons 7 (+ (if B-instead-of-Bb 1 0) alt))
-                (cons name alt))))
-    (make-line-markup
-     (list
-      (make-simple-markup
-       (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a)))
-      (make-normal-size-super-markup
-       (accidental->markup (cdr n-a)))))))
-
-
-(define-public (note-name->german-markup  pitch)
-  (let* ((name (ly:pitch-notename pitch))
-        (alt (ly:pitch-alteration pitch))
-        (n-a (if (member (cons name alt) '((6 . -1) (6 . -2)))
-                 (cons 7 (+ 1 alt))
-                 (cons name alt))))
-    (make-line-markup
-     (list
-      (string-append
-       (list-ref '("c" "d" "e" "f" "g" "a" "h" "b") (car n-a))
-       (if (or (equal? (car n-a) 2) (equal? (car n-a) 5))
-          (list-ref '( "ses"  "s" "" "is" "isis") (+ 2 (cdr n-a)))
-          (list-ref '("eses" "es" "" "is" "isis") (+ 2 (cdr n-a)))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-
-(define-public (sequential-music-to-chord-exceptions seq)
-  "Transform sequential music of <<a b c>>-\markup{ foobar } type to
- (cons ABC-PITCHES FOOBAR-MARKUP)
- "
-  
-  (define (is-req-chord? m)
-    (and
-     (memq 'event-chord (ly:get-mus-property m 'types))
-     (not (equal? (ly:make-moment 0 1) (ly:get-music-length m)))
-    ))
-
-  (define (chord-to-exception-entry m)
-    (let*
-       (
-        (elts   (ly:get-mus-property m 'elements))
-        (pitches (map
-                  (lambda (x)
-                    (ly:get-mus-property x 'pitch)
-                    )
-                  (filter-list
-                   (lambda (y) (memq 'note-event (ly:get-mus-property y 'types)))
-                   elts)))
-        (sorted  (sort pitches ly:pitch<? ))
-        (root (car sorted))
-        (non-root (map (lambda (x) (ly:pitch-diff x root)) (cdr sorted)))
-        (texts (map
-                (lambda (x)
-                  (ly:get-mus-property x 'text)
-                  )
-                
-                (filter-list
-                 (lambda (y)
-                   (memq 'text-script-event
-                         (ly:get-mus-property y 'types))) elts)
-                ))
-        (text (if (null? texts)
-                  #f
-                  (car texts)))
-
-        )
-      (cons non-root text)
-    ))
-
-  (let*
-    (
-     (elts (filter-list is-req-chord? (ly:get-mus-property seq 'elements)))
-     (alist (map chord-to-exception-entry elts))
-     )
-    (filter-list (lambda (x) (cdr x)) alist)
-  ))
+;;;
+;;; chord-name.scm --  chord name utility functions
+;;;
+;;; source file of the GNU LilyPond music typesetter
+;;; 
+;;; (c)  2000--2003  Han-Wen Nienhuys
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -173,7 +52,6 @@
            ))
       ))
 
-
 (define (remove-step x ps)
   "Copy PS, but leave out the Xth step."
   (if (null? ps)