User Extensions Source Code

If you want to use Emacs and SLIME with Opusmodus, that is possible. Here are steps that work: If you haven't already done so, install Quicklisp. Evaluate (ql:quickload "quicklisp-slime-helper"). Follow its instructions and put (load (expand-file-name "~/quicklisp/slime-helper.el")) into your ~/.emacs file. Start Opusmodus, and evaluate (cl-user::start-swank). This should print something like ";; Swank started at port: 4005". Now, start your Emacs. Type M-x slime-connect and you'll be prompted for a host (use the default, which is 127.0.0.1) and then a port. The port needs to match the port (default 4005) that was printed out earl…

Move-set is a function inspired by Mikael Kuhn's move-set function in PGen for Csound. https://mikelkuehn.com/index.php/ng It allows you to make random choices by moving progressively in a morphing from one set to another linearly or by following a convex or concave curve controlled by the parameter: curve. <1 = concave, 1 = linear,> 1 = convex. The norep option allows you to remove direct repeats in random choices. ;;;====================================== ;;; MOVE-SET ;;; SB. 01.11.2020 ;;;====================================== ;;; Move-set est une fonction inspirée de la fonction move-set de Mikael Kuhn dans PGen pour Csound…

here is a sketch for an alternative "binary-(or element-)layer-FUNCTION (defun element-layer (lists &key (rnd nil)) (let ((lists (if (null rnd) lists (rnd-order lists :list t)))) (car (last (loop for x in (rest lists) with list = (car lists) collect (setf list (loop for i in list with cnt = 0 when (equal i 0) collect (nth cnt x) and do (incf cnt) else collect i))))))) (element-layer (list '(1 0 0 1 1 0 0 1 0 0 0 0) '(…

