omn-rnd-vars

[Stephane Boussuge]

here's a useful function (for me at least) who use unfold internally to apply some variations from a reservoir to some OMN material. This function can surely be much improved (adding seed etc...) but actually I'm using it like this...

Example of usage is at the end of the function definition file, a short string quartet example.

 

;;; OMN-RND-VAR
;;; Base sur ma vieille pratique
;;; avec omn-rnd-variations1.

(defun generate-variation (max-length num-measures)
  "Generate a sorted list of unique random numbers based on num-measures."
  (sort-asc (find-unique (rnd-number num-measures 1 max-length :norep t))))

(defun omn-rnd-var (variations measures omn-sequence &key (uset 'om))
  "Application de variations via unfold avec une liste de variations et mesures correspondantes."
  (let ((max-length (length omn-sequence))
        (variation-list '()))
    (dolist (pair (mapcar #'cons variations measures))
      (let ((var (car pair))
            (num-measures (cdr pair)))
        (push (list var (generate-variation max-length num-measures)) variation-list)))
    (unfold uset (reverse variation-list) omn-sequence )))

#!
;; Exemple d'appel de l a fonction
;; Note: Le nombre de mesure n'est pas toujours exact
;; en raison de l'appel de find unique dans la fonction
;; generate variations afin de generer les index aleatoires
;; de mesure sans repetition, find-unique donc qui peut entrainer
;; la suppression de certains index qui etaient repetes. 

;; Attention, pour que la fonction fonctionne bien,
;; Les 2 listes variations et measures doivent etre
;; de la meme longueur (meme nombre d'elements).

;; Possibilite d'utiliser un unfold set personel avec uset.
(setf omn-mat (gen-trim 8 '((e c4 fs4 d4 a4 c5 g4 d4 e4))))
(omn-rnd-var '(ld12 ld42 d) '(2 4 3) omn-mat)
(omn-rnd-var '(ld12 ld42 d) '(2 5 3) omn-mat :uset 'om) ;replace 'om by your own unfold set.

;; Exemple d'utilisation:
(setf mat1 '((s c4 d4 e4 fs4 q b4)))
(setf vars1.n 24)
(setf vars1 (length-legato
             (omn-rnd-var 
              '(ad da d ld12mx ld22mx i ri ra rr4 pf2 rop 7-15 stacc dl1)
              '(3   8 3  4     4      2  2  2 8   8   8   8    11    12)
              (gen-repeat vars1.n mat1)) 
             ))

(setf idx1 (vector-round 1 vars1.n (gen-noise vars1.n)))
(setf idx2 (vector-round 1 vars1.n (gen-noise vars1.n)))
(setf idx3 (vector-round 1 vars1.n (gen-noise vars1.n)))
(setf idx4 (vector-round 1 vars1.n (gen-noise vars1.n)))

(setf line1 (vector-map vars1 idx1))
(setf line2 (vector-map vars1 idx2))
(setf line3 (vector-map vars1 idx3))
(setf line4 (vector-map vars1 idx4))

(setf vn1 (ambitus 'violin (pitch-transpose 8 line1)))
(setf vn2 (ambitus 'violin (pitch-transpose 0 line2)))
(setf vla (ambitus 'viola (pitch-transpose -8 line3)))
(setf vlc (ambitus 'cello (pitch-transpose -18 line4)))

(ps 'gm :sq (list vn1 vn2 vla vlc))
!#