Jump to content

AM

Members
  • Joined

  • Last visited

Everything posted by AM

  1. 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) collect (list (nth i omn-events) (nth (1+ i) omn-events)) and do (incf i 2) else collect (neg! (car (omn :length (nth i omn-events)))) and do (incf i)))) ;;; EXAMPLE (setf basic-omn-seq (make-omn :pitch (vector-to-pitch '(c4 c6) (gen-white-noise 100 :type :logistic)) :length '(t) :span :pitch)) ;;; check out all these filter-tests (setf omn-seq (filter-omn-by-intervals basic-omn-seq '(1 2 3))) ;(setf omn-seq (filter-omn-by-intervals basic-omn-seq '(3 -3))) ;(setf omn-seq (filter-omn-by-intervals basic-omn-seq '(1 -1 5 -5 7 -7))) (def-score example (:title "example" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument1 :omn (flatten omn-seq) :channel 1 :sound 'gm-piano) (instrument2 :omn (flatten basic-omn-seq) :velocity 20 :channel 3 :sound 'gm-piano)) here is a more complex example (defvar library) (defvar abfolge) (defvar omn-seq) (defvar rhy) (defvar field) ;;;library + rhy -------------------------------------------------------------------------------- (setf rhy 44) ;;; LIBRARY MIRT RHY-PAAREN! (setf library (list '(eb5 5 p mute) '(e4 5 mf mute) '(gs4 3 f mute) '(g5 3 ppp mute) '(f6 2 p mute) '(cs4 1 f mute) '(d5 1 fff mute) '(b3 4 pppp mute) '(bb5 4 mp mute) '(a4 3 pp mute) '(fs3 (2 7) ppp mute) '(c6 (1 11) mp mute))) (setf library (loop for i in library collect (append (list (car i)) (if (listp (cadr i)) (gen-length (list (rnd-pick (cadr i))) rhy) (gen-length (list (cadr i)) rhy)) (filter-last 2 i)))) ;;; gen seq from library/abfolge--------------------------------------------------------------- (setf field '(eb5 e4 gs4 g5 f6 cs4 d5 b3 bb5 a4 fs3 c6)) (setf abfolge (pick-norepeat 500 field)) (setf omn-seq (loop for x in abfolge with y do (setf y (assoc x library)) append (append (reverse (filter-first 2 y)) (filter-last 2 y)))) (setf basic-omn-seq omn-seq) (setf omn-seq (filter-omn-by-intervals basic-omn-seq '(1 -1 11 -11 13 -13 4 -4 8 -8 16 -16 20 -20 28 -28 32 -32 7 -7 19 -19))) ;;;--------------------------------------------------------------------------------------------- (def-score example2 (:title "example2" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (flatten omn-seq) :channel 1 :sound 'gm-piano) (hidden-structure :omn (flatten basic-omn-seq) :channel 1 :velocity 0 :sound 'gm-piano)) ;;;--------------------------------------------------------------------------------------------- (omn-list-plot (flatten omn-seq) :join-points t)
  2. (defun and-span (n a b) (and (>= n a) (<= n b))) (and-span 13 12 45) => t (and-span 2 12 45) => nil
  3. 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 factor i) :round round) else collect i)))) (rest-diminution '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/4) => (-q e4 mp -h e e4 ff) (rest-diminution '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/8) => (-e q e4 mp -q. e e4 ff) ;;; (defun rest-augmentation (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-augmentation factor i) :round round) else collect i)))) (rest-augmentation '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/4) => (-q e4 mp -d. e e4 ff) (rest-augmentation '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/8) => (-q e4 mp -d. e e4 ff) ;;; (defun only-length-augmentation (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-augmentation factor i) :round round) else collect i)))) (only-length-augmentation '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/8) => (-3q h. e4 mp -w q. e4 ff) (only-length-augmentation '(-3q q e4 mp -w e e4 ff) :factor 3 :round 1/4) => (-3q h. e4 mp -w q. e4 ff -e)
  4. function name changed to length-to-tempo.
  5. AM replied to AM's post in a topic in User Extensions Source Code
    for pitch-seq or length-seq + vector-envelope you will need SPAN
  6. AM replied to AM's post in a topic in User Extensions Source Code
    @janusz: you could expand it with conditionals like >, <, =, span .... and implement it.... and... if you would write this function with conditionals for pitches (sequences of pitches) you could filter by vector-envelope...
  7. you can filter all events by length (>= min). all other events will be replaced by rests... (defun filter-events-by-length (omnlist &key min) (let ((omnlist (single-events omnlist)) (min (car (omn :length (list min))))) (flatten (length-rest-merge (loop for i in omnlist when (>= (car (omn :length i)) min) collect i else collect (neg! (car (omn :length i)))))))) (filter-events-by-length '(e c4 d4 e4 e5 q c4 d4 e4 h c4 d4 e4) :min 'e) => (e c4 mf e d4 mf e e4 mf e e5 mf q c4 mf q d4 mf q e4 mf h c4 mf h d4 mf h e4 mf) (filter-events-by-length '(e c4 d4 e4 e5 q c4 d4 e4 h c4 d4 e4) :min 'q) => (-h q c4 mf q d4 mf q e4 mf h c4 mf h d4 mf h e4 mf) (filter-events-by-length '(e c4 d4 e4 e5 q c4 d4 e4 h c4 d4 e4) :min 'h) => (-wq h c4 mf h d4 mf h e4 mf)
  8. AM replied to AM's post in a topic in User Extensions Source Code
    I wanted to call my own function like that - "Error: The function binary-invert is predefined by Opusmodus." also: (binary-invert '(0 8 0 2 2)) => (1 0 1 0 0) janusz? 😉
  9. AM replied to AM's post in a topic in User Extensions Source Code
    i found an internal function 🙂 (binary-invert '((1 0) (0 0 1))) => ((0 1) (1 1 0))
  10. (defun replace-lengths-of-a-pitch-sequence (omn-list pitch-list length-list) (flatten (loop with cnt = 0 for i in (single-events omn-list) when (equal (cadr i) (nth cnt pitch-list)) collect (append (list (nth cnt length-list)) (rest i)) and do (incf cnt) else collect i when (= cnt (length pitch-list)) do (setf cnt 0)))) (setf white-series-l (vector-to-pitch '(c4 c5) (gen-white-noise 100 :type :logistic :seed 23))) (replace-lengths-of-a-pitch-sequence (cons 't white-series-l) '(e4 f4 a4 gs4 g4 b4 c5 bb4) '(2/16 3/16 4/16 5/16 6/16 7/16 8/16)) => '(t gs4 mf t g4 mf t g4 mf t c5 mf t g4 mf t gs4 mf 1/8 e4 mf 3/16 f4 mf t gs4 mf t gs4 mf t bb4 mf t gs4 mf t fs4 mf t fs4 mf t f4 mf t g4 mf t bb4 mf t b4 mf t b4 mf t g4 mf t e4 mf t g4 mf t fs4 mf t b4 mf 1/4 a4 mf t g4 mf t g4 mf t a4 mf t b4 mf t fs4 mf t bb4 mf t a4 mf 5/16 gs4 mf t a4 mf 3/8 g4 mf t a4 mf t a4 mf t a4 mf t a4 mf t a4 mf t f4 mf t bb4 mf t g4 mf t fs4 mf 7/16 b4 mf t a4 mf t g4 mf t bb4 mf t a4 mf t gs4 mf t a4 mf t gs4 mf t g4 mf t g4 mf t gs4 mf t a4 mf t f4 mf t f4 mf t bb4 mf t gs4 mf t fs4 mf t a4 mf t g4 mf t a4 mf t g4 mf t gs4 mf t bb4 mf t eb4 mf t bb4 mf t fs4 mf t fs4 mf t gs4 mf t g4 mf t gs4 mf t gs4 mf t c4 mf t gs4 mf t g4 mf t gs4 mf 1/2 c5 mf bb4 mf t gs4 mf t fs4 mf t fs4 mf t bb4 mf t a4 mf t g4 mf t g4 mf t b4 mf t g4 mf t f4 mf t g4 mf t gs4 mf t gs4 mf t gs4 mf t gs4 mf t fs4 mf t gs4 mf t eb4 mf t a4 mf)
  11. AM posted a post in a topic in User Extensions Source Code
    (defun memberp (n liste) (not (equal 'nil (member n liste)))) ;;; MAIN (defun omn-sieve-filter (omn-list filter-list) (flatten (loop for i in (single-events omn-list) for j from 1 to (length omn-list) when (memberp j filter-list) collect i else collect (length-invert (car i))))) (omn-sieve-filter (make-omn :pitch (rnd-sample 10 '(c4 d4 e4 fs4 gs4) :seed 89) :length '(e) :span :pitch) '(1 2 3 5 8 9 10)) => (e c4 mf e gs4 mf e fs4 mf -1/8 e e4 mf -1/8 -1/8 e c4 mf e gs4 mf e fs4 mf)
  12. AM posted a post in a topic in User Extensions Source Code
    something i've coded... (defun binary-filter (alist bin-list) (let ((event-list (cond ((omn-formp alist) (single-events alist)) (t alist)))) (flatten (loop for i in event-list for j in bin-list when (= j 1) collect i else append (cond ((omn-formp i) (list (length-invert (car i)))) ((lengthp i) (neg! (omn :length (list i))))))))) (binary-filter '(q -q -q q) '(0 1 0 1)) => (-1/4 -q -1/4 q) (binary-filter '(q q q q -q) '(0 1 0 1 1)) => (-1/4 q -1/4 q -q) (binary-filter '(c4 d4 e4 f4) '(1 1 0 1)) => (c4 d4 f4) (binary-filter '(q c4 mf d4 e4 e f4 ppp g4 a4 b4) '(1 0 1 1 0 1 1)) => (q c4 mf -1/4 q e4 mf e f4 ppp -1/8 e a4 ppp e b4 ppp)
  13. AM posted a post in a topic in User Extensions Source Code
    ...how ti filter all "unused/complementary" pitches inside a sieve (if you like to extend the function... could be interesting if it works also with chords) (defun neg-sieve (pitchlist) (let ((pitchlist (pitch-to-midi pitchlist))) (midi-to-pitch (loop for i from (car pitchlist) to (car (last pitchlist)) when (null (member i pitchlist)) collect i)))) (setf sieve '(fs3 g3 as3 b3 c4 cs4 ds4 e4 f4 gs4 a4 d5 eb5 fs5 g5 gs5 bb5 b5 c6 cs6 e6 f6)) (neg-sieve sieve) => (gs3 a3 d4 fs4 g4 bb4 b4 c5 cs5 e5 f5 a5 d6 eb6) (neg-sieve '(c4 d4 e4 fs4 gs4 as4 c5)) => (cs4 eb4 f4 g4 a4 b4)
  14. AM replied to AM's post in a topic in Support & Troubleshooting
    i think it's better when it's seperate. keep the function/process as simple and clear as possible?
  15. AM replied to AM's post in a topic in Support & Troubleshooting
    yes, that's it!! already part of the system?
  16. complementation to OR/AND/NOT! i hope everything is correct... https://de.wikipedia.org/wiki/Logikgatter (defun nand (&rest rest) (flet ((every-truep (x) (equal x t))) (not (every #'every-truep rest)))) (nand nil nil nil) => t (nand t t t t t t) => nil (nand nil t t t nil t) => t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun nor (&rest rest) (contain-itemp 'nil rest)) (nor t t t t) => nil (nor nil t nil) => t (nor t nil nil nil) => t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xor (&rest rest) (oddp (car (count-item t rest)))) (xor t nil t t nil nil nil) => t (xor t t nil) => nil (xor nil t) => t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xnor (&rest rest) (evenp (car (count-item t rest)))) (xnor t nil t t nil nil nil) => nil (xnor t t nil) => t (xnor nil t) => nil (xnor t nil t t nil nil t nil) => t ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. 👍
  18. exactly... thanks for the solution! i will try to CODE some XOR, NOR.... based on it! i was in trouble with the "input-format" (when it's not a list) 🤔
  19. AM replied to AM's post in a topic in User Extensions Source Code
    INPUT-curves could be like that: (in that way you could imitate some early "xenakis-curves" when you map it to pitches :-)) (setf curve1 '(-5.1 -2.3 -1.1 -0.8 -0.3 -2.5)) (setf curve2 '(1.0 1.2 1.5 2.1 4.6 10.6)) (vector-range-drift curve1 curve2 (gen-white-noise 250)) as result: "imitated" by my old/simple function: (list-plot (append (vector-range-drift '(-5.1 1) '(-2.3 1.2) (gen-white-noise 50)) (vector-range-drift '(-2.3 1.2) '(-1.1 1.5) (gen-white-noise 50)) (vector-range-drift '(-1.1 1.5) '(-0.8 2.1) (gen-white-noise 50)) (vector-range-drift '(-0.8 2.1) '(-0.3 4.6) (gen-white-noise 50)) (vector-range-drift '(-0.3 4.6) '(-2.5 10.6) (gen-white-noise 50))))
  20. hi all i would like to code a NAND gate with more then two input-items (as extension to AND etc...). here is a simple version of the NAND function with two inputs, but i don't know how to exapnd it to n-inputs without putting the the inputs to in a list (like lisp-internal AND / OR)... https://en.wikipedia.org/wiki/NAND_gate i dont't want it: (nand '(t t t nil)) but like to have (nand t nil nil t t t) when i get a solution for that i will code an XOR, NOR etc.... so the "problem" is: how to manage in DEFUN more then two inputs (don't work with &optional, i think) i tried it and failed)... any ideas, lisp-nerds? 🙂 thanx! andré ;;; easy with a specific number of input-items - that works! (defun nand (a b) (not (and a b))) (nand t t) => nil (nand nil nil) => t (nand nil t) => t ;;; i like to have an input perhaps like that - with any number of input-items, like lisp's AND / OR (nand t t t t) (nand nil t t t nil t t t nil) ...
  21. AM replied to AM's post in a topic in User Extensions Source Code
    perhaps you could expand the function when we could not only have "start->end-process/linear", also with a seq-curve (two) for LOW and HIGH values... would be very smart. so it's a kind of ambitus-modulation (with perhaps white-noise)
  22. AM posted a post in a topic in User Extensions Source Code
    (defun vector-range-drift (start end input &key (spread 8)) (let ((values (gen-divide (rnd-sum (length input) (primes spread)) input)) (n-values) (a-step) (b-step)) (progn (setf n-values (1- (length values))) (setf a-step (/ (car (difference (list (car start) (car end)))) n-values)) (setf b-step (/ (car (difference (list (cadr start) (cadr end)))) n-values)) (loop for i in values for a = (car start) then (incf a a-step) for b = (cadr start) then (incf b b-step) append (vector-range a b i))))) ;;;;; EXAMPLES -> MODULATE/DRIFT white-noise - with different spreads (list-plot (vector-range-drift '(-7.1 1) '(-0.1 10) (gen-white-noise 187) :spread 10)) (list-plot (vector-range-drift '(-7.1 1) '(-0.1 10) (gen-white-noise 187) :spread 6)) (list-plot (vector-range-drift '(-7.1 1) '(-0.1 5.6) (gen-white-noise 517))) (list-plot (vector-range-drift '(-1.1 1) '(-3.1 5.6) (gen-white-noise 317)))
  23. AM posted a post in a topic in User Extensions Source Code
    short question to GEN-SORT.... the original/start-sequence is not shown with GEN-SORT? i think it should... you see it when using 'min-max... so, i think the AXIOM must be shown greetings andré
  24. AM replied to AM's post in a topic in User Extensions Source Code
    function edited - some small changes... extended: :intervals '(1 2 3) -> all these interval-combinations are shown or :intervals 2 (like before) new: :reduced-interval T or NIL (default NIL) -> when T only basic-intervals search (not 1 = 1 & 13 & 25, only in ONE octave) small example ;;; SIEVE with SYMM_STRUCTURE (setf sieve1 (pitch-transpose -6 (integer-to-pitch (gen-sieve '((0 39) (0 40)) '((5) (7)))))) (pitch-to-interval sieve1) ;;; search/permutate interval-combinations (setf pitchlist (find-intervals* sieve1 :intervals '(1 2 3) :reduced-interval t :chord nil)) (setf pitchlist (rnd-unique (length pitchlist) pitchlist)) ;;; change direction of the interval-pairs (setf pitchlist (loop for i in pitchlist when (prob? 0.4) collect (reverse i) else collect i)) ;;; remove immediate repetitions (setf pitchlist (filter-repeat 1 (flatten pitchlist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-score sieve-scan (:title "sieve-scan" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instrument :omn (make-omn :pitch pitchlist :length '(t) :velocity '(p) :span :pitch) :channel 1 :sound 'gm :program 'acoustic-grand-piano)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25. is there a possibility to filter some "combinations"? when i have a seq like that: (a4 gs4 a4 gs4 a4 fs4 gs4 g5 bb5 g5 gs4) i want to filter all immediate repetitions with pattern-length = 2 the result would be: (a4 gs4 a4 fs4 gs4 g5 bb5 g5 gs4) because a4-gs4 is the pair that repeats

Copyright © 2014-2025 Opusmodus™ Ltd. All rights reserved.
Product features, specifications, system requirements and availability are subject to change without notice.
Opusmodus, the Opusmodus logo, and other Opusmodus trademarks are either registered trademarks or trademarks of Opusmodus Ltd.
All other trademarks contained herein are the property of their respective owners.

Powered by Invision Community

Important Information

Terms of Use Privacy Policy