AM

New: POSITION-SWAP
 
The function POSITION-SWAP swaps the positions of the items within a list.
(position-swap '(0 2) '(0 1 2 3 4 5 6)) => (2 1 0 3 4 5 6) (position-swap '((0 2) (3 5)) '(c4 d4 e4 f4 g4 a4 b4)) => (e4 d4 c4 a4 g4 f4 b4) (position-swap '((0 2) (3 5)) '(c4 d4 e4 f4 g4 a4 b4) :seq t) => ((e4 d4 c4 f4 g4 a4 b4) (e4 d4 c4 a4 g4 f4 b4)) (position-swap '((0 2) (3 5)) '(e c4 f d4 p s e4 mp f4 g4 f a4) :seq t) => ((s e4 mp e d4 p c4 f s f4 mp g4 f a4)     (s e4 mp e d4 p c4 f s a4 g4 f4 mp))  

Hello,
 
Here's an example of a possible way for achieve group instrumentation.
The idea is to create names of instrumental groups and extract some binary list from this groups
for using in do-timeline2 function for apply the instrumentation.
 
The score is also attached to this post.
;;;--------------------------------------------------------- ;;; GROUP INSTRUMENTATION EXAMPLE ;;;--------------------------------------------------------- (setf size 12) ;;; Basic Pitch material generation (setf pmat (integer-to-pitch (rnd-number 24 -4 16))) ;;; Global velocity definition (setf gvel (rnd-sample size '((pp)(p)(mp)(mf)(f)))) ;;; OMN material for each instrument (setf flute (make-omn :pitch (pitch-transpose 12 (rnd-sample-seq (rnd-number size 2 8) (gen-repeat 6 (list pmat)))) :length (euclidean-rhythm (gen-repeat size '(16)) 1 16 's :type '(2)) :velocity gvel )) (setf clarinet (make-omn :pitch (pitch-transpose 7 (rnd-sample-seq (rnd-number size 2 8) (gen-repeat 6 (list pmat)))) :length (euclidean-rhythm (gen-repeat size '(16)) 1 16 's :type '(2)) :velocity gvel )) (setf violin (make-omn :pitch (pitch-transpose 10 (rnd-sample-seq (rnd-number size 2 8) (gen-repeat 6 (list pmat)))) :length (euclidean-rhythm (gen-repeat size '(16)) 1 8 's :type '(2)) :velocity gvel )) (setf violoncello (make-omn :pitch (pitch-transpose -12 (rnd-sample-seq (rnd-number size 2 8) (gen-repeat 6 (list pmat)))) :length (euclidean-rhythm (gen-repeat size '(16)) 1 8 's :type '(2)) :velocity gvel )) (setf piano-rh (make-omn :pitch (pitch-transpose 4 (rnd-sample-seq (rnd-number size 2 8) (gen-repeat 6 (list pmat)))) :length (euclidean-rhythm (gen-repeat size '(16)) 1 8 's :type '(2)) :velocity gvel )) (setf piano-lh (make-omn :pitch (pitch-transpose -17 (rnd-sample-seq (rnd-number size 2 8) (gen-repeat 6 (list pmat)))) :length (euclidean-rhythm (gen-repeat size '(16)) 1 4 's :type '(2)) :velocity gvel )) ;;; GROUP INSTRUMENTATION ;;; the main idea is to generate some binary list ;;; based on the interpretation of "instrumental textures or group names). ;; INSTRUMENTAL GROUPS DEFINITION (setf texture1 '(flute clarinet)) (setf texture2 '(flute violin)) (setf texture3 '(flute clarinet violoncello piano-rh piano lh)) (setf texture4 '(clarinet violin violoncello)) (setf texture5 '(violin violoncello piano-rh piano-lh)) (setf texture6 '(flute)) (setf orch-template '(flute clarinet violin violoncello piano-rh piano-lh )) ;; utility function definition (defun binary-orch1 (orch-template groups) (loop for i in orch-template collect (if (member i groups) 0 1))) ;; main function (defun binary-orch (orch-template groups) (mapcar (lambda(x) (binary-orch1 orch-template x)) groups)) ;; group order choice (setf orchestration1 (apply-eval (rnd-sample size '( texture1 texture2 texture3 texture4 texture5 texture6 )))) ;; generate binary from group order (setf binary-from-orch (binary-orch orch-template orchestration1 )) ;; apply the orchestration (do-timeline2 '(flute clarinet violin violoncello piano-rh piano-lh) (matrix-transpose binary-from-orch) '(gen-pause x) ) ;;;--------------------------------------------------------- ;;; Score and Layout ;;;--------------------------------------------------------- (def-score pierrot-ensemble (:title "Title" :composer "Composer" :copyright "Copyright ©" :key-signature 'chromatic :time-signature '((1 1 1 1) 4) :tempo 71 :layout (list (bracket-group (flute-layout 'flute) (clarinet-layout 'clarinet) (violin-layout 'violin) (violoncello-layout 'violoncello)) (piano-layout 'piano-rh 'piano-lh))) (flute :omn flute :channel 1 :sound 'gm :program 'flute :volume 95 :pan 70 :controllers (91 '(52)) ) (clarinet :omn clarinet :channel 3 :sound 'gm :program 'clarinet :volume 95 :pan 60 :controllers (91 '(57)) ) (violin :omn violin :channel 14 :sound 'gm :program 'violin :volume 100 :pan 16 :controllers (91 '(48)) ) (violoncello :omn violoncello :channel 15 :sound 'gm :program 'cello :volume 90 :pan 95 :controllers (91 '(60)) ) (piano-rh :omn piano-rh :channel 7 :sound 'gm :program 'acoustic-grand-piano :volume 100 :pan 64 :controllers (91 '(60)) ) (piano-lh :omn piano-lh :channel 8 :sound 'gm :program 'acoustic-grand-piano :volume 100 :pan 64 :controllers (91 '(60)) ) )  
 
SB.
ExempleForumInstrumentation.opmo

Opusmodus 1.2.21986 fixed the bug.

Here is a slightly revised version of simplify-dynamics that can also handle nested lists (bars). See documentation string for details and examples.
 
Best,
Torsten
 
(defun simplify-dynamics (dynamics &key (flat T)) "Removes intermediate textual dynamic indicators from longer hairpins (e.g., generated by velocity-to-dynamic or gen-dynamic). Args flat (default T): whether or not to simplify dynamics across sublists. Examples: (simplify-dynamics '(pppp< < ppp< pp< < p< < mp< mf< < f< < ff> > mf> mp> p> ppp> pppp)) => (pppp< < < < < < < < < < < < ff> > > > > > pppp) (simplify-dynamics '((pppp< < ppp< pp< < p< <) (mp< mf< < f< < ff> > mf> mp> p> ppp> pppp))) => ((pppp< < < < < < <) (< < < < < ff> > > > > > pppp)) (simplify-dynamics '((pppp< < ppp< pp< < p< <) (mp< mf< < f< < ff> > mf> mp> p> ppp> pppp)) :flat nil) => ((pppp< < < < < < <) (mp< < < < < ff> > > > > > pppp)) " (if (or flat (not (some #'listp dynamics))) (let ((flat-dynamics (flatten dynamics))) (span dynamics (append (list (first flat-dynamics)) (loop for (d1 d2 d3) on flat-dynamics when (and d2 d3) collect (cond ((or (and (cresc-p d1) (dim-p d3)) (and (dim-p d1) (cresc-p d3))) d2) ((or (and (cresc-p d1) (cresc-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (< (get-velocity d2) (get-velocity d3)))) '<) ((or (and (dim-p d1) (dim-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (> (get-velocity d2) (get-velocity d3)))) '>) (t d2))) (last flat-dynamics)))) (mapcar #'simplify-dynamics dynamics)))  

;;; ---------------------------------------------------------------- ;;; modifying proprtions by add/sub of the smallest/largest values ;;; number of elements is constant / sum of the seq also constant ;;; n => number of generations ;;; prop-list => integers ;;; :style => sharpen or flatten ;;; ---------------------------------------------------------------- (defun modify-proportions (n prop-list &key (style 'sharpen)) (let ((rest-pos (loop for i in prop-list for cnt = 0 then (incf cnt) when (< i 0) collect cnt)) (prop-list (abs! prop-list)) (liste)) (progn (setf liste (append (list prop-list) (loop repeat n when (or (= (length (find-above 1 prop-list)) 1) (= (length (find-unique prop-list)) 1)) collect prop-list else collect (setf prop-list (loop for i in prop-list for cnt = 0 then (incf cnt) collect (cond ((= cnt (position (find-closest 2 (find-above 1 prop-list)) prop-list)) (if (equal style 'sharpen) (1- i) (1+ i))) ((= cnt (position (find-max prop-list) prop-list)) (if (equal style 'sharpen) (1+ i) (1- i))) (t i))))))) (loop for i in liste collect (loop for k in i for cnt = 0 then (incf cnt) when (memberp cnt rest-pos) collect (* -1 k) else collect k))))) ;;; examples (modify-proportions 8 '(4 3 -2 7 3 2 7) :style 'sharpen) (modify-proportions 8 '(4 3 -2 7 3 2 7) :style 'flatten) (omn-to-time-signature (gen-length (modify-proportions 8 '(4 3 2 7) :style 'sharpen) 1/16) '(4 4)) (omn-to-time-signature (gen-length (modify-proportions 8 '(4 3 2 7) :style 'flatten) 1/16) '(4 4)) (list-plot (modify-proportions 10 '(5 3 2 -7 1 8 2)) :point-radius 0 :style :fill)  
...works not in all CASES (when :style 'flatten), but okay...
 

I would like to randomly pick a nested list. That works in principle, but the nesting is lost.
(rnd-pick '(((h q) (h)) ((h. q) (h)) ((h. h) (h)))) => ((3/4 1/4) (1/2)) ; instead returns (3/4 1/4 1/2) I guess I have to roll my own :)
(defun rnd-pick2 (selections &key (prob 0.5) seed) "Randomly selects a value from `selections' (without transforming that value). Very similar to rnd-pick, but leaves selected value unchanged (e.g., unflattened). Args prob: a floating-point number. Probability value. The default is 0.5. Example (rnd-pick2 '(((h q) (h)) ((h. q) (h)) ((h. h) (h)))) => ((h. q) (h)) " (rnd-seed seed) (nth (rnd1 :low 0 :high (1- (length selections)) :prob prob :seed (seed)) selections)) Best,
Torsten

> I would advise to search the library, you might find thinks you never thought of 
 
What strategies do you suggest for searching the rather large library of existing functions. Though this question sounds a bit simple, it really mean it seriously. The search facility only searches through function names, AFAIK, and a name like gen-surround is not exactly easy to guess. What other strategies could be there for finding relevant functions?
 
Better support for finding relevant functions could perhaps be an important addition of version 2?
 
Best,
Torsten
  added 8 minutes later Dear André,
> sampling-list BTW: The built-in Common Lisp function subseq is very similar, see http://www.lispworks.com/documentation/HyperSpec/Body/f_subseq.htm
 
subseq is likely much faster than sampling-list, if that is important: calling nth very often in sampling-list needs to go through the input list again and again.
 
Best,
Torsten

;;; GETTING THE LENGTH-PROPORTIONS AS INTEGERS (defun get-proportions (omn_seq &key (abs 'nil)) (let ((denoms)) (progn (setf denoms (remove-duplicates (loop for i in (omn :length omn_seq) collect (denominator (abs i))))) (loop for i in (omn :length omn_seq) collect (if (equal abs 't) (* (abs i) (apply 'lcm denoms)) (* i (apply 'lcm denoms))))))) ;; examples (get-proportions '(-3q 3h_h. d3 mf)) (get-proportions '(5q 5q 5q 5q 5q -e -s t t -q)) (get-proportions '(5q 5q 5q 5q 5q -e -s t t -q) :abs t) (get-proportions '(-e -t t t t t t t t t -s. -q)) ;;; HOW TO USE (setf rhy '(-3h 3q_5h. 5q 5q c4)) (setf props (get-proportions rhy :abs nil)) ;;; you can use that for GEN-LENGTH-CONSTANT ;; ordinary (gen-length-constant props 'w.) ;; a bit advanced (gen-length-constant props 'h.) ;; crazy (gen-length-constant props 'h._e)  

With nested lists:
(defun get-proportions (sequence &key abs) (do-verbose ("get-proportions") (flet ((get-proportions-l (sequence &key abs) (let* ((length (omn-length sequence)) (den (remove-duplicates (loop for i in length collect (denominator (abs i))) :from-end t))) (loop for i in length collect (if abs (* (abs i) (apply #'lcm den)) (* i (apply #'lcm den))))))) (if (listsp sequence) (loop for i in sequence collect (get-proportions-l i :abs abs)) (get-proportions-l sequence :abs abs))))) (get-proportions '(5q 5q 5q 5q 5q -e -s t t -q)) => (8 8 8 8 8 -20 -10 5 5 -40) (get-proportions '((-e -t t t t) (t t t t t -s. -q))) => ((-4 -1 1 1 1) (1 1 1 1 1 -3 -8))  

;;; GETTING THE LENGTH-PROPORTIONS AS INTEGERS (defun get-proportions (omn_seq &key (abs 'nil)) (let ((denoms)) (progn (setf denoms (remove-duplicates (loop for i in (omn :length omn_seq) collect (denominator (abs i))))) (loop for i in (omn :length omn_seq) collect (if (equal abs 't) (* (abs i) (apply 'lcm denoms)) (* i (apply 'lcm denoms))))))) ;; examples (get-proportions '(-3q 3h_h. d3 mf)) (get-proportions '(5q 5q 5q 5q 5q -e -s t t -q)) (get-proportions '(5q 5q 5q 5q 5q -e -s t t -q) :abs t) (get-proportions '(-e -t t t t t t t t t -s. -q)) ;;; HOW TO USE (setf rhy '(-3h 3q_5h. 5q 5q c4)) (setf props (get-proportions rhy :abs nil)) ;;; you can use that for GEN-LENGTH-CONSTANT ;; ordinary (gen-length-constant props 'w.) ;; a bit advanced (gen-length-constant props 'h.) ;; crazy (gen-length-constant props 'h._e)  

...an idea to manipulate lists of pitches/rhythms by "sampling"
 
;;; subfunction (defun sampling-list (liste start-position seq-length) (loop repeat seq-length for cnt = start-position then (incf cnt) when (= cnt (length liste)) do (setf cnt 0) collect (nth cnt liste))) ;;; MAIN: ;;; an value-list will be sampled by start-pos-list in the length of seq-length-list (defun structural-interferences (n value-list start-pos-list seq-length-list) (let ((start-pos-list (remove (length value-list) start-pos-list :test #'<))) (loop repeat n for start-pos = 0 then (incf start-pos) for seq-length = 0 then (incf seq-length) when (= start-pos (length start-pos-list)) do (setf start-pos 1) when (= seq-length (length seq-length-list)) do (setf seq-length 0) append (sampling-list value-list (nth start-pos start-pos-list) (nth seq-length seq-length-list))))) ;;something (list-plot (structural-interferences 21 '(1 2 3 4 5) '(0 1 2 3 4 5 6 7 8 9) '(1 3 2 4 1 2 2 3 1 1 1 1)) :point-radius 1 :style :fill) ;;"self-similar" (list-plot (structural-interferences 21 '(3 2 1 5 4 2) '(2 1 0 4 3 1) '(3 2 1 5 4 2)) :point-radius 1 :style :fill)  

Function name change:
RANDOMIZE-OCTAVES is now RND-OCTAVES
 
Optimisation:
TONALITY-MAP 
 
To change the function name in all of your scores you can use the 'Search Files...' tool.

if you want to change VELOCITY of a technique... 
 
(defun replace-velocity-of-a-technique (omn-list &key technique velocity) (flatten (loop for i in (single-events omn-list) when (equal (car (omn :articulation i)) technique) collect (pattern-map (list (list (list '? technique) (list velocity technique))) i) else collect i))) (replace-velocity-of-a-technique '(e. c4 p tasto d4 ponte e4) :technique 'tasto :velocity 'f)  

if you want to augm/dim the LENGTH of a special technique... you could use that... or extend it...
 
(defun modify-length-of-a-technique (omn-list &key technique (factor 1) (modification 'augmentation)) (flatten (loop for i in (single-events omn-list) when (equal (car (omn :articulation i)) technique) collect (cond ((equal modification 'augmentation) (length-augmentation factor i)) ((equal modification 'diminution) (length-diminution factor i))) else collect i))) (modify-length-of-a-technique '(q d4 mf ponte e fs4 tasto -e. e g4 tasto q gs4 ponte) :technique 'ponte :factor 10 :modification 'augmentation) ;; also 'diminution  

...except that makes you a fun and makes you happy - and that is just as important!
added 10 minutes later so the question will be what can be better, which will be more exciting than what deep learning (or traditional algorithms) can produce. very fast then - in my opinion - the production becomes quite simple and well done, but this has nothing to do with art (if you want) - it will be the "imitation of art", also algorithmic tools pushing you in this direction - is it "music" or the simulation of "music"?. but as VON FOERSTER said: "the map is the territory"... counteracting (radical-constructivistic) the phrase "the map is not the territory"...
 
 

critical thought about this:
I think in the near future this will work through "deep learning". So it is questionable how useful it is to formalize such manual and traditional "activities", such "complex rules systems" in CODE. this question generally arises in areas that focus on imitating and executing existing styles.
greetings
andré
 

Thanks! Should be fixed now.
(defun simplify-dynamics (dynamics) "Removes intermediate textual dynamic indicators from longer hairpins (e.g., generated by velocity-to-dynamic or gen-dynamic). Example: (simplify-dynamics '(pppp< < ppp< pp< < p< < mp< mf< < f< < ff> > mf> mp> p> ppp> pppp)) => (pppp< < < < < < < < < < < < ff> > > > > > pppp) " (append (list (first dynamics)) (loop for (d1 d2 d3) on dynamics when (and d2 d3) collect (cond ((or (and (cresc-p d1) (dim-p d3)) (and (dim-p d1) (cresc-p d3))) d2) ((or (and (cresc-p d1) (cresc-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (< (get-velocity d2) (get-velocity d3)))) '<) ((or (and (dim-p d1) (dim-p d3)) (and (not (member d2 '(< >))) (not (member d3 '(< >))) (not (member d2 *one-note-dynamic-symbol*)) (not (member d3 *one-note-dynamic-symbol*)) (> (get-velocity d2) (get-velocity d3)))) '>) (t d2))) (last dynamics)))  

Just to let you know the TONALITY-MAP with :map 'shift is doing the same thing already 
 
(tonality-step '(c4 messiaen-mode6) '(1 1 -1 (2 2 -1) 5 3 (2 3 -2) -2 1 1)) => (c4 d4 e4 d4 f4gs4fs4 d5 fs5 bb5d6b5 gs5 bb5 b5) (tonality-map '(messiaen-mode6 :map shift) (interval-to-pitch '(1 1 -1 (2 2 -1) 5 3 (2 3 -2) -2 1 1))) => (c4 d4 e4 d4 f4gs4fs4 d5 fs5 bb5d6b5 gs5 bb5 b5)  

the "STEP-TO"-idea could be used more common... with other parameters...welcome to extend/develop it...
for mulidimensional/multiparametrical rnd-walks (first example)? :-)
 
;;; FUNCTION -> same as step-to-pitch (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))))) ;;; EXAMPLES ;;; rnd-walk all parameters (make-omn :length (reading-list-by-steps :steps (gen-walk 4 :start 1) :values '(1/32 2/32 3/32 4/32 5/32 6/32) :start 3/32) :pitch (reading-list-by-steps :steps (gen-walk 4 :start 2) :values (expand-tonality '(b3 messiaen-mode6)) :start 'ds4) :velocity (reading-list-by-steps :steps (gen-walk 4 :start 1) :values '(pppp ppp pp p mp mf f ff fff ffff) :start 'ppp) :articulation (reading-list-by-steps :steps (gen-walk 4 :start 1) :values '(ponte tasto spicc ord pizz snap) :start 'tasto)) ;;;; separeted examples (reading-list-by-steps :steps (gen-walk 4 :start 1) :values '(pppp ppp pp p mp mf f ff fff ffff) :start 'ppp) ;; => depends on rnd-walk values (reading-list-by-steps :steps '(1 1 -1 2 2 -1 1) :values '(a b c d e f g) :start 'b) ;; => (b c d c e g f g) (reading-list-by-steps :steps '(1 1 -1 2 2 -1 1) :values '(1/32 2/32 3/32 4/32 5/32 6/32) :start 3/32) ;; => (3/32 1/8 5/32 1/8 3/16 3/32 1/16 3/32) (reading-list-by-steps :steps '(1 1 -1 2 -1) :values '(ponte tasto spicc ord pizz snap) :start 'tasto) ;; => (tasto spicc ord spicc pizz ord)  
 

Will be part of the next update. 

This is how the new function TONALITY-STEP will work:
 
tonality-step (scale step &key start ambitus (sort t))
(tonality-step '(c4 d4 e4 g4 a4 f4) '(1 1 -1 2 2 -1)) => (c4 d4 e4 d4 f4 a4 g4) (tonality-step '(c4 d4 e4 g4 a4 f4) '(1 1 -1 2 2 -1 5 3 2 3 -2 -2 1 1)) => (c4 d4 e4 d4 f4 a4 g4 f5 c6 e6 a6 f6 d6 e6 f6) (tonality-step '(c4 chromatic) '(1 1 -1 2 2 -1)) => (c4 cs4 d4 cs4 eb4 f4 e4) (tonality-step '(c4 messiaen-mode6) '(1 1 -1 2 2 -1 5)) => (c4 d4 e4 d4 f4 gs4 fs4 d5) (tonality-step '(c4 messiaen-mode6) '(1 1 -1 2 2 -1 5 3 2 3 -2 -2 1 1)) => (c4 d4 e4 d4 f4 gs4 fs4 d5 fs5 bb5 d6 b5 gs5 bb5 b5) (tonality-step '(c4 messiaen-mode6) '(1 2 -1 2 2 -1 5 3 2 3 -2 -2 1 1) :ambitus 'scale) => (c4 d4 f4 e4 fs4 bb4 gs4 e4 gs4 b4 e4 c4 bb4 b4 c4) (tonality-step '(c4 messiaen-mode6) '(1 2 -1 2 2 -1 5 3 2 3 -2 -2 1 1) :ambitus '(c3 a4)) => (c4 d4 f4 e4 fs4 bb3 gs4 e4 gs4 b3 e4 c4 bb3 b3 c4) (tonality-step '((c4d4e4g4a4f4) (c3 messiaen-mode6) (c4d4e4g4a4f4)) '((1 1 -1 2 2 -1) (5 3 2 3 -2 -2 1 1) (2 -1 3 2 3 -2 -2 1 1))) => ((c4 d4 e4 d4 f4 a4 g4) (c3 gs3 c4 e4 gs4 f4 d4 e4 f4) (c4 e4 d4 g4 c5 f5 d5 a4 c5 d5))  

STEP-TO-PITCH - function
 
...perhaps OM could implement such a STEP-TO-PITCH function (in a more professional programming way)?
...in that way it's simple to map any/same GESTALT(S) on any/different (pitch-)MEDIAS (like pitchfields/spectral/whatelse).
...would be the shortest way to "project" (certainly in varèse-way)  for example ALL MY DUCKS to whole-tone-/minor/messiane-x or on a inclined plane
 
"pseudo-code" for this non-sense-example:
-> (setf intervals (pitch-to-interval pitches-all-my-ducks))
-> (step-to-pitch intervals :tonality 'messiaen5)
 
added 3 minutes later @stephane
but - as i know - with tonality-map there sometimes "strange results" because it don't works by steps...
 
-> look at:
(tonality-map '(major)
             '(c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4 as4 b4))
=> (c4 c4 d4 d4 e4 f4 f4 g4 a4 a4 a4 b4)
 
the GESTALT-transformation makes more sense by this STEP-concept
 

The new implementation of voices will allow to do that.

an other solution... same result...
greetings
andré
;;; by using SINGLE-EVENTS -> my preferred tool (defun alt-add-3rd-quarter (omn-list) (loop for i in (single-events omn-list) when (equal (first i) 'q) append (omn-replace :pitch (chord-interval-add '(4) (list (second i))) i) else append i)) (alt-add-3rd-quarter '(e c4 p d4 q e4 f stacc e f4 p a4 q g4 f stacc)) => (e c4 p e d4 p q e4gs4 f stacc e f4 p e a4 p q g4b4 f stacc)  

Fix to missing TIE is some instances.
 
New:
OMN-TO-MEASURE
This function works the same way as the OMN-TO-TIME-SIGNATURE function but uses measures instead of time-signature form.
---------------------------------- 
 
omn-to-measure omn-form measures &key loop
 
[Function]
 
Arguments and Values:
 
omn                omn-form list.
measures                          a list of length-symbols or ratios.
loop                                    NIL or T. The default is T.
 
Description:
 
The OMN-TO-MEASURE function is used to span an omn-form list to create sublists that match up with a list of time-signature measures. This is particularly valuable when organising the omn output from the import of a Midifile to allow for further processing. For example, here’s part of an improvisation captured to Midifile. First, its output before the OMN-TO-MEASURE:
 
(setf rh-1
      '(-dd h c7 p eb6 mp p - c7 q e6 - h_e g6 e mf
        bb5 mp -h.. q bb6 p -h. q. d6 e c4 -h..
        q bb3 mf e g6 mp h_e e6 -h e g5 h a6
        -e = h bb4 e6 p q bb6 mp e6 e g3 g6 p
        q. g3 e bb3 bb6 mp q g6 pp e c7 mp eb4 p))
 
Now, with this output organised to produce lists that adhere to the measure 4/4:
 
(setf bw-rh1 (omn-to-measure rh-1 '(4/4)))
=> ((-w) (-w) (-w) (-w)
    (h c7 p eb6 mp)
    (h eb6 p -h)
    (h c7 p q e6 -q)
    (h_e g6 p e mf bb5 mp -e tie)
    (-h. q bb6 p)
    (-h. q d6 p tie)
    (e d6 p c4 -h.)
    (-e q bb3 mf e g6 mp h e6 tie)
    (e e6 mp -h e g5 q a6 tie)
    (q a6 mp -e a6 h bb4)
    (h e6 p q bb6 mp e6)
    (e g3 mp g6 p q. g3 e bb3 bb6 mp g6 pp tie)
    (e g6 pp c7 mp eb4 p))
 
Examples:
 
The following examples show further possibilities of this function. Particularly notice in the next example how the tie is added automatically in the second bar.
 
(setf measures '(q h. h. w h.))
 
(setf omn1 '(-q q c5 p eb4 h gb4 q gb5 p a4 f
               c5 q c6 p eb5 gb5 q gb6 p a5 c6))
 
(omn-to-measure omn1 measures)
=> ((-q) (q c5 p eb4 gb4 tie) (q gb4 p gb5 a4 f)
    (q c5 f c6 p eb5 gb5) (q gb6 p a5 c6))
 
The example below is interesting because it’s only featuring a single bass pitch. Remember that in omn when a part may have only a single pitch, simply stating the next rhythmic value automatically includes a repetition of that pitch.
 
(setf omn2 '(s gb2 f -e. s fff -e. s f -e. s fff
             -e. s f -e. s -e. s -e. s -e. s -e.
             s fff -e. s f -e. s fff -e. s f -e.
             s -e. s -e. s -e. s -e. s fff -e. s f
             -e. s fff -e. s -e s -e s -e s -we s
             -q s -q s -q s -q s -q s -q s -))
 
(omn-to-measure omn2 '(q q. q. w))
=> ((s gb2 f -e.)
    (s gb2 fff -e. s gb2 f -)
    (-e s gb2 fff -e.)
    (s gb2 f -e. s gb2 -e. s gb2 -e. s gb2 -e.)
    (s gb2 f -e. s gb2 fff -e. s gb2 f -e. s gb2 fff -e.)
    (s gb2 f -e. s gb2 -e. s gb2 -e. s gb2 -e.)
    (s gb2 f -e. s gb2 fff -e. s gb2 f -e. s gb2 fff -e.)
    (s gb2 fff -e s gb2 -e s gb2 -e s gb2 -q.)
    (-h. s gb2 fff -e.)
    (-s gb2 fff -q s gb2 -q s gb2 -q)
    (s gb2 fff -q s gb2 -q s gb2 -))
 
As in the initial example here’s a fragment barred with two measure values and with loop set to T.
 
(setf omn3 '(s b4 d5 fs5 a5 e. g5 s c5
               b4 a4 g4 b4 a4 cs5 e5 g5
               e. fs5 s b4 a4 g4 fs4 a4
               g4 b4 d5 fs5 e. e5 s a4
               g4 fs4 e4 g4))
 
(omn-to-measure omn3 '(q. q) :loop t)
=> ((s b4 d5 fs5 a5 e g5 tie)
    (s g5 c5 b4 a4)
    (s g4 b4 a4 cs5 e5 g5)
    (e. fs5 s b4)
    (s a4 g4 fs4 a4 g4 b4)
    (s d5 fs5 e e5 tie)
    (s e5 a4 g4 fs4 e4 g4))
 
See OMN-TO-TIME-SIGNATURE