convert-to-binary

[AM]

for my current project i have to CONVERT/MAP pitches/lengths/velocity or MIDI into a binary sequence. so i coded this simple FUNCTION... feel free to use/adapt....

 

greetings

andré

 

 

(defun fill-to-x-bit (listseq &key (bitlength 7))
  (loop for i in listseq
    when (< (length i) bitlength)
    collect (append (gen-repeat (- bitlength (length i)) 0) i)
    else collect i))

;;;; CONVERT PITCH/LENGTH or VELOCITY TO BINARY INFORMATION

(defun convert-to-binary (alist &key (parameter 'pitch) (length-resolution 127) (velocity-resolution 127) (pitch-resolution 127) (event nil)  (bitlength 7))
  (let ((pitch) (length) (velocity)
        (alist (progn 
                 (setf alist (cond ((stringp alist)
                                    (flatten (midi-to-omn alist :instrument 1)))
                                   (t alist)))
                 
                 (if (omn-formp alist)
                   (cond ((equal parameter 'pitch)
                          (setf alist (omn :pitch alist)))
                         ((equal parameter 'length)
                          (setf alist (omn :length alist)))
                         ((equal parameter 'velocity)
                          (setf alist (omn :velocity alist)))
                         ((equal event 't)
                          (setf alist (single-events alist))))
                         alist))))
                           
    (if (null event)
      (cond ((pitchp (car alist))
             (progn
               (setf alist  (pitch-to-midi (pitch-melodize alist)))
               (fill-to-x-bit (decimal-to-binary (vector-round 0 (if (null pitch-resolution)
                                                                  (- (find-max alist) (find-min alist))
                                                                  pitch-resolution) alist)) :bitlength bitlength)))
            
            ((lengthp (car alist))
             (fill-to-x-bit (decimal-to-binary  (vector-round 1 length-resolution (mapcar 'float (omn :length alist)))) :bitlength bitlength))
            
            ((velocityp (car alist))
             (fill-to-x-bit (decimal-to-binary  (vector-round 1 velocity-resolution (get-velocity  alist))) :bitlength bitlength)))

      (progn 
        (setf pitch (progn
                      (setf alist  (pitch-to-midi (pitch-melodize  (omn :pitch alist))))
                      (fill-to-x-bit (decimal-to-binary (vector-round 0 (if (null pitch-resolution)
                                                                         (- (find-max alist) (find-min alist))
                                                                         pitch-resolution) alist)) :bitlength bitlength)))
        (setf length (fill-to-x-bit (decimal-to-binary  (vector-round 1 length-resolution (mapcar 'float (omn :length alist)))) :bitlength bitlength))
        (setf velocity (fill-to-x-bit (decimal-to-binary  (vector-round 1 velocity-resolution (get-velocity  (omn :velocity alist))))  :bitlength bitlength))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(convert-to-binary '(c4 cs5 fs3 c5 f5) :bitlength 15)
(convert-to-binary '(-e e -q h e) :bitlength 15)
(convert-to-binary '(p p ffff mp ) :bitlength 15)

 

 

 

[AM]

here is another little function to COMBINE the binary-information i got from CONVERT-TO-BINARY  -> gen a new structure from it

 

so, with CONVERT-FROM-BINARY and BINARY-LAYER-ADD you could do things like:

compose music => convert to binary data => generate music by this data  .... ad infinitum  conceptual ....

 

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ADDING 3 BINARY-LAYERS IN A WAY THAT INFORMATION COULD BE ENCODED
;;; first layer with 0/1
;;; second layer with 0/2
;;; third layer with 0/4

(defun binary-layer-add (lists)
  (loop 
    for i in (first lists)
    for j in (second lists)
    for k in (if (null (third lists))
               (gen-repeat (length (second lists)) 0)
               (third lists))

    collect (+ i (* j 2)  (* k 4))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(list-plot 
 (binary-layer-add (list
                    (flatten (convert-to-binary '(c4 cs5 fs3 c5 f5) :bitlength 8))
                    (flatten (convert-to-binary '(-e h -q h e) :bitlength 8))
                    (flatten (convert-to-binary '(p p  ffff mp mf ) :bitlength 8))))
 :join-points t
 :point-radius 0)

(list-plot 
 (binary-layer-add (list
                    (flatten (convert-to-binary '(c4 cs5 fs3 c5 f5) :bitlength 32))
                    (flatten (convert-to-binary '(-e h -q h e) :bitlength 32))
                    (flatten (convert-to-binary '(p p  ffff mp mf ) :bitlength 32))))
 :join-points t
 :point-radius 0)

(list-plot 
 (binary-layer-add (list
                    (flatten (convert-to-binary '(c4 cs5 fs3 c5 f5) :bitlength 16))
                    (flatten (convert-to-binary '(-e h -q h e) :bitlength 16  :length-resolution 64))
                    (flatten (convert-to-binary '(p p  ffff mp mf ) :bitlength 16))))
 :join-points t
 :point-radius 0)

 

[AM]

this little CONCEPTUAL project goes on:

 

converting "something" (musical paramters in this case) into a binary form and reconvert it (binary back into musical parameters) => like kind of A/D-D/A-converters and have a look how "the reality is different/changing", experimenting with mapping/resolution etc... i don't think primarily musically with this work but more technically and see what results from that.

 

;;; SUB

(defun fill-to-x-bit (listseq &key (bitlength 7))
  (loop for i in listseq
    when (< (length i) bitlength)
    collect (append (gen-repeat (- bitlength (length i)) 0) i)
    else collect i))


(defun length/rest-to-binary (alist)
  (loop for i in alist
    when (length-restp i)
    collect 0 else collect 1))




;;;; CONVERTING PITCH/LENGTH or VELOCITY TO BINARY INFORMATION

(defun convert-to-binary (alist &key (parameter 'pitch) (lengthspan '(24 100)) (velocity-resolution 127) (pitch-resolution 127) (bitlength 7))
  (let (
        (alist (progn 
                 (setf alist (cond ((stringp alist)
                                    (flatten (midi-to-omn alist :instrument 1)))
                                   (t alist)))
                 
                 (if (omn-formp alist)
                   (cond ((equal parameter 'pitch)
                          (setf alist (omn :pitch alist)))
                         ((equal parameter 'length)
                          (setf alist (omn :length alist)))
                         ((equal parameter 'velocity)
                          (setf alist (omn :velocity alist))))
                         alist))))
                           
      (cond ((pitchp (car alist))
             (progn
               (setf alist  (pitch-to-midi (pitch-melodize alist)))
               (fill-to-x-bit (decimal-to-binary (vector-round 1 (if (null pitch-resolution)
                                                                  (- (find-max alist) (find-min alist))
                                                                  pitch-resolution) alist)) :bitlength bitlength)))
            
            ((lengthp (car alist))
             (fill-to-x-bit (decimal-to-binary 
                             (vector-round (car lengthspan) (cadr lengthspan) (mapcar 'float (omn :length alist)))) :bitlength bitlength))
            
            ((velocityp (car alist))
             (fill-to-x-bit (decimal-to-binary 
                             (vector-round 1 velocity-resolution (get-velocity  alist))) :bitlength bitlength)))))


;;;; CONVERTING BINARY INFORMATION BACK TO OMN

(defun convert-to-omn (binlist &key (parameter 'pitch) (lengthspan '4/4) (length/rest nil) (velocityspan '(pppp ffff)) 
                               (pitchspan '(c3 c5)) (bitlength 8))
  (let ((binlist (gen-divide bitlength (flatten binlist))))
                           
    (cond ((equal parameter 'pitch)
           (midi-to-pitch (vector-round (car (pitch-to-midi pitchspan)) (cadr (pitch-to-midi pitchspan)) (binary-to-decimal binlist))))
          ((equal parameter 'length)
           (if (null length/rest)
             (gen-length-constant (binary-to-decimal binlist) lengthspan)
             (loop 
               for i in (gen-length-constant (binary-to-decimal binlist) lengthspan)
               for j in length/rest
               when (= j 0) collect (* i -1) else collect i)))
               

          ((equal parameter 'velocity)
           (vector-to-velocity (car (get-velocity (list (car velocityspan)))) 
                    (car (get-velocity (list (cadr velocityspan))))
                    (loop for i in  (binary-to-decimal binlist)
                      collect (* i (float (/ 1 (sum (binary-to-decimal binlist)))))))))))
          

 

 

evaluate here and you see the original and reconverted SAMPLE

 

;;; SOME EXAMPLES OF THE PROCESS SEQ to BINARY, THEN MAPPED BACK TO OMN
;;; IF THE BITLENGTHS ARE DIFFERENT YOU GET DIFFERENT RESulTS
;;; ALSO DIFFERENT RESULTS WITH VELOCITY / LENGTHS => it depends on RESOLUTION etc...

;; cmd-E or cmd-1


(pitch-list-plot
 (list
  (setf seq '(c4 cs5 fs3 c5 f5) );; original
  (convert-to-omn (convert-to-binary seq :bitlength 32) ;; reconverted
                  :bitlength 32
                  :pitchspan (get-ambitus seq :type :pitch)))

 :join-points t)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(length-list-plot
 (list
  (setf seq '(-e e -q h e)) ;; original

  (convert-to-omn (convert-to-binary seq :bitlength 32) ;; reconverted
                  :parameter 'length
                  :length/rest (length/rest-to-binary seq)
                  :bitlength 32
                  :lengthspan '4/4))
 :join-points t)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(velocity-list-plot
 (list
  (setf seq '(p p ffff mp )) ;; original
  (convert-to-omn (convert-to-binary seq :bitlength 32) ;; reconverted
                  :parameter 'velocity
                  :bitlength 32
                  :velocityspan '(ppp mf)))

 :join-points t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

[Stephane Boussuge]

Very interesting, thanks !

[AM]

ANTON WEBERN - Variationen für Klavier Op.27, I 

converted into BINARY INFORMATION // "Verdoppelung der Welt" //

 

(inspired by Armin Nassehi's Book  "Muster - Theorie der digitalten Gesellschaft")