User Extensions Source Code

a "rnd-pick" that works with different "input-formats"... so it's flexible to use... for many (not all) input-cases ;;; subfunction (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))) ;;; mainfunction (defun rnd-pick* (alist) (if (and (listp (first alist)) (floatp (second (first alist)))) (weighted-random alist) (rnd-pick alist))) ;;; examples ;;; without weight (rnd-pick* '(1 2 3 4 5)) (rnd-pick* '((1 2 3 4) (3 4 5 7 3) (…

;;; ----------------------------------------------------------------------------------------------- ;;; A QUASI-UNISONO by proportional length-differences ;;; SAME PITCHES IN ALL VOICES INCLUDING START/END-PITCH ;;; ----------------------------------------------------------------------------------------------- ;;; a random-pitch-seq (rnd-walk) ;;; ;;; immediate-pitch-repetitions are building the rhythm ;;; ;;; with MODIFY-PROPORTIONS i'm generating "proportional variants" of this rhythm, in this example ;;; by 16 generations -> then i take the generations 1, 8, and 15 for each voice ;;; ;;; by "(filter-repeat 1 sequence)" i swallow the immediate-pitch-repetitions fo…

;;; SWAPS THE POSITIONS SYMMETRICALLY AND RANDOMIZED ;;; n => number of generations, output: last gen or all gens... ;;; new-version works also for symmetrical-sequences! (special cas) (defun rnd-symmetrical-position-swap (n liste &key (out 'all)) (let ((n1) (n2)) (progn (setf liste (loop repeat n do (setf n1 (random (1- (list-length-divide liste))) n2 (random (1- (list-length-divide liste)))) collect (progn (setf liste (position-swap (list (list n1 n2) (list …

dear all i'll try to code a function that overwrites the SEQ with an insert after a pattern-match... not so simple, because to calculate all the length-values in the SEQ so that there ist no "shifting" ist very.... here an easy sketch... but with a simple, so that i haven't got to calculate (beacuse all is mapped on quaternotes)... i hope anyone could CODE that... would be an interesting FUNCTION!!! using things as a NET!! compare -> seq with the function output... the you see the idea (setf seq '(e c4 -e -q q d4 -q s c4 -e. -h. q)) (setf insert '(3q c4 d4 e4 c4 d4 e4 c4 d4 -3q)) (setf insert-span (loop for i in (omn…

;;; ---------------------------------------------------------------- ;;; 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…

...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 …

;;; 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 T…

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 …

I think it would be nice to have some figured bass functions. I started with these simplistic functions and I am wondering if anyone has thoughts on how to generalize them. I think it'll probably be best if eventually one would be able to simply input a list of bass notes and figures - something like (figured-bass '(c3 (5 3) d3 (4 3) e3 (6) '(c major)) and the function would return the figured bass realized. (defun five-three (degree root type) (tonality-map `(,type :root ,root :map shift) (chordize (pitch-transpose (- degree 1) (interval-to-pitch '(2 2)))))) (five-three 2 'd 'major) => (e4g4b4) (defun six-three (degree root type) (tonality…

here is a little "sketched" function STEP-TO-PITCH , perhaps OM could further develop the function... ;;; FUNCTION (defun step-to-pitch (&key steps pitches start) (let ((pos (car (position-item start pitches)))) (append (list (nth pos pitches)) (loop for i in steps ;; setting pos by add the step to pos do (setf pos (+ pos i)) ;; when pitch-range to small then reset to lowest pitch+step ;; could be a more intelligent solution when (> pos (length pitches)) do (setf pos (+ 0 i)) collect (nth pos pitches))))) ;;; EXAMPLES (step-to-pitch :s…

Has anyone tried to implement pitch spelling algorithms in Opusmodus? There is already some code available on Dave Meredith's site - http://www.titanmusic.com/software.php - but it's far beyond my lisp knowledge to adapt these to Opusmodus. I believe the codes are designed to read midi files and respell them

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 :…

greetings andré (pitch-to-interval (expand-tonality '(c5 messiaen-mode4))) ; => (1 1 3 1 1 1 3) (pitch-to-interval (expand-tonality '(c5 messiaen-mode5))) ; => (1 1 3 1 1 1 3) -> should be (1 4 1 1 4 1)

have a look -> missing slur/tie (i don't kno the correct expression) between bar1 and bar2... greetings andré p.s. i will post the troubles/bugs here in "SOURCE CODE", okay? (setf mat1-pitches '(a4 g4 eb4 f4 a4 b4)) (setf mat1-durations '(-7 23 -7 5 11 7 -5 11 17)) (setf mat1-lengths (gen-length mat1-durations 1/20)) (setf omn (make-omn :pitch mat1-pitches :length mat1-lengths :velocity '(p)))

bad code-style, but modify/use it... ;;; FUNCTION ;;; expands (merges) length-values in the order of the substructure-list ;;; by inverting immediate following length-rests. ;;; (defun gen-legato-substructure (omn-list substructure-list) (loop repeat (length (single-events omn-list)) with event-list = (single-events omn-list) with sub-cnt = 0 for cnt = 0 then (incf cnt) when (and (equal (car (cond ((lengthp (car substructure-list)) (omn :length (nth cnt event-list))) ((pitchp (car substructure-list)) (omn :pitch (nth cnt event-…

I'm experimenting witn namespaces in Common Lisp. When I create a namespace like below, the symbols from the opusmodus namespace seems to be unknown: (defpackage :com.wimdijkgraaf.tonnetz (:nicknames "TONNETZ" "TNNZ") (:use "COMMON-LISP" "OPUSMODUS" "TESTFRAMEWORK") (:export "APPLY-TONNETZ")) (in-package :tonnetz) ;;; setup hash table for quick lookup (defparameter *triad-interval-to-degrees* (make-hash-table :test 'equal)) ;; major triads (setf (gethash '(4 3) *triad-interval-to-degrees*) '(1 3 5)) (setf (gethash '(7 -3) *triad-interval-to-degrees*) '(1 3 5)) (setf (gethash '(8 -5) *triad-interval-to-degrees*) '(3 1 5)) (setf (gethash '(5 4) *triad-int…

Dear folks! So inspired using OM since a couple of weeks. I do have a question, one of you might have run into before. I have sincere trouble integrating a third party package into OM. Randist would be amazing because of its normal distributed random generators. I found cl-randist here: https://github.com/lvaruzza/cl-randist Happy to read your ideas, thanks in advance! .-.deno.--.-

bad coding-style, but a useful function -> implement in OM? all the best andré (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) …

Hi, here's a small function i did for one of my work in progress. The idea is to process omn pitch material relating to omn length values. For example, if omn length value faster than 1/8, "monodize" the melody at this point. ;;; =============================================================== ;;; MONO-FAST ;;; "Monodize" (remove chords) the omn parts faster than the given rhythmic value. ;; Utility function (defun mono-fast* (max-length-value mat) (let* (; disassembling the omn mat into his components (omn-mat (disassemble-omn mat)) (p-mat (getf omn-mat :pitch)) (l-mat (getf omn-mat :length)) …

if you want to modify "a weight" from GEN-generation to next GEN-generation you could use this... (modifying a weight could be useful if you want to give your production-rules a global drift) greetings andré (defun modify-weight (&key weight (step 0.1) type (threshold 0.5) (span '(0 1)) (max-weight 1.0)) (cond ((or (equal type 'incr) (equal type 'decr)) (progn (setq weight (cond ((equal type 'incr) (incf weight step)) ((equal type 'decr) (decf weight step)))) (i…

i needed something like that (to fit sequences in a FRAME), don't know if it exists... very simple... (defun length-rest-sum (omn-list) (loop for i in (omn :length omn-list) sum (abs i)))

Hi all, I've had some excellent classes with Stephane related to Parametric Composition using Opusmodus. I had hoped that with my professional background as a programmer I would be able to get up-and-running quickly but I find myself struggling too much. Not so much with the Common Lisp language itself (have found some books that really help me a lot) but more with the workflow and Common Lisp technical issues that prevent me from using the main part of my time studying Lisp. Those issues are: - TDD (Test Driven Development). I'm used to do TDD and continuous testing on the .NET platform using NCrunch. I'm also used to do testing on uni…

Anyone using Emacs or LispBox for Opusmodus specific development or any other environment that might be more productive for a professional developer to work in than the standard Opusmodus environment? Big hug, Wim Dijkgraaf

;;;function which replaces/rewrites the component in OMN-seq (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 (pitchp (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)) …

Hello i tried to have a function who could move one atom or a list anyplace in another list , but now i would like to have the options to move this atom or list with or without parenthesis , see option a option b option a2 option b2 . I have no idea how i can implement several result options in a function , could you please explain me how to do that Thank you Patrick her are the functions i'd use as helping functions (defun list-diff (L1 L2) (cond ((null L1) nil) ((null (member (first L1) L2)) (cons (first L1) (list-diff (rest L1) L2))) (t (list-diff (rest L1) L2)) ) )…