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

  • http://www.midi.org
  • Spécifications Midi : http://usuarios.maptel.es/jbercher/Midispec.htm
  • Documents : http://www.harmony-central.com/MIDI/Doc/
  • Tables des codes Midi : http://www.musique.umontreal.ca/electro/MAX/Midi.html

  • Fichier obtenu : essai.mid

    
    ;;; ================================ 
    ;;; Ecriremidifile.drs / 23 mai 2002 
    ;;; ================================
    
    ;;; EXEMPLE: 
    ;;; (ecrire-midifile '(4 4) 120 '((60 96) (62 96) (64 192)) "essai.mid")
    
    (define (ecrire-midifile signature tempo liste-couples fich)
      (sauve-midifile (conversion-midifile signature tempo liste-couples) fich))
    
    (define (sauve-midifile liste-octets fich)
      (when (file-exists? fich) (delete-file fich)
        (let ((p (open-output-file fich)))
          (ecrire-liste liste-octets p)
          (close-output-port p))))
    
    (define (ecrire-liste liste-octets port)
      (cond ((null? liste-octets) 'stop)
            (else (write-char (integer->char (car liste-octets)) port)
               (ecrire-liste (cdr liste-octets) port))))
    
    
    ;;; Conversion d'un Midifile: 
    ;;; ------------------------- 
    ;;; EXEMPLE: (conversion-midifile '(4 4) 120 '((60 96) (62 96) (64 192))) 
    ;;;          signature = (4 4)  ;;; 4/4 
    ;;;          tempo = 120     ;;; nbre de noires/60 secondes 
    ;;;          liste-couples ( ) = ((60 96) (62 96) (64 192))    
    ;;; -> do3 "noire" 96 ticks, re3 "noire" 96 ticks, mi3 "blanche" 192 ticks 
    ;;; 1 "tick" = "division" de la pulsation (donnee par le header)        
    ;;; donne: 
    ;;; (#x4D #x54 #x68 #x64            ;;; M T h d 
    ;;;  #x00 #x00 #x00 #x06            ;;; longueur = 6 octets 
    ;;;  #x00 #x00 #x00 #x01 #x00 #xC0  ;;; format=0, 1 track, division=192 
    ;;;  #x4D #x54 #x72 #x6B                            ;;; M T r k 
    ;;;  #x00 #x00 #x00 #x2C                            ;;; longueur 
    ;;;  #x00 #xFF #x58 #x04 #x04 #x02 #x18 #x08        ;;; signature 
    ;;;  #x00 #xFF #x51 #x03 #x07 #xA1 #x20             ;;; tempo 
    ;;;  #x00 #x90 #x3C #x3C #x60 #x80 #x3C #x00        ;;; do3 
    ;;;  #x00 #x90 #x3E #x3C #x60 #x80 #x3E #x00        ;;; re3 
    ;;;  #x00 #x90 #x40 #x3C #x81 #x40 #x80 #x40  #x00  ;;; mi3 
    ;;;  #x00 #xFF #x2F #x00)                           ;;; end of track
    
    (define (conversion-midifile signature tempo liste-couples)
      (append (creer-header-chunk 0 1 192) (creer-track-chunk signature tempo liste-couples)))
    
    (define (creer-header-chunk format nbre-tracks division)
      (append (map char->integer (list #\M #\T #\h #\d))
              (list #x00 #x00 #x00 #x06)    ;;; longueur = 6 octets
              (list #x00 format)    ;;; format 0
              (list #x00 nbre-tracks)    ;;; nbre de track chunks = 1
              (list #x00 division)))  ;;; "division" (nbre de "ticks"/pulsation) = 192
    
    ;;; Ascii: (char->integer #\a) -> 97, (integer->char 97) -> #\a
    
    
    (define (creer-track-chunk signature tempo liste-couples)
      (append (map char->integer (list #\M #\T #\r #\k))
              (let ((liste-octets (calcul-octets signature tempo liste-couples)))
                (append (calcul-longueur (+ (length liste-octets) 4)) 
                        liste-octets
                        (list #x00 #xFF #x2F #x00)))))   ;;; end of track
    
    (define (calcul-octets signature tempo liste-couples)
      (append (calcul-signature signature) (calcul-tempo tempo) (calcul-liste-notes liste-couples)))
    
    ;;; Meta-evenement signature FF 58: a l'instant 0, par defaut 4/4
    
    (define (calcul-signature couple) 
      (list #x00 #xFF #x58 #x04 (car couple) (inexact->exact (truncate (/ (log (cadr couple)) (log 2)))) #x18 #x08))
    
    ;;; Meta-evenement tempo FF 51: a l'instant 0, duree noire en microsecondes sur 3 octets
    
    (define (calcul-tempo tempo)
      (let ((n (/ (* 60 1000000) tempo)))
        (list #x00 #xFF #x51 #x03 
              (logand (quotient n #x10000) #xFF)
              (logand (quotient n #x100) #xFF)
              (logand n #xFF))))
    
    (define (calcul-liste-notes liste-couples)
      (if (null? liste-couples) ()
          (append (calcul-note (car liste-couples))
                  (calcul-liste-notes (cdr liste-couples)))))
    
    (define (calcul-note couple)
      (append (list #x00 #x90 (car couple) #x3C)   ;;; NoteOn
              (append (calcul-deltatime (cadr couple)) 
                      (list #x80 (car couple) #x00))))   ;;; NoteOff
    
    ;;; Deltatime a longueur variable, sur 1 ou 2 octets de 7 bits 
    ;;; (0 en tete s'il y en a un, 1 et 0 en tete s'il y a en a deux) 
    ;;; EXEMPLE: 159 ticks = 128+16+8+4+2+1 
    ;;; donne (1)000 0001  (0)001 1111 = #x81 #x1F 
    ;;; La valeur max avec deux octets = 16383 ticks = 85 noires (div de 192) 
    
    (define (calcul-deltatime duree)
      (let* ((new-octet (logand duree #x7F))
             (liste-octets (list new-octet)))
        (do ((d (quotient duree #x80) (quotient d #x80)))
            ((= d 0) liste-octets)
          (set! new-octet (logand d #x7F))   ;;; 7 derniers bits
          (set! liste-octets (cons (logior #x80 new-octet) liste-octets)))))
    
    (define (logand n1 n2)
      (cond ((or (= n1 0) (= n2 0)) 0)
            (else (+ (* (remainder n1 2) (remainder n2 2))
                     (* 2 (logand (quotient n1 2) (quotient n2 2)))))))
    
    (define (logior n1 n2)
      (cond ((and (= n1 0) (= n2 0)) 0)
            (else (+ (min (+ (remainder n1 2) (remainder n2 2)) 1)
                     (* 2 (logior (quotient n1 2) (quotient n2 2)))))))
    
    ;;; Longueur du track chunk sur 4 octets:
    
    (define (calcul-longueur n)
      (list (logand (quotient n #x1000000) #xFF)
            (logand (quotient n #x10000) #xFF)
            (logand (quotient n #x100) #xFF)
            (logand n #xFF)))