AM

thanx! i can modify my own function now, so that it will work properly :-)

nice :-)

;;;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)) (append replace-component) (omn :articulation omn-sequence)))) (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))

great :-) release date?

with yours and rangarajan-help it works!! thanx!

dear janusz, stephan....... i tried to install SCREAMER via quicklisp... quicklisp-thing worked, but for the rest i'm to stupid... :-) coudl anyone help me.... where should i copy folders/files... i have no idea ... i'm only a simple musician who is coding in lisp-OMN (but not more) :-) i would like i step by step... thanx andré

thanks. yes i know it... but i'm working different... more "generative" (and not with many OMN-functions)... i have to check in every generation the output on different parameters, and as a feedback i change when PATTERN-MATCH => T the data-DNA (the production-datas for next gen via (defstruct => make-.... )) or the function which generates something in the generative APP ... most of the code is in pure LISP. it's great that i can code it like that in OPUSMODUS (very open!)...i can find my own solutions and ways, and it's not necessary to use the "official grammar" (always a problem with music-production-software), but i could i if i want :-) ... so i have a large personal USER LIBRARY now :-) thanks for your pracitcal examples how to work on OMN-level - i can learn a lot from them on OMN :-) regards andré

possible? would like it if i could see/open/work COMPOSER, SCORE, MIDI-display, GRAPHICS in different windows (for working with more then one SCREEN)...? what do you think? regards andré

thanx for articulationp!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;how to split randomly a number into "n-parts" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun rnd-split-number (n &key (total-sum 1.0)) (let ((values)) (setq values (loop repeat (- n 1) with val-a = total-sum with val-b collect (setq val-b (random val-a)) do (setq val-a (- val-a val-b)))) (append values (list (- total-sum (sum values)))))) ;; examples (rnd-split-number 5 :total-sum 1.8) => (0.26645982 1.47964 0.014375878 0.014122969 0.025401235) (rnd-split-number 3 :total-sum 9.8) => (5.1533704 1.7459779 2.900652)

so i could search articulation-patterns in my BOTS => is it complicated? i would need it urgent :-)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; WHEN PATTERN-MATCH => T ;;; THEN WEIGHETD RANDOM DECIDING THE NEXT VALUE ;;; with :gate/:keyword = extra AND-function ;;; with :evaluate => you could evaluate a function-output directly ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; subfunctions (defun pattern-match (liste pattern) (loop for z in liste with cnt = 0 with pattern_cnt = 0 when (or (equal (nth cnt pattern) z) (equal '? (nth cnt pattern))) do (incf pattern_cnt) and do (incf cnt) else do (setq cnt (setq pattern_cnt 0)) when (equal pattern_cnt (length pattern)) collect 't into bag and do (return (car bag)))) (defun test.pm.omn (seq pattern) (let ((seq (if (omn-formp seq) (cond ((lengthp (car pattern)) (omn :length seq)) ((pitchp (car pattern))(omn :pitch seq)) ((velocityp (car pattern)) (omn :velocity seq))) (append seq)))) (pattern-match seq pattern))) (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 test.pm+chance (test.seq pattern values/weights &key keyword gate (evaluate 'nil)) (let ((out)) (setf out (if (and (test.pm.omn test.seq pattern) (equal keyword gate)) (weighted-random values/weights) (append gate))) (if (equal evaluate 't) (eval out) (append out)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; example => works also with OMN etc... (test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.15) (c 0.375) (d 0.21))) ;; more examples (test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.25) (c 0.25)) :gate 'no-entry :keyword 'no-entry) ;; => key correct (test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '((a 0.5) (b 0.5)) :gate 'no-entry :keyword 'whatever) ;; key incorrect ;; example with :evaluate T (test.pm+chance '(1 2 3 4 5 4 3 5 6 7 2) '(5 ? 3) '(((cons 'a 'b) 0.5) ((cons 'c 'd) 0.5)) :evaluate t)

