scm/chord-names.scm

   1 ;; pitch: (notename . 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 pitch-names-alist '())
   8 (set! pitch-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       pitch-names-alist))
  21
  22 (define (user-pitch-name pitch)
  23   (let ((entry (assoc pitch pitch-names-alist)))
  24        (if entry
  25            (cdr entry))))
  26
  27 (define chord-names-alist '())
  28 (set! chord-names-alist
  29       (append
  30       '(
  31         ; C iso C.no3.no5
  32         (((0 . 0)) . ("" . ""))
  33         ; C iso C.no5
  34         (((0 . 0) (2 . 0)) . ("" . ""))
  35         ; Cm iso Cm.no5
  36         (((0 . 0) (2 . -1)) . ("m" . ""))
  37         ; Cdim iso Cm5-
  38         (((0 . 0) (2 . -1) (4 . -1)) . ("dim" . ""))
  39         ; Co iso Cm5-7-
  40         ; urg
  41         ; (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" . ("feta-1" . ".")))
  42         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" . ("script" . "o")))
  43         ; Cdim9
  44         (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" . ("script" . "9")))
  45         (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" . ("script" . "11")))
  46         )
  47       chord-names-alist))
  48
  49 (define (user-chord-name chord)
  50   ;(display chord)
  51   ;(newline)
  52   (let ((entry (assoc chord chord-names-alist)))
  53        (if entry
  54            (cdr entry))))
  55