score Make-chord-if-length study

Stephane Boussuge · November 1, 2018

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))
   )
  )

AM · November 1, 2018

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"

lviklund · November 1, 2018

Add this to the top of the file:

(add-program-attributes
 '(default)
)

It is not defined.

SB missed to include that .

/Lasse

Stephane Boussuge · November 2, 2018

Thanks Iviklund.

indeed, default articulation is included in my setup from a long time and i forget to put it back here.

have a nice day

SB

Stephane Boussuge · November 2, 2018

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.

Sign In

score Make-chord-if-length study

Recommended Posts

Stephane Boussuge

Link to comment

Share on other sites

AM

Link to comment

Share on other sites

lviklund

Link to comment

Share on other sites

Stephane Boussuge

Link to comment

Share on other sites

Stephane Boussuge

Link to comment

Share on other sites

Join the conversation

Browser

Documents

Examples

GUI

Activity

Downloads

Buy

Important Information