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

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×