Jump to content
Sign in to follow this  
Stephane Boussuge

Make-chord-if-length study

Recommended Posts

Here's a small piano study using my new function make-chord-if-length and few others from my personal lib.

Enjoy 😉

SB.

 

;;; UTILITIES
;;; ========================================
;;; GEN-PITCH-LINE
;;; Fonction de génération de hauteurs basées sur une conversion de vecteur de bruit
;;; avec un grand choix de type de bruit, taux de compression du vecteur, filtrage des répétitions et ambitus.
(defun gen-pitch-line (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat (type :white))
  (setf seed (rnd-seed seed))
  (let (pitches)
    (do-verbose
        ("gen-pitch-line :seed ~s" seed)
      (labels ((white-or-pink (nb-pitch seed type)
                 (if (eq type ':pink)
                   (gen-pink-noise nb-pitch :seed seed)
                   (gen-white-noise nb-pitch :seed seed :type (if (eq type ':white) :normal type))))
               
               (process  (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat type)
                 (setf pitches (vector-to-pitch ambitus (vector-smooth compress (white-or-pink nb-pitch seed type)))) 
                 (when filter-repeat
                   (setf pitches (gen-trim nb-pitch (filter-repeat filter-repeat pitches))))
                 pitches)
               )
        (process nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type type)))))



#| USAGE
(gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1)
(gen-pitch-line 24 :compress 0.42 :type :pink :filter-repeat 1)
(gen-pitch-line 24 :compress 0.42 :type :extreme :filter-repeat 1)
(gen-eval 
 8
 '(make-omn
   :pitch (gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1)
   :length (euclidean-rhythm 16 1 16 's :type 2)
   )
 :seed 33)
|#


;;; OMN-ARTICULATION-PROCESSOR
(defun omn-articulation-processor (map omn-mat &key (section nil))
  (do-verbose
      ("omn-articulation-processor")
    (let ((artic
           (pattern-map map
                        (omn :length omn-mat)
                        :otherwise '(default) :section section))
          )
      (omn-replace :articulation artic omn-mat)
      )))


;;; MAKE-CHORD-IF-LENGTH
(defun make-chord-if-length-aux (omn &key (test #'>) (length-val 1/8) (interval-list '((4 7)(7 12))) (cycle t)(relative nil) seed)
(setf seed (rnd-seed seed))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      when (funcall test (omn-encode (first e)) length-val)
      append (omn-replace :pitch (gen-chord3  (list (second e))   interval-list :cycle cycle :relative relative :seed (seed)) e )
      else append e)))


(defun make-chord-if-length (omn &key (test #'>) (length-val 1/8) (interval-list '((4 7)(7 12)))(cycle nil)(relative nil) seed)
  (setf seed (rnd-seed seed))
  (do-verbose ("make-chord-if-length :seed ~s :length-val ~s :interval-list ~s :cycle ~s  :relative ~s" seed length-val interval-list cycle relative)
    (let ((test-fn (case test
                     (> #'>)
                     (< #'<)
                     (= #'=)
                     (otherwise test))))
      (if (listp (car omn))
        (mapcar #'(lambda (x) 
                    (make-chord-if-length-aux x :test test-fn :length-val (omn-encode length-val) :interval-list interval-list
                                              :cycle cycle :relative relative :seed (seed))) 
                omn)
        (make-chord-if-length-aux omn :test test-fn :length-val (omn-encode length-val) :interval-list interval-list 
                                  :cycle cycle :relative relative :seed (seed))))))


;;; ========================================
;;;---------------------------------------------------------
;;; Parameters
;;;---------------------------------------------------------
(setf size 24)
(setf flow1 (pitch-transpose
             -7
             (make-omn
              :pitch (gen-pitch-line 128 :compress 0.33 :seed 729353)
              :length (rnd-sample size '((s s s s s s s s -q)
                                         (e e h)(h.)(q q e e)
                                         (e e q q)(s s s s q q)
                                         (q s s s s q)(s s e -e s s q)
                                         )
                                  :seed 729355)
              :velocity (rnd-sample size '((ppp)(pp)(p)(mp)(mf)) :seed 729356)
              )))


(setf flow2 (pitch-transpose
             -4
             (make-omn
              :pitch (gen-pitch-line 128 :compress 0.73 :seed 353)
              :length (rnd-sample size '((h. )
                                         (q. e q)(h.)(q q q)
                                         (h -q)(e e h)
                                         (h e e)
                                         )
                                  :seed 729355)
              :velocity (rnd-sample size '((ppp)(pp)(p)) :seed 729356)
              )))

(setf flow3 (pitch-transpose
             -7
             (make-omn
              :pitch (gen-pitch-line 128 :compress 0.33 :seed 7353)
              :length (rnd-sample size '((s s s s s s s s -q)
                                         (e e h)(h.)(q q e e)
                                         (e e q q)(s s s s q q)
                                         (q s s s s q)(s s e -e s s q)
                                         )
                                  :seed 7255)
              :velocity (rnd-sample size '((ppp)(pp)(p)(mp)(mf)) :seed 7256)
              )))


;;; Articulation remap
(setf map '(((1/16 1/16 1/16 1/16)(leg leg leg default))))

(setf with-ch1 (omn-articulation-processor
                map 
                (pitch-ornament
                 (make-chord-if-length
                  flow1
                  :interval-list '((-7 -19 3 9)(-4 -16 3 7)
                                   (-5 -17 4 12)(-3 -15 7))
                  :cycle nil
                  :relative t
                  :seed 729358
                  ))))


(setf with-ch2 (omn-articulation-processor
                map 
                (pitch-ornament
                 (make-chord-if-length
                  flow2
                  :interval-list '((-7 -19 3 9)(-4 -16 3 7)
                                   (-5 -17 4 12)(-3 -15 7))
                  :cycle nil
                  :relative t
                  :seed 729358
                  ))))

(setf with-ch3 (omn-articulation-processor
                map 
                (pitch-ornament
                 (make-chord-if-length
                  flow3
                  :interval-list '((-7 -19 3 9)(-4 -16 3 7)
                                   (-5 -17 4 12)(-3 -15 7))
                  :cycle nil
                  :relative t
                  :seed 729358
                  ))))


;;; SCORE ASSEMBLY
(setf piano-rh (omn-replace 
                :articulation
                '(default leg leg leg default fermata-l)
                (ambitus-filter
                 '(c4 c8)
                 (assemble-seq with-ch1 with-ch2 with-ch3))
                :section '(71)))

(setf piano-lh (omn-replace 
                :articulation
                '(default fermata-l)
                (ambitus-filter 
                 '(c0 b3)
                 (assemble-seq with-ch1 with-ch2 with-ch3))
                :section '(71)))


;;;---------------------------------------------------------
;;; Score and Layout
;;;---------------------------------------------------------

(def-score Study
           (:title "Mcil-study"
            :composer "S.Boussuge"
            :copyright "Copyright © 2018 s.boussuge "
            :key-signature 'chromatic
            :time-signature '((1 1 1) 4)
            :tempo 82
            :layout (piano-solo-layout 'piano-rh 'piano-lh))
  
  (piano-rh
   :omn piano-rh
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano
   :volume 100
   :pan 64
   :controllers (91 '(48))
   )
  
  (piano-lh
   :omn piano-lh
   :channel 2
   :controllers (91 '(48))
   )
  )

 

Share this post


Link to post
Share on other sites

i get an error... when i evaluate this

 

(setf with-ch1 (omn-articulation-processor
                map 
                (pitch-ornament
                 (make-chord-if-length
                  flow1
                  :interval-list '((-7 -19 3 9)(-4 -16 3 7)
                                   (-5 -17 4 12)(-3 -15 7))
                  :cycle nil
                  :relative t
                  :seed 729358
                  ))))

 

> Error: OMN Parse Error: fail
> While executing: omn-to-ast, in process Listener-2(13).
> Type cmd-. to abort, cmd-\ for a list of available restarts.
> Type :? for other options.

... problem seems to be: "omn-articulation-processor"

 

Share this post


Link to post
Share on other sites

Add this to the top of the file:

 

(add-program-attributes
 '(default)
)

It is not defined.

SB missed to include that 🙂.

 

/Lasse

Share this post


Link to post
Share on other sites

EDIT:

 

Sligthly improved version with chord-interval-replace for finalising the final score assembly:

 

;;; UTILITIES
;;; ========================================
;;; GEN-PITCH-LINE
;;; Fonction de génération de hauteurs basées sur une conversion de vecteur de bruit
;;; avec un grand choix de type de bruit, taux de compression du vecteur, filtrage des répétitions et ambitus.
(defun gen-pitch-line (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat (type :white))
  (setf seed (rnd-seed seed))
  (let (pitches)
    (do-verbose
        ("gen-pitch-line :seed ~s" seed)
      (labels ((white-or-pink (nb-pitch seed type)
                 (if (eq type ':pink)
                   (gen-pink-noise nb-pitch :seed seed)
                   (gen-white-noise nb-pitch :seed seed :type (if (eq type ':white) :normal type))))
               
               (process  (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat type)
                 (setf pitches (vector-to-pitch ambitus (vector-smooth compress (white-or-pink nb-pitch seed type)))) 
                 (when filter-repeat
                   (setf pitches (gen-trim nb-pitch (filter-repeat filter-repeat pitches))))
                 pitches)
               )
        (process nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type type)))))



#| USAGE
(gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1)
(gen-pitch-line 24 :compress 0.42 :type :pink :filter-repeat 1)
(gen-pitch-line 24 :compress 0.42 :type :extreme :filter-repeat 1)
(gen-eval 
 8
 '(make-omn
   :pitch (gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1)
   :length (euclidean-rhythm 16 1 16 's :type 2)
   )
 :seed 33)
|#


;;; OMN-ARTICULATION-PROCESSOR
(defun omn-articulation-processor (map omn-mat &key (section nil))
  (do-verbose
      ("omn-articulation-processor")
    (let ((artic
           (pattern-map map
                        (omn :length omn-mat)
                        :otherwise '(default) :section section))
          )
      (omn-replace :articulation artic omn-mat)
      )))


;;; MAKE-CHORD-IF-LENGTH
(defun make-chord-if-length-aux (omn &key (test #'>) (length-val 1/8) (interval-list '((4 7)(7 12))) (cycle t)(relative nil) seed)
(setf seed (rnd-seed seed))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      when (funcall test (omn-encode (first e)) length-val)
      append (omn-replace :pitch (gen-chord3  (list (second e))   interval-list :cycle cycle :relative relative :seed (seed)) e )
      else append e)))


(defun make-chord-if-length (omn &key (test #'>) (length-val 1/8) (interval-list '((4 7)(7 12)))(cycle nil)(relative nil) seed)
  (setf seed (rnd-seed seed))
  (do-verbose ("make-chord-if-length :seed ~s :length-val ~s :interval-list ~s :cycle ~s  :relative ~s" seed length-val interval-list cycle relative)
    (let ((test-fn (case test
                     (> #'>)
                     (< #'<)
                     (= #'=)
                     (otherwise test))))
      (if (listp (car omn))
        (mapcar #'(lambda (x) 
                    (make-chord-if-length-aux x :test test-fn :length-val (omn-encode length-val) :interval-list interval-list
                                              :cycle cycle :relative relative :seed (seed))) 
                omn)
        (make-chord-if-length-aux omn :test test-fn :length-val (omn-encode length-val) :interval-list interval-list 
                                  :cycle cycle :relative relative :seed (seed))))))


;;; ========================================
;;;---------------------------------------------------------
;;; Parameters
;;;---------------------------------------------------------
(setf size 24)
(setf flow1 (pitch-transpose
             -7
             (make-omn
              :pitch (gen-pitch-line 128 :compress 0.33 :seed 729353)
              :length (rnd-sample size '((s s s s s s s s -q)
                                         (e e h)(h.)(q q e e)
                                         (e e q q)(s s s s q q)
                                         (q s s s s q)(s s e -e s s q)
                                         )
                                  :seed 729355)
              :velocity (rnd-sample size '((ppp)(pp)(p)(mp)(mf)) :seed 729356)
              )))


(setf flow2 (pitch-transpose
             -4
             (make-omn
              :pitch (gen-pitch-line 128 :compress 0.73 :seed 353)
              :length (rnd-sample size '((h. )
                                         (q. e q)(h.)(q q q)
                                         (h -q)(e e h)
                                         (h e e)
                                         )
                                  :seed 729355)
              :velocity (rnd-sample size '((ppp)(pp)(p)) :seed 729356)
              )))

(setf flow3 (pitch-transpose
             -7
             (make-omn
              :pitch (gen-pitch-line 128 :compress 0.33 :seed 7353)
              :length (rnd-sample size '((s s s s s s s s -q)
                                         (e e h)(h.)(q q e e)
                                         (e e q q)(s s s s q q)
                                         (q s s s s q)(s s e -e s s q)
                                         )
                                  :seed 7255)
              :velocity (rnd-sample size '((ppp)(pp)(p)(mp)(mf)) :seed 7256)
              )))


;;; Articulation remap
(setf map '(((1/16 1/16 1/16 1/16)(leg leg leg default))))

(setf with-ch1 (omn-articulation-processor
                map 
                (pitch-ornament
                 (make-chord-if-length
                  flow1
                  :interval-list '((-7 -19 3 9)(-4 -16 3 7)
                                   (-5 -17 4 12)(-3 -15 7))
                  :cycle nil
                  :relative t
                  :seed 729358
                  ))))


(setf with-ch2 (omn-articulation-processor
                map 
                (pitch-ornament
                 (make-chord-if-length
                  flow2
                  :interval-list '((-7 -19 3 9)(-4 -16 3 7)
                                   (-5 -17 4 12)(-3 -15 7))
                  :cycle nil
                  :relative t
                  :seed 729358
                  ))))

(setf with-ch3 (omn-articulation-processor
                map 
                (pitch-ornament
                 (make-chord-if-length
                  flow3
                  :interval-list '((-7 -19 3 9)(-4 -16 3 7)
                                   (-5 -17 4 12)(-3 -15 7))
                  :cycle nil
                  :relative t
                  :seed 729358
                  ))))


;;; SCORE ASSEMBLY
(setf piano-rh (chord-interval-replace
                '(0 1 2)
                '(4 3 4)
                (omn-replace 
                 :articulation
                 '(default leg leg leg default fermata-l)
                 (ambitus-filter
                  '(c4 c8)
                  (assemble-seq with-ch1 with-ch2 with-ch3))
                 :section '(71))))

(setf piano-lh (chord-interval-replace
                '(0 1 2)
                '(4 3 4)
                (omn-replace 
                 :articulation
                 '(default fermata-l)
                 (ambitus-filter 
                  '(c0 b3)
                  (assemble-seq with-ch1 with-ch2 with-ch3))
                 :section '(71))))


;;;---------------------------------------------------------
;;; Score and Layout
;;;---------------------------------------------------------

(def-score Study
           (:title "Mcil-study"
            :composer "S.Boussuge"
            :copyright "Copyright © 2018 s.boussuge "
            :key-signature 'chromatic
            :time-signature '((1 1 1) 4)
            :tempo 82
            :layout (piano-solo-layout 'piano-rh 'piano-lh))
  
  (piano-rh
   :omn piano-rh
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano
   :volume 100
   :pan 64
   :controllers (91 '(48))
   )
  
  (piano-lh
   :omn piano-lh
   :channel 2
   :controllers (91 '(48))
   )
  )

SB.

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  

  • Similar Topics

    • By Stephane Boussuge
      A piano solo Study.
       

      SB.
    • By ajf-
      Here is my study about the klangreihen: 
       
      (defparameter tempo 60) (defparameter title "Klangreihen Study") ;;; This object takes care of setting and getting of parts (defclass study-score () ((instruments :initarg :instruments :initform 0) (duration :initarg :duration :initform 0) (parts))) ;;; When initializing, fill it with an empty model for parts (array of size N) (defmethod initialize-instance :after ((score study-score) &key) (let ((instruments (slot-value score 'instruments ))) (setf (slot-value score 'parts) (make-array instruments :initial-element '(-w)' :fill-pointer instruments)))) ;;; Getter and setter methods (defun get-part (score n) (elt (slot-value score 'parts) n )) (defun (setf part) (part score n) (let ((previous-value (elt (slot-value score 'parts) n))) (setf (elt (slot-value score 'parts) n) (concatenate 'list previous-value part)))) ;;; Instance of the object (defparameter study (make-instance 'study-score :instruments 16 :duration tempo)) ;;; Main procedure (let* ;; Main local variables ((12tone '(0 2 4 5 7 9 6 8 10 11 1 3)) (variants (list (row-variant 0 'r4 12tone) (row-variant 0 '4 12tone))) (total-parts (slot-value study 'instruments)) (bases (apply #'append (map 'list #'(lambda (v) (klangreihen 0 '(3 3 3 3) v)) variants))) (lengths (subseq (gen-divide total-parts (gen-length (distributive-cube (interference2 '(3 2 2))) 16)) 0 (length bases)))) (loop for base in bases for length in lengths do (labels ;; Local transformative functions ((amount-of (n) (/ 1 (nth n length))) (vel-scale (v) (+ 0.2 (* 0.6 v) )) (vel-format (v) (get-velocity (list v) :type :symbol)) (velocity-for (n) (vel-format (vel-scale (/ (amount-of n) 16)))) (length-for (n) (list (nth n length ))) (octave-of (n) (let ((low-bound (- 12 (* 12 (round (* (/ 1 total-parts) n 3.4) ))))) (list low-bound (+ low-bound 12)))) (pitch-for (n) (let* ((rolled (gen-surround base :size (amount-of n) :start n))) (ambitus (octave-of n) rolled)))) (loop for n from 0 to (- total-parts 1) do (destructuring-bind (&key length pitch velocity) ;; Example of handling on a case-by-case basis. No extra cases configured now. (case n (otherwise (list :length (length-for n) :velocity (velocity-for n) :pitch (pitch-for n) ))) (setf (part study n) (make-omn :length length :pitch pitch :velocity velocity :span :pitch))))))) ;;; Retrieve parts and save score (let ((partnum -1)) (def-score Study (:title title :composer "A. Jacomet" :key-signature 'atonal :time-signature '(4 4) :tempo tempo :layout (string-ensemble-layout '(vn11 vn12 vn13 vn14 vn21 vn22 vn23 vn24) '(vla1 vla2 vla3 vla4) '(vlc1 vlc2) '(ctb1 ctb2))) (vn11 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 1) (vn12 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 2) (vn13 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 3) (vn14 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 4) (vn21 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 5) (vn22 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 6) (vn23 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 7) (vn24 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 8) (vla1 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 9) (vla2 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 11) (vla3 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 12) (vla4 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 13) (vlc1 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 14) (vlc2 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 14) (ctb1 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 15) (ctb2 :omn (get-part study (incf partnum)) :sound 'gm :program 'Acoustic-Grand-Piano :channel 15))) (live-coding-midi (compile-score 'Study)) (display-musicxml 'Study) ;;;--------------------------------------------------------- ;;; ANNOTATION ;;;--------------------------------------------------------- #! This study is about the LISP languages and the possibilities of working with object oriented programming and loops. The first important part of this study is the 'study-score' class defined at the top of the file. (defclass study-score () ((instruments :initarg :instruments :initform 0) (duration :initarg :duration :initform 0) (parts))) On initialization, that object will create and save in one of it's properties, a model of the parts, which is an array of lists. (defmethod initialize-instance :after ((score study-score) &key) (let ((instruments (slot-value score 'instruments ))) (setf (slot-value score 'parts) (make-array instruments :initial-element '(-w)' :fill-pointer instruments)))) It is important to note that this can be extended to an N-dimensional array supporting Parts, Pitches, Velocities, Lengths, and more information. We then define trivial functions that are intended to help in adding and retrieving parts. (defun get-part (score n) (elt (slot-value score 'parts) n )) (defun (setf part) (part score n) (let ((previous-value (elt (slot-value score 'parts) n))) (setf (elt (slot-value score 'parts) n) (concatenate 'list previous-value part)))) This will eventually help keep our program free of code redundancy, and we can adapt the parts in any way we like in a global way. The rest is a simple example of utilizing a klangreihen base and looping over it. The loop starts with a LET clause that sets all the basic parameters: (let* ;; Main local variables ((12tone '(0 2 4 5 7 9 6 8 10 11 1 3)) (variants (list (row-variant 0 'r4 12tone) (row-variant 0 '4 12tone))) (total-parts (slot-value study 'instruments)) (bases (apply #'append (map 'list #'(lambda (v) (klangreihen 0 '(3 3 3 3) v)) variants))) (lengths (subseq (gen-divide total-parts (gen-length (distributive-cube (interference2 '(3 2 2))) 16)) 0 (length bases)))) ..... ) Looping over these global parameters, we start to build our theme sequentially, making all parts for each base. (loop for base in bases for length in lengths do (labels ... )) The LABELS special operator allows us to define local functions for our loop body, that will be helpful in transforming the data. Within it's function body, we have the actual loop that loops over the parts: (loop for n from 0 to (- total-parts 1) ...) The DESTRUCTURING-BIND macro allows us to keep our syntax clean and succint, because we can handle different cases using CASE, while setting Length, Velocity and Pitch, and then in a single line, retrieve those values and use them to set that particular omn in the parts array: (destructuring-bind (&key length pitch velocity) ;; Example of handling on a case-by-case basis. No extra cases configured now. (case n (otherwise (list :length (length-for n) :velocity (velocity-for n) :pitch (pitch-for n) ))) (setf (part study n) (make-omn :length length :pitch pitch :velocity velocity :span :pitch))) !#  
×
×
  • Create New...