Projets d'informatique musicale
Licence-Maîtrise d'informatique - Université de Caen
Marc Chemillier



;;; =========================== 
;;; Jazz.lisp / 30 octobre 1998 
;;; ===========================

;;; Realisation d'une grille sous forme de parties basse + piano 
;;; EX: (realise-grille 
                 '(((C 7M)) ((B m7) (E 7)) ((A m7) (D 7)) ((G m7) (C 7)) 
                   ((F 7M)) ((F m7) (Bb 7)) ((Eb 7M)) ((Eb m7) (Ab 7))
                   ((D m7)) ((G 7)) ((C 7M)) ((C 7M)))    ;;; )

(defun realise-grille (grille)
  (let ((basse ()) (piano ()))
    (do ((l grille (cdr l)))
        ((null l) (list (reverse basse) (reverse piano)))
      (let ((mesure-basse (calcul-basse (car l))) (mesure-piano (calcul-piano (car l))))
         (setq basse (append (reverse mesure-basse) basse))
         (setq piano (append (reverse mesure-piano) piano))))))


(defun calcul-piano (mesure)
  (let* ((accord1 (notes-piano (car mesure)))
         (accord2 (if (null (cdr mesure)) accord1 (notes-piano (cadr mesure)))))
    (rythme-piano accord1 accord2)))

(defun calcul-basse (mesure) 
  (let* ((basse1 (notes-basse (caar mesure)))
         (basse2 (if (null (cdr mesure)) (+ basse1 7) (notes-basse (caadr mesure)))))
    (rythme-basse basse1 basse2)))


;;; Calcul du rythme: 
;;; ----------------- 
;;; Chaque mesure = liste de (silence accord-ou-note duree) 
;;; silence, duree = nbre de ticks (96 = noire) 
;;; accord-ou-note = liste de codes midi (piano), ou 1 code midi (basse)

(defun rythme-piano (accord1 accord2)
  (let ((choix-rythme (if (equal accord1 accord2) (random 2) (+ 2 (random 3)))))
    (case choix-rythme
      (0 (list (list 0 accord1 384)))                           ;;; UN ACCORD: ronde
      (1 (list (list 48 accord1 336)))                          ;;; demi-soupir/blanche-double-pointee
      (2 (list (list 0 accord1 192) (list 0 accord2 192)))      ;;; DEUX ACCORDS: blanche/blanche
      (3 (list (list 48 accord1 144) (list 0 accord2 192)))     ;;; demi-soupir/noire-pointee/blanche
      (4 (list (list 0 accord1 192) (list 48 accord2 144))))))  ;;; blanche/demi-soupir/noire-pointee


(defun rythme-basse (basse1 basse2) (list (list 0 basse1 192) (list 0 basse2 192)))


;;; Calcul des notes: 
;;; -----------------

(defun notes-piano (chiffrage)
  (let ((fondamentale (car chiffrage)))
    (when (eq fondamentale 'Db) (setq fondamentale 'C#))
    (when (eq fondamentale 'Gb) (setq fondamentale 'F#))
    (case (cadr chiffrage)
     (m7 (position-mineur-sept fondamentale))
     (7 (position-dominante-sept fondamentale))
     (7M (position-majeur-sept fondamentale)))))

(defun position-registre (fondamentale tranche1 position1 tranche2 position2)
  (let ((rang-fond1  (member fondamentale tranche1)))
    (if rang-fond1 (decaler-position position1 (- (length tranche1) (length rang-fond1)))
        (decaler-position position2 (- (length tranche2) (length (member fondamentale tranche2)))))))))


;;; II mineur 7 (m7) 
;;; ----------- 
;;; Gm7-Dm7: sol1 fa2 sib2 re3 la3 / Ebm7-F#m7: mib2 solb2 reb3 fa3 sib3

(defun position-mineur-sept (fondamentale)
  (position-registre fondamentale '(G Ab A Bb B C C# D) '(43 53 58 62 69) '(Eb E F F#) '(51 54 61 65 70)))


;;; Dominante (7) 
;;; ---------

(defun position-dominante-sept (fondamentale)
  (if (= (random 3) 0) (position-dominante-sept-sus4 fondamentale)   ;;; 1 fois sur 3
      (position-dominante-sept fondamentale)))

;;; position1: C7-G7: do2 mi2 sib2 re3 la3 / Ab7-B7: lab1 solb2 do3 fa3 sib3

(defun position-dominante-sept (fondamentale)
  (position-registre fondamentale '(C C# D Eb E F F# G) '(48 52 58 62 69) '(Ab A Bb B) '(44 54 60 65 70)))

;;; position2 (sus4): C7-G7: do2 sib2 re3 fa3 la3 / Ab7-F#7: lab1 solb2 sib2 reb3 fa3

(defun position-dominante-sept-sus4 (fondamentale)
  (position-registre fondamentale '(C C# D Eb E F F# G) '(48 58 62 65 69) '(Ab A Bb B) '(44 54 58 61 65)))


;;; I Majeur 7 (7M) 
;;; ---------- 
;;; F7M-C7M: fa1 mi2 la2 do3 sol3 / Db7M-E7M: reb2 fa2 do3 mib3 lab3

(defun position-majeur-sept (fondamentale)
  (position-registre fondamentale '(F F# G Ab A Bb B C) '(41 52 57 60 67) '(C# D Eb E) '(49 53 60 63 68)))


(defun decaler-position (position decalage)
  (mapcar #'(lambda (x) (+ x decalage)) position))


(defun notes-basse (fondamentale)
  (case fondamentale (C 36) ((C# Db) 37) (D 38) (Eb 39) (E 40) (F 41) ((F# Gb) 42)
        (G 43) (Ab 44) (A 45) (Bb 46) (B 47)))