Jump to content

AM

Members
 View Profile  See their activity

  • Posts

    792

  • Joined

  • Last visited

 Content Type 

Posts posted by AM

    I have this error message with (length-chordize-map) when evaluating this score

    in Support & Troubleshooting

    Posted

    when i evaluate this: 

      (setf pianomainHarm (tonality-map (append  (gen-repeat 4 '((scale2)))
                       (gen-repeat 4 '((scale1)))
                       (gen-repeat 4 '((scale3)))
                       ) pianomain))

    Error: 

    > Error: scale2 is not a tonality or a chord.
> While executing: make-tonality, in process Listener-1(6).
> Type cmd-. to abort, cmd-\ for a list of available restarts.
> Type :? for other options.

     

    so, take a look what is your scale2 etc

    or it's in YOUR library, so i can't test YOUR score/code

    Looking for a function that could do that

    in Support & Troubleshooting

    Posted 

    ;;; in "pure lisp" with NIL when lists have not the same length

(defun trans* (lists)
  (loop repeat (car (last (sort-asc (mapcar 'length lists))))
    for cnt = 0 then (incf cnt)
    collect (loop for i in lists
                collect (nth cnt i))))
  
(trans* '((1 2 3 4) (a b c d) (11 12 13 14) (k l m n)))
(trans* '((1 2 3 4) (a b c d e) (11 12 13 14 14 16) (k l m n o p q r s t)))
(trans* '((1 2 3 4) (a b c d e) (11 12 13 14) (k l m n r s t)))

     

    reset-pitch-sequence

    in User Extensions Source Code

    Posted

    reset a pitch-sequence on a specific pitch (lowest, highest, middle pitch of the sequence)

      

    ;;;; SUB


(defun center-position-in-list (list &key (get-value 'nil))
  (let ((pos))
    (progn
      (setf pos (if (evenp (length list))
                  (/ (length list) 2)
                  (/ (1+ (length list)) 2)))
      (if (equal get-value 'nil)
        (append pos)
        (nth (1- pos) list)))))


;;; MAIN

(defun reset-pitch-sequence (pitch-sequence pitch &key (type 'low))
  (let ((pitch1 (cond  ((equal type 'low)
                        (car (find-ambitus pitch-sequence :type :pitch)))
                       ((equal type 'high)
                        (cadr (find-ambitus pitch-sequence :type :pitch)))
                       ((equal type 'center) 
                        (center-position-in-list pitch-sequence :get-value t)))))
    (pitch-transpose (car (pitch-to-interval (list (if (chordp pitch1)
                                                     (car (pitch-melodize pitch1))
                                                     (append pitch1))
                                                   pitch))) pitch-sequence)))



(reset-pitch-sequence '(gs2 g2 a2 fs2 ds2 f2 e2) 'fs3 :type 'low)
=> (b3 bb3 c4 a3 fs3 gs3 g3)

(reset-pitch-sequence '(gs2 g2 a2 fs2 ds2 f2 e2) 'fs3 :type 'high)
=> (f3 e3 fs3 eb3 c3 d3 cs3)

(reset-pitch-sequence '(gs2 g2 a2 fs2 ds2 f2 e2) 'fs3 :type 'center)
=> (f3 e3 fs3 eb3 c3 d3 cs3)

     

     

    gen-integer-step*

    in User Extensions Source Code

    Posted · Edited by AM
    added some stuff

    same with gen-integer-step

      

    (defun gen-integer-step* (n intervals &key (offset 0) (every-x 1) (reverse nil))
  (let ((n (* n every-x)) (seq)) 
      (setf seq (find-everyother every-x (subseq (gen-integer-step 0 (+ n offset) intervals) offset (+ n offset))))
      (if (equal reverse nil)
        seq
        (reverse seq))))


(gen-integer-step* 20 '(1 -2 3 1))
=> (0 1 -1 2 3 4 2 5 6 7 5 8 9 10 8 11 12 13 11 14)

(gen-integer-step* 20 '(1 -2 3 1) :every-x 2)
=> (0 -1 3 2 6 5 9 8 12 11 15 14 18 17 21 20 24 23 27 26)

(gen-integer-step* 20 '(1 -2 3 1) :offset 6 :every-x 4 :reverse t)
 => (59 56 53 50 47 44 41 38 35 32 29 26 23 20 17 14 11 8 5 2)


;;;; in combination with "reading-list-by-steps"

(defun reading-list-by-steps (&key steps values (start (car values)))
  (let ((pos (car (position-item start values))))
    (append (list (nth pos values))
            (loop for i in steps
              do (setf pos (+ pos i))
              when (> pos (length values))
              do (setf pos (+ 0 i))
              collect (nth pos values)))))

(list-plot
 (reading-list-by-steps :steps (gen-repeat 5 '(1 2 -1 3 4 -1))
                        :values (gen-integer-step* 100 '(1 2 3 1) :offset 4 :reverse t))
 :join-points t)

     

    fibonacci*

    in User Extensions Source Code

    Posted · Edited by AM
    added some stuff

    same with fibonacci 

    (defun fibonacci* (n &key (offset 0) (every-x 1) (reverse nil))
  (let ((n (* n every-x)) (seq)) 
      (setf seq (find-everyother every-x (subseq (fibonacci 0 (+ n offset)) offset (+ n offset))))
      (if (equal reverse nil)
        seq
        (reverse seq))))


(fibonacci* 5 :offset 2)
=> (1 2 3 5 8)

(fibonacci* 5 :offset 5 :every-x 2)
=> (5 13 34 89 233)

(fibonacci* 5 :offset 5 :every-x 2 :reverse t)
=> (233 89 34 13 5)


;;;; in combination with "reading-list-by-steps"

(defun reading-list-by-steps (&key steps values (start (car values)))
  (let ((pos (car (position-item start values))))
    (append (list (nth pos values))
            (loop for i in steps
              do (setf pos (+ pos i))
              when (> pos (length values))
              do (setf pos (+ 0 i))
              collect (nth pos values)))))

(list-plot
 (reading-list-by-steps :steps '(1 -1 4 -3 2 -1 3 -2 4 1 1 -1)
                        :values (fibonacci* 14 :offset 6 :reverse t)
                        :start 89)
 :join-points t)

     

    primes*

    in User Extensions Source Code

    Posted · Edited by AM
    added some stuff

    a little prime-function-extension 

    (defun primes* (n &key (offset 0) (every-x 1) (reverse nil))
  (let ((n (* n every-x)) (seq)) 
    (progn 
      (setf seq (find-everyother every-x (subseq (primes (+ n offset)) offset (+ n offset))))
      (if (equal reverse nil)
        seq
        (reverse seq)))))



(primes* 4 :offset 0)
=> (2 3 5 7)

(primes* 4 :offset 1)
=> (3 5 7 11)

(primes* 6 :offset 8)
=> (23 29 31 37 41 43)

(primes* 5 :offset 5 :every-x 2)
=> (13 19 29 37 43)

(primes* 5 :offset 3 :every-x 4)
=> (7 19 37 53 71)

(primes* 5 :offset 5 :every-x 3 :reverse t)
=> (61 47 37 23 13)


;;;; in combination with "reading-list-by-steps"

(defun reading-list-by-steps (&key steps values (start (car values)))
  (let ((pos (car (position-item start values))))
    (append (list (nth pos values))
            (loop for i in steps
              do (setf pos (+ pos i))
              when (> pos (length values))
              do (setf pos (+ 0 i))
              collect (nth pos values)))))

(list-plot
 (reading-list-by-steps :steps '(1 2 -1 3 4 -1)
                        :values (primes* 10 :offset 4 :reverse t))
  :join-points t)

     

    sum-list-items*

    in User Extensions Source Code

    Posted

    new version, for LISTS with different-lengths => compensated

      

    ;;; SUB

(defun compensate-list-lengths (somelists &key (value 0))
  (let ((maxlength (find-max (mapcar 'length somelists))))
    (loop for i in somelists
      when (< (length i) maxlength)
      collect (append i (loop repeat (- maxlength (length i))
                          collect value))
      else collect i)))

                     
;;; MAIN 
                     
(defun sum-list-items (somelists &key (each-step nil))
  (let ((somelists (compensate-list-lengths  somelists))
        (lista (car somelists)) (firstlist (car somelists)))
    (progn
      (setf somelists (loop for x in (rest somelists)
                        collect (setf lista (loop 
                                              for i in lista
                                              for j in x
                                              collect (+ i j)))))
      (if (equal each-step t)
        (append (list firstlist) somelists)
        (car (last somelists))))))

;;;
                     
(sum-list-items '((1 0 4 4 4 4 4 4 0 1) (81 0 0 0) (0 0 1 1 99 200)))
=> (82 0 5 5 103 204 4 4 0 1)

     

    integer-to-binary-lengths*

    in User Extensions Source Code

    Posted

    perhaps there's a OM-solution... in this case it's to hard to find... (search-engine?)

    otherwise...

      

    
(defun integer-to-binary-lengths* (alist)
  (loop for i in alist
    when (> (abs i) 1)
    append (append (list 1) (loop repeat (- (abs i) 1)
                      collect 0))
    else collect 1))
  

(integer-to-binary-lengths* '(2 2 2 1 1 4 4 4 4))
(integer-to-binary-lengths* '(6 4 8 5 2 1 10 2))

     

    sum-list-items*

    in User Extensions Source Code

    Posted

    very simple, i used something like this for my work... but is there somthing like this in OM?

    greetings 

    andré

     

      

    (defun sum-list-items* (somelists &key (each-step nil))
  (let ((lista (car somelists)) (firstlist (car somelists)))
    (progn
      (setf somelists (loop for x in (rest somelists)
                        collect (setf lista (loop 
                                              for i in lista
                                              for j in x
                                              collect (+ i j)))))
      (if (equal each-step t)
        (append (list firstlist) somelists)
        (car (last somelists))))))
  

(sum-list-items* '((1 0 0 1) (1 0 0 0) (0 0 1 1)))
(sum-list-items* '((1 0 0 1) (1 0 0 0) (0 0 1 1)) :each-step t)


(sum-list-items* '((1 0 8 1) (2 0 0 0) (0 -1 3 1)))
(sum-list-items* '((1 0 8 1) (2 0 0 0) (0 -1 3 1)) :each-step t)

     

    extended gen-symmetrical*

    in User Extensions Source Code

    Posted

    some extensions to the basic function...

    greetings

    andré

      

    ;;; SUB

(defun rnd-pick* (alist)
  (if (and (listp (first alist)) 
           (floatp (second (first alist))))
    (weighted-random alist)
    (rnd-pick alist)))


(defun weighted-random (list)
  (loop for item in list
    with rand-num = (random (loop for x in list sum (second x)))
    for add = (second item) then (+ add (second item))
    when (< rand-num add) return (first item)))


;;; MAIN


(defun gen-symmetrical* (n list &key (type 'nil))
  (if (equal type 'hierarchic)

    (progn 
      (let ((alist (butlast list))
            (center (last list)))
        (if (> n (* 2 (length list)))
          'list-has-too-few-items
          (if (evenp n)
            (progn
              (setf alist (loop repeat (/ n 2)
                            for i in alist
                            collect (rnd-pick* i)))
              (append alist (reverse alist)))
            (progn 
              (setf alist (loop repeat (/ (1- n) 2)
                            for i in alist
                            collect (rnd-pick* i)))
              (append alist (list (rnd-pick* (flatten center))) (reverse alist)))))))
    
    (progn 
      (let ((list (rnd-order list))
            (newlist (rest list))
            (center (car list)))   
        
        (if (> n (* 2 (length list)))
          'list-has-too-few-items
          (if (evenp n)
            (progn
              (setf list (rnd-unique (/ n 2) newlist))
              (append list (reverse list)))
            (progn 
              (setf list (rnd-unique (/ (1- n) 2) (rest newlist)))
              (append list (list center) (reverse list)))))))))
  




;;ordinario

(gen-symmetrical* 5 '(1 2 3 4 5 6 7 8))



;;unmittelbare wiederholungen möglich

(gen-symmetrical* 9 '(1 2 3 4 5 6 7 8) :repeat t)



;;werte kommen nur doppelt vor durch die symmetrie-
;;bildung, aber nicht auf einer der symmetrieseiten.

(gen-symmetrical* 9 '(1 2 3 4 5 6 7 8) :style 'unique)
(gen-symmetrical* 30 '(1 2 3 4 5 6 7 8) :style 'unique)
;;=> list-has-too-few-items 



;;bei ":type 'hierarchic" wird immer zuerst aus der 
;;ersten sublist ausgewählt, dann aus der zweiten etc...

(gen-symmetrical*  6 '((a b c) 
                       (6 7) 
                       (8 9) 
                       (10 11)) 
                   :style 'unique
                   :type 'hierarchic)


;;auch mit weight möglich

(gen-symmetrical*  5 '(((1 0.2) (2 0.8)) 
                       ((4 0.1) (5 0.9)) 
                       (6 7) 
                       (8 9) 
                       (10 11)) 
                   :style 'unique	
                   :type 'hierarchic)

     

    gen-stacc

    in User Extensions Source Code

    Posted

    could be interesting for you... an really extend gen-stacc-function :cool:

    greetings

    andré

      

    ;;; SUB

(defun center-position-in-list (list &key (get-value 'nil))
  (let ((pos))
    (progn
      (setf pos (if (evenp (length list))
                  (/ (length list) 2)
                  (/ (1+ (length list)) 2)))
      (if (equal get-value 'nil)
        (append pos)
        (nth (1- pos) list)))))


;(center-position-in-list '(1 2 3 4 x 4 3 2 1) :get-value nil)
;(center-position-in-list '(1 2 3 4 x 4 3 2 1) :get-value t)


(defun gen-stacc3 (n-liste liste &key (stacc-chance 1))
  (loop for i in liste
    with n
    do (setq n (rnd-pick* n-liste))
    when (and (> i n) (equal (weighted-t/nil stacc-chance) 't))
    append (list n (* -1 (- (abs i) n)))
    else collect i))

;(gen-stacc3 '(1/2) '(3 4 5 3 2 1) :stacc-chance 0.5)
;(gen-stacc3 '(1/32 3/32) '(3/32 5/32  14/8) :stacc-chance 0.5)


;;; MAIN

(defun gen-stacc* (liste &key 
                         (symmetrical 'nil) 
                         (stacc-chance 1) 
                         (possible-stacc-lengths 'nil)
                         (no-center-stacc 'nil))
  (let ((alist liste) (blist) (val)
        (n (/ 1 (find-max (mapcar 'denominator liste)))))

    (if (equal symmetrical 'nil)
      ;;bei unsymmetrischen strukturen
      (gen-stacc3 (if (equal possible-stacc-lengths 'nil) 
                    (list n)
                    possible-stacc-lengths)
                    liste :stacc-chance stacc-chance)
      ;;bei symmetrischen strukturen
      (if (evenp (length liste))
        (progn 
          (setf alist (gen-stacc3 (if (equal possible-stacc-lengths 'nil) 
                                    (list n)
                                    possible-stacc-lengths) 
                                  (filter-first (/ (length liste) 2) liste)
                                  :stacc-chance stacc-chance))

          (setf blist (flatten (loop for i in (reverse (gen-divide 2 alist))
                                 collect (reverse i))))
          (append alist blist))
        
        (progn 
          (setf alist (gen-stacc3 (if (equal possible-stacc-lengths 'nil) 
                                    (list n)
                                    possible-stacc-lengths)
                                  (filter-first (/ (1- (length liste)) 2) liste)
                                  :stacc-chance stacc-chance))
          (setf blist (flatten (loop for i in (reverse (gen-divide 2 alist))
                                 collect (reverse i))))
          (append alist 
                  (if (equal no-center-stacc 't)
                    (list (center-position-in-list liste :get-value t))
                    (progn 
                      (setf val (/ (center-position-in-list liste :get-value t) 3))
                      (list (* -1 val) val (* -1 val))))
                  blist))))))


;; ordinario
(gen-stacc* (gen-length '(4 5 6 3 6 5 4) 1/20)) 

;; vorgebener stacc-wert
(gen-stacc* '(4 5 6 3 6 5 4) 
            :possible-stacc-lengths '(1/4))


;; wählt rnd die längen der stacc-values
(gen-stacc* '(4 5 6 3 6 5 4) 
            :possible-stacc-lengths '(2/32 1/32 5/32 1/4))

;; rnd-stacc
(gen-stacc* (gen-length '(4 5 6 3 6 5 4) 1/32) 
            :stacc-chance 0.4)

;; rnd-stacc mit verschiedenen möglichen stacc-lengths
(gen-stacc* (gen-length '(4 5 6 3 6 5 4) 1/32) 
            :stacc-chance 0.7
            :possible-stacc-lengths '(2/32 1/32))

;; symm-strukturen werden berücksichtigt
(gen-stacc* (gen-length '(4 5 6 7 6 5 4) 1/32) 
            :symmetrical t
            :no-center-stacc t)

;; ohne stacc bei center-value
(gen-stacc* (gen-length '(4 5 6 7 6 5 4) 1/32) 
            :symmetrical t
            :no-center-stacc t)

     

    gen-symmetrical (with rnd-unique)

    in User Extensions Source Code

    Posted 

    ;;; alternative function for GEN-SYMMETRICAL: in combination 
;;; with FIND-UNIQUE => symmetries with unique items (except 
;;; what is generated by symmetry)


(defun gen-symmetrical* (n list)
  (let ((list (rnd-order list))
        (newlist (rest list))
        (center (car list)))   

    (if (> n (* 2 (length list)))
      'list-has-too-few-items
      (if (evenp n)
        (progn
          (setf list (rnd-unique (/ n 2) newlist))
          (append list (reverse list)))
        (progn 
          (setf list (rnd-unique (/ (1- n) 2) (rest newlist)))
          (append list (list center) (reverse list)))))))
  

(gen-symmetrical* 5 '(1 2 3 4 5 6 7 8))
(gen-symmetrical* 9 '(1 2 3 4 5 6 7 8))

(gen-symmetrical* 30 '(1 2 3 4 5 6 7 8))
=> list-has-too-few-items ; error-message

     

    shift-proportions

    in User Extensions Source Code

    Posted 

    ;;; CODE
            
(defun shift-proportions (integer-seq  shift &key (type 'primes))
  (let ((number-seq))
    (progn 
      (setf number-seq (cond ((equal type 'primes)
                              (primes 30))
                             ((equal type 'fibonacci)
                              (fibonacci 1 20))
                             ((equal type 'decimal)
                              (gen-integer-step 1 200 1))))
      (setf number-seq (append (reverse (neg! number-seq)) number-seq))
      (loop for i in integer-seq
        when (> i 0)
        collect (nth (+ (car (position-item i number-seq)) shift) number-seq)
        else collect (nth (- (car (position-item i number-seq)) shift) number-seq)))))


;;; EXAMPLE => the integer-seq must include only values from ":type"-system

(shift-proportions '(1 2 3 4 5 -3 2 -1 3 -8) 1 :type 'decimal)
=> (2 3 4 5 6 -4 3 -2 4 -9)
(shift-proportions '(1 2 -13 4 5 -3 2 -1 3 -8) 8 :type 'decimal)
=> (9 10 -21 12 13 -11 10 -9 11 -16)


(shift-proportions '(3 5 -17 -11 23) 1 :type 'primes)
=> (5 7 -19 -13 29)
(shift-proportions '(3 5 -17 -11 23) 5 :type 'primes)
=> (17 19 -37 -29 43)


(shift-proportions '(-5 55 -34 233 -89) 1 :type 'fibonacci)
=> (-8 89 -55 377 -144)
(shift-proportions '(-5 55 -34 233 -89) 3 :type 'fibonacci)
=> (-21 233 -144 987 -377)

     

    User functions supporting arbitrary OMN input – defining them more easily

    in OMN Lingo

    Posted

    perhaps something like that? only a sketch... modify it... don't work in all cases...

      

    ;;; SUBFUNCTIONS

;;; TAKES A GIVEN TONAILTY AND EXPAND IT FOR X OCTAVES

(defun multiple-expand-tonality (&key startpitch octaves tonality)
  (remove-duplicates 
   (loop repeat octaves
     with pitch = startpitch
     with cnt = 0 

     when (= cnt (length tonality))
     do (setq cnt 0)

     append (expand-tonality (list pitch (nth cnt tonality)))
     do (incf cnt)
     do (setq pitch (car (pitch-transpose 12 (list pitch)))))))


;;; EXPAND A TONALITY BY STEPS -> in a sense of schillinger?

(defun tonality-with-scale-expansion (tonality expansion-nr)
  (let ((expansion (nth expansion-nr '(0 1 2 3 4 5 6))))
     (reading-list-by-steps :steps (gen-repeat 53 expansion)
                            :values (multiple-expand-tonality :startpitch 'c0 
                                                              :octaves 8 
                                                              :tonality (list tonality))    
                            :start 'c0)))
  

;;; READS THE PITCHSEQUQNZ IN A TONALITY NOT AS INTERVALS , READS IT AS STEPS (IN A GIVEN PITCHFIELD)

(defun get-steps (tonality pitches)
  (let ((tonality-space (multiple-expand-tonality :startpitch 'c0 
                                                  :octaves 8 
                                                  :tonality (list tonality))))
    (difference (loop for i in pitches
                  append (position-item i tonality-space)))))


;;; READS A LIST NY STEPS AND NOT BY INTERVALS -> USEFULL WHEN WORKING WITH PITCHFIELDS
;;; ALSO AVAILABLE IN TONALITY-MAP!!!

(defun reading-list-by-steps (&key steps values start)
  (let ((pos (car (position-item start values))))
    (append (list (nth pos values))
            (loop for i in steps
              do (setf pos (+ pos i))
              when (>= pos (length values))
              do (setf pos (+ 0 i))
              collect (nth pos values)))))


;;; filter-pitches-octave-independent

(defun filter-pitches-octave-independent (pitches filter-pitch &key (bandwith 10))
  (let ((search-field (loop for j in filter-pitch
                        append (append
                                (reverse (loop repeat (/ bandwith 2)
                                           with p1 = (pitch-to-midi j)
                                           collect (setq p1 (- p1 12))))
                                (list (pitch-to-midi j))
                                (loop repeat (/ bandwith 2)
                                  with p2 = (pitch-to-midi j)
                                  collect (setq p2 (+ p2 12)))))))
    
    (loop for i in (pitch-to-midi pitches)
      when (not (null (member i search-field)))
      collect (midi-to-pitch i))))





;;; MAIN_FUNCTION ---------------------------------------------------------------------------------------------------------------------

(defun expand-melody (expansion-nr tonality melody)
  (let ((start-pitch (nth expansion-nr (expand-tonality (list 'c4 (car (list tonality))))))
        (new-tonality (tonality-with-scale-expansion tonality expansion-nr)))
    (pitch-transpose-start start-pitch
                           (reading-list-by-steps :steps (get-steps 'major melody)
                                                  :values new-tonality
                                                  :start (car (filter-pitches-octave-independent new-tonality (list start-pitch)))))))


(expand-melody 1 'major '(c4 f4 e4 f4 g4 a4))
(expand-melody 2 'major '(c4 f4 e4 f4 g4 a4))
(expand-melody 3 'major '(c4 f4 e4 f4 g4 a4))
(expand-melody 4 'major '(c4 f4 e4 f4 g4 a4))

     

    a simple lisp question

    in User Extensions Source Code

    Posted

    is it possible to do such a (nonsense-function) with mapcar (then with loop)?

    -> how should i handle the &key (y 1) with mapcar? possible? a function without &key is clear but with &key ....???

     

    thanx for a note

      

    (defun testfu (value &key (y 1))
  (* (random 10) value y))

(loop 
  for i in '(1 2 3 4 5)
  for j in '(1 2 3 4 5)
  collect (testfu i :y j))

     

    Omn Function

    in Support & Troubleshooting

    Posted

    you could work with omn-replace (from OM-library)? ...or some other code... have a look... greetings andré 

    ;;; THREE SIMILAR FUNCTIONS FROM MY USER LIBRARY

;;; recognizes the parameter who has to be replaced
(defun omn-component-replace (omn-sequence replace-component)
  (make-omn :length (if (lengthp (car replace-component))
                     (append replace-component)
                     (omn :length omn-sequence))
            :pitch (if (or (pitchp (car replace-component)) (chordp (car replace-component)))
                     (append replace-component)
                     (omn :pitch omn-sequence))
            :velocity (if (velocityp (car replace-component))
                        (append replace-component)
                        (omn :velocity omn-sequence))
            :articulation (if (articulationp (car replace-component))
                            (append replace-component)
                            (omn :articulation omn-sequence))))

;;; the same with multiple inputs at once
(defun omn-component-replace2 (omn-sequence replace-component)
  (car (last (loop for i in replace-component
               collect (setf omn-sequence
                             (make-omn :length (if (lengthp (car i))
                                                 (append i)
                                                 (omn :length omn-sequence))
                                       :pitch (if (pitchp (car i))
                                                (append i)
                                                (omn :pitch omn-sequence))
                                       :velocity (if (velocityp (car i))
                                                   (append i)
                                                   (omn :velocity omn-sequence))
                                       :articulation (if (articulationp (car i))
                                                       (append i)
                                                       (omn :articulation omn-sequence))))))))


;;; replaces a single element
(defun omn-single-element-replace (omn-list old new)
  (let ((new-list (loop for i in (cond ((lengthp old)
                                        (omn :length (flatten omn-list)))
                                       ((pitchp old)
                                        (omn :pitch (flatten omn-list)))
                                       ((velocityp old)
                                        (omn :velocity (flatten omn-list)))
                                       ((articulationp old)
                                        (omn :articulation (flatten omn-list))))
                                        
                    when (equal i old) collect new
                    else collect i)))
    (omn-component-replace (flatten omn-list) new-list)))

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

;;; EXAMPLES


(setf seq1 '(s gs3 ppp tasto q.t cs4 pppp tasto s f4 ppp tasto))

(omn-component-replace seq1 '(5/16 7/16 3/32))
=> (qs gs3 ppp tasto q.. cs4 pppp tasto s. f4 ppp tasto)




(omn-component-replace2 '(S C4 PPP TASTO Q.T D4 PPPP TASTO S E4 PPP TASTO) '((p) (ponte) (e2 b2 d2)))
=> (S E2 P PONTE Q.T B2 PONTE S D2 PONTE)



(omn-single-element-replace '(t gs4 pppp tasto a4 tasto bb4 tasto -t) 'bb4 'c4)
=> (t gs4 pppp tasto a4 tasto c4 tasto -)

(omn-single-element-replace '(t gs4 pppp tasto a4 tasto bb4 tasto -t) 'pppp 'ff)
=> (t gs4 ff tasto a4 tasto bb4 tasto -)

     

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy

  I accept