Hi, i've made this function for my own usage. Sharing here if it can be useful for some others. It is a function who replace articulation by a given one on repeated notes. Best SB. ;;; OMN-REPLACE-ARTICULATION-IF-REPEAT (defun omn-replace-articulation-if-repeat (new-art omn-sequence) (do-verbose ("omn-replace-articulation-if-repeat") (let ((spn '()) (res '()) ) (progn (setf spn (get-span omn-sequence)) (setf res (loop for i from 0 to (- (length (flatten-sublist (single-events omn-sequence))) 1) collect (if (or (eq (second (nth i (flatten-sublist (single-events omn-sequence)))) (second …

;;; ADD-RND-DUST TO LENGTHS ;;; this function adding RANDOMLY some "dust" to the LENGTHS, so it will be like a little rubato, ;;; or "humanizing"-effect. the ADD-SPAN is in percent (0.1 = 10%) on each length-value. (defun add-rnd-dust (omnseq &key (span '(0.1)) (seed nil) (quantize '(1 2 3 4 5 6 7 8 9))) (let ((rhy (omn :length omnseq)) (sp)) (progn (setf rhy (loop with cnt = 0 for i in rhy do (setf sp (nth cnt span)) when (not (null seed)) do (incf seed) when (> i 0) collect (+ i (car (rnd-num…

greetings andré ;;; MODIFY THE PITCH CONTOUR inside a pitchfield or tonality ;;; please evaluate the example and have a look to the contours ;;; subfunction (defun position-items (items alist) (loop for item in items append (position-item item alist))) ;;; function (defun compr/expand-melody (melody field &key (type 'add) (n 1) (shift 0)) (let* ((ints (loop for i in (difference (position-items (pitch-to-midi melody) (pitch-to-midi field))) collect (cond ((equal type 'add) (cond ((<= i -1) …

have fun... greetings andré ;;; here is a MULTI-GEN-SORT ------------------------- ;;; you could interlace different processes of SORTING (defun multi-gen-sort (lists &key (types nil) (sorts '>) (steps nil) (seed nil)) (let* ((sorted-lists (loop for i in lists for cnt = 0 then (incf cnt) collect (gen-sort i :type (if (listp types) (nth cnt types) types) :sort (if (listp sorts) …

;;; THIS FUNCTION DOING SYMM TRANSPOSITIONS TO CONRACT (OR EXPAND, depends on INTERVAL) A CHORD or PITCH-SEQ ;;; default setting: it changes in every generation the highest and lowest pitch by an OCTAVE ;;; by changing :position (see examples) you could change which position should be changed/transposed ;;; default interval is 12 ;;; FUNCTION (defun chord-contraction/expansion (n pitchlist &key (position nil) (interval 12) (chord nil)) (let* ((pitchlist (if (chordp (car pitchlist)) (melodize pitchlist) pitchlist)) (position (if (null position) (list 0 (1- (length pitch…

hi all i'm looking for different SORTING ALGORITHMS in LISP - no problem to find (different) in the WWW... but: i would like to have as OUTPUT-result ALL generations of the SORTING-process and not only the LAST one - i'm interested in the PROCESS!! thanks for some help or any idea? (for once i do not want to code it myself :-)) greetings andré

to use the function which works on event-numbers, first you have to number it (the score), so that you could work with this afterwards... ;;; ADD numbers to text attributes (can do that in your setup), then ADD number to events ;;; have a look to the example. after that, easy to use REPLACE-ON-EVENT-NUMBER etc... (defun add-numbers-to-text-attributes (a b) (loop for i from a to b append (add-text-attributes (list (compress (list 'nr i)) (write-to-string i))))) (add-numbers-to-text-attributes 0 100) (defun add-num-to-events (omnlist) (loop for x in (single-events omnlist) for i from 0 to (length (single-events omnlist)) when (omn-formp x…

the same idea with INSERT/REPLACE (defun replace-on-event-number (omn-list &key position/list (type 'replace) (output nil)) (progn (setf omn-list (loop for i in (single-events omn-list) for cnt = 0 then (incf cnt) with position-list = (loop for x in position/list collect (car x)) with list = (loop for y in position/list collect (rest y)) with cnt2 = 0 when (= cnt (nth cnt2 position-list)) collect (cond ((equal type 'replace) …

;;; FUNCTION: for some coding-cases i needed THIS function, to keep the OMN-notation ;;; and not to change to RATIO (otherwise i got strange results in NOTATION because the "ties are gone") (defun length-invert** (length-val) (append (compress (list '- length-val)))) ;;; EXAMPLES ;;; new => keeps OMN (length-invert** (car '(q e4 mp))) => -q ; in this case i wanted to keep the format with tie (length-invert** (car '(3q_q e4 mp))) => -3q_q ;;; original => changes to ratio (length-invert (car '(q e4 mp))) => -1/4 ; no tie here! i was in trouble :-) (length-invert (car '(3q_q e4 mp))) => -1/3

Here's a new function a bit similar to my old "add-interval-if-length" function but bit more sophisticated. It use gen-chord3 to create chord on defined length. ;;; ============================================== ;;; UTILITY FUNCTIONS ;;; (defun make-chord-if-length-aux (omn &key (test #'>) (length-val 1/8) (interval-list '((4 7)(7 12))) (cycle t)(relative nil) seed) (setf seed (rnd-seed seed)) (let ((s-events (single-events omn))) (loop for e in s-events for i in (gen-trim (length s-events) interval-list) when (funcall test (omn-encode (first e)) length-val) append (omn-replace :pitch (gen-chord3 (list (second e)) …

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

use it or not... greetings andré ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; count-up/down => not well coded but it works ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; A FUNCTION which counts a integer-list from its values (individual) ;;; to value B (all the same end-value :to (default is 1)) ;;; n => how many output values (approx: depends on input/round... was not important for my project) ;;; up or down (default is 'down) ;;; with variabel STEPS => sequencieally (horizontal) or with steps for each value individiual (v…

;; a function which fills up a sequence randomly - max-length = length sequence ;; (regardless of the number of cycles) (defun rnd-complete-seq (n &key sequence (step 1) seed (sort '<) (exclude nil) (append-excluded nil)) (let* ((testseq) (sequence (if (null exclude) sequence (filter-remove exclude sequence))) (sequence (loop repeat (length sequence) with sequence = (loop repeat n with seq = '() do (setf seq (append (rnd-unique step sequence :seed seed) seq)) do (setf…

Hi, here are the two functions i use daily in my workflow. The first gen-pitch-line can be used as this but is also required for the second function svoice1. svoice1 is a generic omn generator i find useful for my work. ;;; ------------------------------------------------------------------------------ ;;; GEN-PITCH-LINE ;;; Fonction de génération de hauteurs basées sur une conversion de vecteur de bruit ;;; avec un grand choix de type de bruit, taux de compression du vecteur, filtrage des répétitions et ambitus. (defun gen-pitch-line (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat (type :white)) (setf seed (…

works, but only for one-time-repetiton... could you use it? (defun merge-lengths-of-a-pitch-rep (omn-seq) (let* ((omn-seq (single-events omn-seq)) (l)) (flatten (loop repeat (length omn-seq) for cnt = 0 then (incf cnt) when (equal (omn :pitch (nth cnt omn-seq)) (omn :pitch (nth (1+ cnt) omn-seq))) do (progn (setf l (length-note-merge (append (omn :length (nth cnt omn-seq)) (omn :length (nth (1+ cnt) omn-seq))))) (incf cnt)) and collect (omn-replace :length l (nth cnt omn-seq)) else collect (nth cnt omn-seq))))) (merge-le…

;;; removes pitches by its position-number, will be replaced by rests. (starts with 0) (defun omn-pitch-position-remove (positions omnseq) (length-rest-merge (loop for i in (single-events omnseq) with cnt = 0 when (and (pitchp (cadr i)) (not (equal 'nil (member cnt positions)))) append (make-omn :length (list (length-invert (car i)))) else append i when (pitchp (cadr i)) do (incf cnt)))) (omn-pitch-position-remove '(0 1) '(-q e c4 e d4 e e4 e e e e)) …

could be an interesting idea for OPMO? (or already existing?) greetings andré ;;; a function (a sketch - i needed it for my momentary work) which filters ;;; an OMN-sequence in a specific bar, from a specific beat, with a specific ;;; span. (in such a basic version all in quarters (bars/...)) (defun copy-omn-seq (omnseq bar/beat-list &key (measure '(4/4)) (span nil)) (loop for i in bar/beat-list collect (loop repeat (if (null span) (- (/ (car measure) 1/4) (1- (cadr i))) span) for x = (1- (cadr i)) then (incf x) append (nth x (omn-to-measure (nth (1- (car i)…

;;; CHANGE-TIME-STRUCTURES ;;; works okay, but not exactly precise because of rhy-to-integer, which is not very easy in some cases ;;; this function changes basic-rhy-structures (if it's all the time perhaps in x/32) ;;; to other/changing sections. the lengths/rests will be rounded like in LENGTH-RATIONAL-QUANTIZE ;;; rhy+span => '((32 2) (44 7)) => means in 32 three values, in 44 seven values (defun change-time-structure (omnseq rhy+span &key (basic-rhy 32) (round 1/4)) (let* ((intseq (loop for i in (omn :length (flatten omnseq)) collect (* i basic-rhy))) (rhyseq (mapcar #'car rhy+span)) (spanseq (mapcar #'cadr rhy+spa…

a sieve/filter-function - filters specific INTERVALS and replacing the others by rests. (don't work perfect, but as a sketch....) ;;; (defun equal/or (n alist) (car (loop for i in alist when (equal i n) collect 't))) ;;; FUNCTION (defun filter-omn-by-intervals (omn-seq intervals) (setf omn-seq (loop with omn-events = (single-events omn-seq) with i = 0 while (not (null (nth i omn-events))) when (equal/or (car (pitch-to-interval (append (omn :pitch (nth i omn-events)) (omn :pitch (nth (1+ i) omn-events))))) intervals) …

(defun and-span (n a b) (and (>= n a) (<= n b))) (and-span 13 12 45) => t (and-span 2 12 45) => nil

i needed functions which shorten/enlarge only the RESTS of my complex/tupled-mixed texture - not precisely - so i coded it with diminution/augmentation+round (otherwise i would be in trouble by the crazy rests)... violà... use it or code it smarter for OMPO! greetings andré 3 functions: rest-diminution rest-augmentation only-length-augmentation ;;; (defun rest-diminution (omnlist &key (factor 1) (round 1/4)) (length-rest-merge (flatten (loop for i in (single-events (length-rest-merge omnlist)) when (< (car (omn :length i)) 0) collect (length-rational-quantize (length-diminution fac…

two functions i needed for working with POLYTEMPO-NETWORK http://philippekocher.ch/#109 http://polytempo.zhdk.ch greetings andré (defun length-to-decimal (alist &key (sum nil)) (let ((list (loop for i in (omn :length alist) collect (float (* i 4))))) (if (equal sum t) (sum list) list))) ;;; result: q = 1 / h. = 3 ...etc... (length-to-decimal '(h. h. 3q 5e 3h)) => (3.0 3.0 0.33333334 0.1 0.6666667) (length-to-decimal '(h. h. 3q 5e 3h) :sum t) => 7.1 (defun length-to-sec (alist tempo &key (sum nil)) (let ((list (loop for i in (omn :length alist) collect (* (/ …