scm/chord-names.scm

   1 ;; note-name: (note . accidental)
   2 ;; list:  (list-of-pitches . (modifier-string . addition-subtraction-string))
   3
   4 ;; if a complete chord is found, use name
   5 ;; if a chord's base triad is found (c e g), use name
   6
   7 (define note-names-alist '())
   8 (set! note-names-alist
   9       (append
  10       '(
  11         ; use these for German naming
  12         ;((6 . 0) . ("H" ""))
  13         ;((6 . -1) . ("B" ("feta-1" . "\12")))
  14
  15         ; C-p/C-r current feta chars for sharp/flat
  16         ; don't use them: ly2dvi breaks (inputenc package)
  17         ;((0 . 1) . ("C" ("feta-1" . "\10")))
  18         ;((0 . -1) . ("C" ("feta-1" . "\12")))
  19         )
  20       note-names-alist))
  21
  22 (define (pitch->note-name pitch)
  23   (cons (cadr pitch) (caddr pitch)))
  24
  25 (define (user-pitch-name pitch)
  26   (let ((entry (assoc (pitch->note-name pitch) note-names-alist)))
  27        (if entry
  28            (cdr entry))))
  29
  30 (define chord-names-alist '())
  31 (set! chord-names-alist
  32       (append
  33       '(
  34         ; C iso C.no3.no5
  35         (((0 . 0)) . (#f . #f))
  36         ; C iso C.no5
  37         (((0 . 0) (2 . 0)) . (#f . #f))
  38         ; Cm iso Cm.no5
  39         (((0 . 0) (2 . -1)) . ("m" . #f))
  40         ; Cdim iso Cm5-
  41         (((0 . 0) (2 . -1) (4 . -1)) . ("dim" . #f))
  42         ; Co iso Cm5-7-
  43         ; urg
  44         ; (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" . ("feta-1" . ".")))
  45         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (#f . ("script" . "o")))
  46         ; Cdim9
  47         (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" . ("script" . "9")))
  48         (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" . ("script" . "11")))
  49         )
  50       chord-names-alist))
  51
  52 (define (user-chord-name chord)
  53   (let ((entry (assoc (map (lambda (x) (pitch->note-name x)) chord)
  54                       chord-names-alist)))
  55     (if entry
  56         (cdr entry))))