AM

Members
  • Content count

    250
  • Joined

  • Last visited

  • Days Won

    39

AM last won the day on April 23

AM had the most liked content!

About AM

  • Rank
    Advanced Member

Contact Methods

  • Website URL
    https://soundcloud.com/andr-meier-1 http://www.andremeier.org

Profile Information

  • Gender
    Male

Recent Profile Visitors

917 profile views
  1. great... that's a smart solution :-) simpler then mine ...i didn't know how to set "-1" outside the FUNCTION without DEFSTRUCT thanx!! i like it when the program tells me that it has done the job... so i coded a little extension: (let ((i -1)) (defun next (liste &key (stop 'nil) (one-cycle 'nil)) (if (equal stop 't) (if (< i (1- (length liste))) (nth (mod (incf i) (length liste)) liste) (if (equal one-cycle 'nil) (progn (setf i -1) 'nil) 'nil)) (nth (mod (incf i) (length liste)) liste)))) (next '(a b c d e f)) (next '(a b c d e f) :stop t :one-cycle nil) ;; shows a NIL after last value, then starts again (next '(a b c d e f) :stop t :one-cycle t) ;; shwows only NILs after the last value
  2. is there another way to code such a function/idea? this is (at the moment) a "theoretically function"... no concret use - l'art pour l'art :-) thanx for smarter LISP-code-IDEAS! andré ;;; evaluate PROGN (as a reset) (progn (defstruct counter n) (defvar cnt) (setf cnt (make-counter :n -1)) (defun read-list-in-steps (alist) (nth (setf (counter-n cnt) (1+ (counter-n cnt))) alist))) ;;; evaluate a view times, so one value after the other will be in the output ;;; you have to evaluate the progn-seq before every new start!!! (read-list-in-steps '(1 2 3 4 5 6)) (read-list-in-steps '(c4 f4 e4 f4 g5))
  3. 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) (75 392 2))) ;;; with weight (rnd-pick* '((2 0.2) (3 0.4) (4 0.2))) (rnd-pick* '(((2 3 4 5) 0.2) ((8 796 5) 0.4))) (rnd-pick* '(((1 3) 0.2) (3 0.3)))
  4. not the same number of pitches/rhythms, like phase-shifted
  5. ;;; 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 (- (1- (length liste)) n1) (- (1- (length liste)) n2))) liste))))) (cond ((equal out 'last) (car (last liste))) ((equal out 'all) (append liste)))))) (rnd-symmetrical-position-swap 2 '(1 2 3 4 3 2 1) :out 'last) (rnd-symmetrical-position-swap 5 '(1 2 3 4 5 6) :out 'last) (rnd-symmetrical-position-swap 2 '(a b c d e f g h) :out 'all)
  6. ;;; ----------------------------------------------------------------------------------------------- ;;; 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 for correct ;;; of PITCH- and RHYTHM-phases ;;; ;;; ----------------------------------------------------------------------------------------------- ;;; FUNCTION (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))))) ;;; ----------------------------------------------------------------------------------------------- ;;; GENERATING SCORE (setf sequence (gen-walk 100 :step '(0 0 0 0 0 0 0 1 2) :start 'c5)) (setf rhy 1/32) ;;; ----------------------------------------------------------------------------------------------- (def-score quasi-unisono (:title "quasi-unisono" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instr1 :omn (make-omn :length (gen-length (nth 1 (modify-proportions 16 (count-repeat sequence) :style 'sharpen)) rhy) :pitch (filter-repeat 1 sequence)) :channel 1 :port 0 :sound 'gm) (instr2 :omn (make-omn :length (gen-length (nth 8 (modify-proportions 16 (count-repeat sequence) :style 'sharpen)) rhy) :pitch (filter-repeat 1 sequence)) :channel 2 :port 0 :sound 'gm) (instr3 :omn (make-omn :length (gen-length (nth 15 (modify-proportions 16 (count-repeat sequence) :style 'sharpen)) rhy) :pitch (filter-repeat 1 sequence)) :channel 3 :port 0 :sound 'gm)) there is no BUG when i work without "omn-to-time-signature", but is also not necessary!
  7. thanx! you are fast :-)
  8. perfect! i thought it was something like that - it seems that it's strange with "every TIE" in such a combination... also with: (5q 5q 5h._3q -3q 3q_5h. 5q 5q) (t t e._5q -5h. 5q_e. t t) etc... thanks! a.
  9. when i put these lists into MAKE-OMN, i get strange rhy-values, because MAKE-OMN "organizes" the TIED-values different... why? (make-omn :length '(3q 3q 3q_t -e. t_3q 3q 3q) :pitch '(a5 f5 b4 ds5 a4 f4)) have a look how the rhythm-notation changed (3q a5 f5 s_t_3s b4 -e. s_t_3s ds5 3q a4 f4) thanks a.
  10. ;;; ---------------------------------------------------------------- ;;; 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...
  11. ;;; 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)
  12. thanx... but seems to be more complicated... i'll try to code/sketch a solution
  13. a question: in a pattern match i would like to overwrite the existing OMN sequence. that means that for the duration of the insert the original OMN-sequence is not pushed backwards. As I see it now, the OMN-values are only inserted and do not overwrite the sequence, (and not rhythmically "compensating") ... ? would be very nice! ...or i have to code it for myself an example: ;; basic omn-seq '(e c4 -e -q q c4 -q s c4 -e. q) ;; insert '(3q c4 d4 e4 c4 d4 e4 c4 d4) ;; pattern-match on (q c4) ;; result should be '(e c4 -e -q 3q c4 d4 e4 c4 d4 e4 c4 d4 -3q q c4)
  14. i work in another way... the tools has to follow the ideas and not my ideas are "what the tools can do" ;-)
  15. release? - would be important for next projects, and many other users :-)