yes, because with it, i could code more "multi-usable" functions :-)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; WHEN PATTERN-MATCH => T ;;; THEN MARKOV PRODUCES THE NEXT VALUES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; subfunctions (defun pattern-match (liste pattern) (loop for z in liste with cnt = 0 with pattern_cnt = 0 when (or (equal (nth cnt pattern) z) (equal '? (nth cnt pattern))) do (incf pattern_cnt) and do (incf cnt) else do (setq cnt (setq pattern_cnt 0)) when (equal pattern_cnt (length pattern)) collect 't into bag and do (return (car bag)))) (defun test.pm.omn (seq pattern) (let ((seq (if (omn-formp seq) (cond ((lengthp (car pattern)) (omn :length seq)) ((pitchp (car pattern))(omn :pitch seq)) ((velocityp (car pattern)) (omn :velocity seq))) (append seq)))) (pattern-match seq pattern))) ;; mainfuction (defun test.pm+markov (seq pattern start-slot transitions &key (size 1)) (if (test.pm.omn seq pattern) (if (= size 1) (car (rest (gen-markov-from-transitions transitions :size (1+ size) :start start-slot))) (rest (gen-markov-from-transitions transitions :size (1+ size) :start start-slot))) (append start-slot))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setf transitions '((a (a 2) (b 1)) (b (a 2) (b 1)))) (setq test-omn '(t fs4 pp tasto g4 ppp tasto -s. t e4 pppp tasto -s. t eb4 pp tasto -het - t)) ;; examples1 (test.pm+markov test-omn '(pp ppp) 'a transitions) ;; evaluate a few times (test.pm+markov test-omn '(fs4 g4) 'a transitions) ;; evaluate a few times (test.pm+markov test-omn '(g2) 'a transitions) ;; evaluate a few times => no match => no new value (test.pm+markov test-omn '(1/32 -3/32) 'a transitions) ;; evaluate a few times ;; examples2 (test.pm+markov test-omn '(pp) 'a transitions :size 5) ;; evaluate a few times (test.pm+markov test-omn '(g4 e4) 'a transitions :size 3) ;; evaluate a few times ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

is there an articulationp like a pitchp etc???

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; PATTERN MATCH FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; i needed some PATTERN_MATCH-FUNCTIONS (also with wildcards) ;;; in my projects to check sequences ;;; output is t/nil - ;;; implement it if you whant :-) regards, andré ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun pattern-match (liste pattern) (loop for z in liste with cnt = 0 with pattern_cnt = 0 when (or (equal (nth cnt pattern) z) (equal '? (nth cnt pattern))) do (incf pattern_cnt) and do (incf cnt) else do (setq cnt (setq pattern_cnt 0)) when (equal pattern_cnt (length pattern)) collect 't into bag and do (return (car bag)))) (pattern-match '(1 2 3 4 5 6 7 8) '(2 ? 3)) => nil (pattern-match '(1 2 3 4 5 6 7 8) '(2 ?)) => t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun test.pm.length (seq pattern) (let ((seq (if (omn-formp seq) (omn :length seq) (append seq)))) (pattern-match seq pattern))) (defun test.pm.pitch (seq pattern) (let ((seq (if (omn-formp seq) (omn :pitch seq) (append seq)))) (pattern-match seq pattern))) (defun test.pm.velocity (seq pattern) (let ((seq (if (omn-formp seq) (omn :velocity seq) (append seq)))) (pattern-match seq pattern))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ASHBY-OPERATOR => some nonsense-sound-examples ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; little function for mapping... (defun eliminate-repetitions (liste) (let ((liste (append liste (list 'nil)))) (loop repeat (1- (length liste)) with cnt = 0 when (not (equal (nth cnt liste) (nth (+ 1 cnt) liste))) collect (nth cnt liste) do (incf cnt)))) ;;; some examples ;(setq integers ; (flatten (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17)))) (setq integers (flatten (ashby-operator-1 '( 3 1 4 0 7 8 9 10 5 6 2 11)))) ;(setq integers ; (flatten (ashby-operator-1 (gen-sieve '(c4 c7) '(1 2 3))))) ;;; mapping (setq pitches (eliminate-repetitions (integer-to-pitch integers))) (def-score example (:key-signature 'chromatic :time-signature '(4 8) :tempo '(e 176) :layout (bracket-group (piano-grand-layout 'piano))) (piano :omn (setq omn-list (make-omn :pitch pitches :length (loop repeat (length pitches) collect 1/32))) :sound 'gm-piano)) #| (def-score example-reverse (:key-signature 'chromatic :time-signature '(4 8) :tempo '(e 176) :layout (bracket-group (piano-grand-layout 'piano))) (piano :omn (setq omn-list (make-omn :pitch (reverse pitches) :length (loop repeat (length pitches) collect 1/32))) :sound 'gm-piano)) |#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ASHBY-OPERATOR: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; i coded somethings special, that i have seen in a book ;;; of HEINZ VON FOERSTER (my favorite writer/philosopher..) ;;; https://en.wikipedia.org/wiki/Heinz_von_Foerster ;;; => i didn't found this ASHBY-algo (he is writing about it) ;;; anywhere else, but for me it was interesting to code it. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; every list of integers (from 0 to ?) will end with "0" ;;; perhaps you could map it with whatever you want ....... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ashby-operator-1 (liste) (append (list liste) (loop with slot-pos with slot-val with slot-product ;; choose two positions in the list do (setq slot-pos (loop repeat 2 collect (random (length liste)))) ;; picks the values from the positions do (setq slot-val (list (nth (first slot-pos) liste) (nth (second slot-pos) liste)) ;; gen the product of the two values slot-product (* (first slot-val) (second slot-val))) ;; replace the value of the first pos with the (first (explode slot-product)) ;; or when it's < 10 with 0 do (setq liste (loop for i in liste for cnt = 0 then (incf cnt) when (= cnt (first slot-pos)) collect (if (> slot-product 9) (first (explode slot-product)) (append 0)) else collect i)) ;; replace the value of the second pos with the (second (explode slot-product)) ;; or or when it's < 10 with the slot-product collect (setq liste (loop for i in liste for cnt = 0 then (incf cnt) when (= cnt (second slot-pos)) collect (if (> slot-product 9) (second (explode slot-product)) (append slot-product)) else collect i)) into bag ;; collects all into bag ;; when LISTE only '(0 0 0 0 0 ...) return all generations when (= (sum liste) 0) do (return bag)))) ;;;examples (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9)) (list-plot (flatten (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 11))) :point-radius 0.1 :style :fill :line-width 1) (integer-to-pitch (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 10 11))) (chordize-list (integer-to-pitch (remove-duplicates (ashby-operator-1 '(0 1 2 3 5 8 13)))))

yes, but... it has some error... > Error: No length specified before first pitch > While executing: (:internal parse-omn-note), in process Listener-1(6). > Type cmd-. to abort, cmd-\ for a list of available restarts. > Type :? for other options. only when i do gen-rotate with the sequence the sequence works with perhaps (gen-retrograde seq) or... the sequence (produced by rnd-bots) is for example, something like that... ((et b1 f gettato t f1 ff ord et cs3 mf gettato t fs3 f tasto d5 tasto et g5 mf gettato t eb7 ff ord et a6 f gettato)) and works fine without (gen-rotate

is there a function to ROTATE a complete omn-sequence? (like a sample) .... thanks for help!

bad code but nice results... :-) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; rnd-symm-expand => generates rnd-symm transpositions ;;;; in different sequences (intervals, OMN-form,rhythms... ;;;; :chance => 0.0 - 1.0 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun rnd-symm-expand (seq &key (possible-intervals '(12 -12)) (chance 1)) (let ((row) (firstpart) (rev-secondpart) (out)) (setq row (if (pitchp (first seq)) (pitch-to-midi seq) (append seq))) (setq firstpart (loop repeat (if (evenp (length row)) (/ (length row) 2) (/ (1- (length row)) 2)) for cnt = 0 then (incf cnt) collect (nth cnt row))) (setq rev-secondpart (loop repeat (if (evenp (length row) ) (/ (length row) 2) (/ (1- (length row)) 2)) for cnt = (- (length row) 1) then (decf cnt) collect (nth cnt row))) (loop for i in firstpart for j in rev-secondpart with int = 0 do (if (prob? chance) (setq int (rnd-pick possible-intervals)) (setq int 0)) collect (+ i int) into bag1 collect (+ j (* -1 int)) into bag2 when (= (length bag2) (if (evenp (length row)) (/ (length row) 2) (/ (1- (length row)) 2))) do (if (evenp (length row)) (setq out (append bag1 (reverse bag2))) (setq out (append bag1 (list (nth (length firstpart) row)) (reverse bag2))))) (if (pitchp (first seq)) (midi-to-pitch out) (append out)))) ;;;examples (rnd-symm-expand '(0 0 0 0 0 0 0 0 0 0) :possible-intervals '(4 12 7) :chance 0.5) (rnd-symm-expand '(1/4 1/4 1/4 1/4 1/4) :possible-intervals '(-1/32 1/32) :chance 0.5) (rnd-symm-expand '(c1 c2 c3 c4 c5 c6) :possible-intervals '(1 -1) :chance 0.5)

perfect...! a kind of... (compress-time-signatures bars) was my next step... so... thanx to you!! perhaps, both in ONE?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; modify time-signatures like '(1 4 3) to (3 4 1), ;;; helps me after (split-tuplet-lengths) to clean up ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; with the :exclude and :threshold ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun modify-time-signature-repetitions (time-signature-seq &key (exclude '((0 0))) (threshold '10/4) (numerator-threshold 20)) (loop for i in time-signature-seq when (and (> (third i) 1) (< (/ (first i) (second i)) threshold) (< (* (first i) (third i)) numerator-threshold) (not (if (listp (first exclude)) (loop for x in exclude when (equal (butlast i) x) collect t) (equal (butlast i) exclude)))) collect (list (* (first i) (third i)) (second i) 1) else collect i)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq bars '((5 4 4) (1 4 2) (3 4 2) (1 8 5) (1 32 8))) (modify-time-signature-repetitions bars) (modify-time-signature-repetitions bars :exclude '(1 4)) (modify-time-signature-repetitions bars :exclude '((1 4) (1 8))) (modify-time-signature-repetitions bars :exclude '((1 32)) :threshold '4/4) (modify-time-signature-repetitions bars :numerator-threshold 7) ;; because i don't want 200/4 - bars :-) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

it's allready in my USER LIBRARY... just say when you are not interested in such things - i know you have a lot of work without these extra-stuff... :-) i'm very happy with OPUSMODUS!

VERY NICE CODE... but your function does not do the same as mine ...perhaps a misunderstanding / a different idea! ...you compensate EVERY value, my code only compensates when "rhy" is changing (length-round '(1/16 3/16 2/32 5/7 4/20 6/20 3/20 5/16)) => (1/16 -3/16 3/16 -1/16 1/16 -3/16 5/7 -1/28 1/5 -1/20 3/10 -1/5 3/20 -1/10 5/16 -3/16) ..after the 1/16 it's not necessary to "round" with -3/16, because -> also with teh other values here with my code -> i only want to compensate when "denominators" are changing => have a look at markings (bold) (length-compensate2 '((1 16) (3 16) (2 32) (5 7) (4 20) (6 20) (3 20) (5 16))) => (1/16 3/16 1/16 -3/16 5/7 -1/28 1/5 3/10 3/20 -1/10 5/16 -3/16)