Jump to content
  1. opmo

    opmo

  • Similar Topics

    • By AM
      hi all
       
      the following function could be usefull, it's a first sketch, but it seems to work....
       
      if you want to INSERT a new OMN-seq, perhaps in bar 2 on the 3/20 in your BASIC-OMN-sequence... with this function you can do this, it will overwrite your original phrase.
      test it or tell me whatelse would be better...
       
      greetings
      andré
       
      ;;; ------------------------------------------------------------------------ ;;; INSERTING SEQ BY OVERWRITING ;;; ------------------------------------------------------------------------ ;;; SUB (defun get-resolution2 (beat) (cond ((memberp (cadr beat) '(3 6 12 24 48)) 1/24) ((memberp (cadr beat) '(1 2 4 8 16 32)) 1/16) ((memberp (cadr beat) '(5 10 20 40)) 1/20) ((memberp (cadr beat) '(7 14 28 56)) 1/28))) ;;; MAIN: INSERTING SEQ BY OVERWRITING (defun inserting-on-bar/beat* (seq &key insert time-sign bar beat) (let ((resolution (get-resolution2 beat)) (ord-time-sign time-sign) (time-sign (if (listp (car time-sign)) (loop for i in time-sign when (> (caddr i) 1) append (loop repeat (caddr i) collect (list (car i) (cadr i))) else collect (list (car i) (cadr i))) (append time-sign))) (distance (if (listp (car time-sign)) (+ (car (loop repeat (- bar 1) for i in time-sign collect (/ (* (1- bar) (/ (car i) (cadr i))) (get-resolution2 beat)))) (/ (/ (1- (car beat)) (cadr beat)) (get-resolution2 beat))) (+ (/ (* (1- bar) (/ (car time-sign) (cadr time-sign))) (get-resolution2 beat)) (/ (/ (1- (car beat)) (cadr beat)) (get-resolution2 beat)))))) (omn-to-time-signature (omn-merge-ties (flatten (loop repeat (length (omn-to-time-signature seq (list (numerator resolution) (denominator resolution)))) for cnt = 0 then (incf cnt) with new-seq = (omn-to-time-signature seq (list (numerator resolution) (denominator resolution))) with insert-rounded = (append insert (rest (length-rational-quantize (list (apply '+ (omn :length insert))) :round resolution))) when (= cnt distance) collect insert-rounded and do (setf cnt (+ (/ (get-span (flatten insert-rounded)) resolution) cnt -1)) else collect (nth cnt new-seq)))) ord-time-sign))) ;;; EXAMPLES (inserting-on-bar/beat* '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5)) :insert '(s f3 e3 eb3 d3) :time-sign '(3 4) :bar 2 :beat '(2 16)) (inserting-on-bar/beat* '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5)) :insert '(3q c5 b4 bb4 a4) :time-sign '(3 4) :bar 1 :beat '(2 12)) ;;; EXAMPLE WITH different TIME-SIGNATURES (inserting-on-bar/beat* '(e c6 a5 h b5 tie q b5 b5 a5 tie h a5 q a5 h. g5) :insert '(5q c5 b4 bb4 a4) :time-sign '((2 4 1) (3 8 1) (5 8 1) (3 4 1)) :bar 3 :beat '(3 20))  
    • By AM
      ;;; gets the position => bar and beat where the value is ;;; => could be used in combination with "inserting-on-bar/beat*", ;;; if you are looking for a specific value to sprout a sequqnce ;;; FUNCTION (defun get-position (seq value &key (get 'all)) (let ((beat) (bar (car (loop for i in seq for bar = 1 then (incf bar) append (loop for j in (single-events i) when (pattern-matchp j (list value)) collect bar))))) (progn (setf beat (loop for k in (loop for i in (single-events (nth (1- bar) seq)) when (not (pattern-matchp i (list value))) append (omn :length i) else collect 'match) when (numberp k) collect (abs k) into bag when (equal k 'match) do (return (list (1+ (numerator (abs (sum bag)))) (denominator (abs (sum bag)))))))) (cond ((equal get 'all) (list bar beat)) ((equal get 'bar) (append bar)) ((equal get 'beat) (append beat))))) ;;; EXAMPLES: (setf seq '((h c4 q q) (e f4 pp f4 mp f4) (-3q 3q cs5 -3q h))) (get-position seq 'cs5 :get 'all) (get-position seq 'cs5 :get 'bar) (get-position seq 'cs5 :get 'beat) (get-position seq 'pp :get 'all)  
    • By AM
      take it as a sketch... you can see the input/output
      greetings andré
       
      p.s. could be nice, if we combine it with a/the/my overwrite-function
      p.s.s an overwrite-function could be very very smart for work... think: for example: you have coded some music but you would overwrite the last two quaternotes of bar  5 in the violin.... !?
       
       
      ;;; ------------------------------------------------------------------------ ;;; INSERTING ON BAR/BEAT ;;; ------------------------------------------------------------------------ (defun inserting-on-bar/beat (insert &key time-sign bar beat) (let ((extra-rest (* -1 (/ (- (car beat) 1) (cadr beat)))) (basic-time-sign time-sign) (time-sign (if (listp (car time-sign)) (loop for i in time-sign when (> (caddr i) 1) append (loop repeat (caddr i) collect (list (car i) (cadr i))) else collect (list (car i) (cadr i))) (append time-sign)))) (omn-to-time-signature (length-rest-merge (flatten (append (if (> bar 1) (list (if (listp (car time-sign)) (loop repeat (- bar 1) for i in time-sign collect (* -1 (/ (car i) (cadr i)))) (* -1 (1- bar) (/ (car time-sign) (cadr time-sign)))))) (length-rational-quantize (if (/= 0 extra-rest) (append (list extra-rest) insert) insert) :round (if (listp (car time-sign)) (/ (car (nth bar time-sign)) (cadr (nth bar time-sign))) (/ (car time-sign) (cadr time-sign))))))) basic-time-sign))) ;;; ------------------------------------------------------------------------ ;;; INSERTING ON BAR/BEAT ;;; ------------------------------------------------------------------------ (inserting-on-bar/beat '(s c4 d4 e4 f4 pp) :time-sign '(4 4) :bar 2 :beat '(3 16)) (inserting-on-bar/beat '(5q c4 d4 e4 f4 pp) :time-sign '(4 4) :bar 2 :beat '(2 20)) (inserting-on-bar/beat '(3q c4 d4 e4 f4 pp) :time-sign '(4 4) :bar 1 :beat '(5 12)) (inserting-on-bar/beat '(s c4 d4 e4 f4 pp) :time-sign '((2 4 1) (3 8 1) (5 8 1) (3 4 1)) :bar 3 :beat '(3 16))  
×
×
  • Create New...