Jump to content

AM

core_group_3
  • Content Count

    445
  • Joined

  • Last visited

  • Days Won

    95

Everything posted by AM

  1. AM

    Fibonacci

    looks like adding intervals? ...code it! :-)
  2. extendig SINGLE-EVENTS with optional-datas (like instrument-name, or whatelse) and reading/filtering this EVENT-LIST by a key-value -> useful for instrumentation... greetings andré ;;; --------------------------------------------------------------------------------------------- ;;; extending single-events with optional-datas ;;; --------------------------------------------------------------------------------------------- ;; SUBFUNCTION (defun memberp (n liste) (not (equal 'nil (member n liste)))) ;; MAINFUNCTION (defun create-extended-single-events (omn-list &key (optional-data1 nil) (optional-data2 nil) (optional-data3 nil)) (loop for i in (single-events omn-list) for data-cnt = 0 then (incf data-cnt) when (< (car (omn :length i)) 0) collect (append (list (first i)) (gen-repeat 6 'nil)) else collect (append (loop repeat 4 for cnt = 0 then (incf cnt) collect (nth cnt i)) (append (list (nth data-cnt optional-data1) (nth data-cnt optional-data2) (nth data-cnt optional-data3)))))) (create-extended-single-events '(e c4 mp stacc e. -h e. p ord e e4 stacc) :optional-data1 '(trp fl trp trp fl clar) :optional-data2 '(1 3 2 4 3 5 3 1 1)) ;; events are extended with the optional-data1-x => ((e c4 mp stacc trp 1 nil) (e. c4 mp nil fl 3 nil) (-h nil nil nil nil nil nil) (e. c4 p ord trp 4 nil) (e e4 p stacc fl 3 nil)) ;;; --------------------------------------------------------------------------------------------- ;;; reads events by key-values!! ;;; --------------------------------------------------------------------------------------------- ;;; now, with this function, you can filter all EVENTS with key-value X. all others will be replaced ;;; by RESTS, so the time-length-structure will be not destroyed. you can say: i need all EVENTS ;;; with key-value 'trp in the trumpet-voice, or all EVENTS with key-value 'c4 for .... (defun read-single-events-by (event-stream &key (key-value 'c4)) (loop for i in event-stream when (memberp key-value i) collect i else collect (append (list (length-invert (first i))) (gen-repeat 6 'nil)))) (read-single-events-by '((e c4 mp stacc trp 1 nil) (e. c4 p ord fl 3 nil) (e e4 p stacc trp 2 nil)) :key-value 'trp) ;; shows all EVENTS with key-value 'trp (other events are replaced by rests) => ((e c4 mp stacc trp 1 nil) (-3/16 nil nil nil nil nil nil) (e e4 p stacc trp 2 nil)) (read-single-events-by '((e c4 mp stacc trp 1 nil) (e. c4 p ord fl 3 nil) (e e4 p stacc trp 2 nil)) :key-value '3) ;; shows all EVENTS with key-value '3 (other events are replaced by rests) => ((-1/8 nil nil nil nil nil nil) (e. c4 p ord fl 3 nil) (-1/8 nil nil nil nil nil nil)) (read-single-events-by '((e c4 mp stacc trp 1 nil) (e. c4 p ord fl 3 nil) (e e4 p stacc trp 2 nil)) :key-value 'ord) ;; shows all EVENTS with key-value 'ord (other events are replaced by rests) => ((-1/8 nil nil nil nil nil nil) (e. c4 p ord fl 3 nil) (-1/8 nil nil nil nil nil nil))
  3. data could also be midi-channel, prog-number....
  4. i see and unterstand what you mean... (as a non-programmer :-)), so i'm asking here some naive questions: a) isn't it better to "seperate" the BASIC-OMN-structure from the additionals? in a way, i'm more independet if OPMO changes some things? b) in my way i see completely transparent and easy what's up, and not a mixture of text-attributes/data...? c) if I could change the OPMO SINGLE-EVENTS-structure, i would extend it like I did ...and not mixing it, isnt' it much more "logic" (but perhaps not for a programmer-brain :-)) ...but... it is great to have such good inputs, that's what i'm looking for in this FORUM, thanx a lot torsten!!! herzlich andré added 8 minutes later in my view it would be nice to EXTEND the "make-omn/single-events"-structure by x-add-datas... like: (make-omn :length :pitch :velocity :articulation :data1 :data2 ... ... ...)
  5. AM

    Klangfarbenmelodie

    if you want to control the global-pitch-progress, and not making/writing all length-list by hand you have to work/think (imo) with EVENTS (in opmo (single-events)), otherwise you will have all the time "random-stuff" or have incorrect synchronisations... but perhaps this is what you are looking for... all the best andré
  6. AM

    Klangfarbenmelodie

    violà, i think something like this -> an example you simply could evaluate!!! :-) ;;; --------------------------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------------------------- ;;; KLANGFARBEN-MELODIE: A FUNCTION THAT SPLITS PITCHES/LENGTHS IN THE WAY OF THE INSTRUMENTATION ;;; SEQUENCE -> SO YOU COULD SPLIT/COMPBINE THE PAARMETERS PITCH + LENGTH + VELOCITY + ARTICULATION ;;; + C O L O R (= INSTRUMENTATION)!!!! -> SO YOU CAN CREATE KLANGFARBENMELODIEN!! ;;; --------------------------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------------------------- (defun generate-events (durations pitches &key (velocity '(mf)) (articulation '(-)) (optional_data 'nil)) ;; generates an EVENT-STREAM from parameter-lists -> important is the "optional_data", ;; that's the place where the instrument's name is written in! (loop repeat (length durations) with cnt-d = 0 with cnt-rest = 0 when (> (nth cnt-d durations) 0) collect (list (nth cnt-d durations) (nth cnt-rest pitches) (nth cnt-rest velocity) (nth cnt-rest articulation) (nth cnt-rest optional_data)) and do (incf cnt-rest) and do (incf cnt-d) else collect (list (nth cnt-d durations) 'nil 'nil 'nil 'nil) and do (incf cnt-d))) (defun filtering-color (selected-color event-stream) ;; filtering the the EVENT-STREAM by instrument (let ((velocity) (articulation)) (loop for i in event-stream with match = 0 append (loop for x in (fifth i) when (equal (first x) selected-color) do (setq articulation (second x) velocity (third x)) and do (setq match 1)) when (and (= match 1) (> (first i) 0)) append (list (first i) (second i) velocity articulation) else collect (* -1 (abs (first i))) do (setq match 0)))) (defun gen-hoquetus (filtered-instrument &key pitch length instrument-list) (let ((events (generate-events length pitch :optional_data instrument-list))) (filtering-color filtered-instrument events))) ;;; --------------------------------------------------------------------------------------------- ;;; OMN_EXAMPLE: ;;; --------------------------------------------------------------------------------------------- (setq pitches '(c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4 bb4 b4)) ; only an example (setq lengths (gen-length '(1 2 3 -4 5 6 5 -4 3 -2 1 1 1 -8 3 2) 1/16)) ; only an example ;; instrumentation -> every LIST/LINE is the instrumentation/technique for one single pitch/length (setq instrumentation '(((pno ord ppp)) ; only an example ((vn pizz p)) ((trp ord ff)) ((vn pizz f) (va ponte f)) ((pno ord ff)) ((pno ord fff)) ((vn tasto mf) (pno ord ff) (vc tasto mf) (trp ord pp)) ((trp mute pp) (vn ponte mf)) ((trp mute pp)) ((trp mute pp)) ((trp ord f) (pno ord ff)) ((trp ord f) (vc tasto mf)))) ;;; --------------------------------------------------------------------------------------------- ;;; SCORE: YOU CAN MAP THE INSTRUMENTS ON THE CHANNEL/PORT YOU NEED FOR YOUR SOFTWARE-INSTR ;;; HAVE A LOOK TO THE SCORE AND INSTRUMENTATION-LIST ;;; --------------------------------------------------------------------------------------------- (def-score klangfarben-melodie (:key-signature '(c maj) :time-signature '(4 4) :tempo '(120) :layout (bracket-group (trumpet-layout 'trumpet) (piano-grand-layout 'piano) (violin-layout 'violin) (viola-layout 'viola) (violoncello-layout 'violoncello))) (trumpet :omn (gen-hoquetus 'trp ;; filters all trp-pitches/lengths/... :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (piano :omn (gen-hoquetus 'pno ;; filters all pno-pitches/lengths/... :pitch pitches :length lengths :instrument-list instrumentation) :channel 2) (violin :omn (gen-hoquetus 'vn :pitch pitches :length lengths :instrument-list instrumentation) :channel 3) (viola :omn (gen-hoquetus 'va :pitch pitches :length lengths :instrument-list instrumentation) :channel 4) (violoncello :omn (gen-hoquetus 'vc :pitch pitches :length lengths :instrument-list instrumentation) :channel 5))
  7. AM

    Klangfarbenmelodie

    you could use the hoquetus.4-function exactly for that
  8. (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 tasto q gs4 ponte) :technique 'ponte :factor 10 :modification 'augmentation) ;; also 'diminution
  9. modifying stephane' s code (defun replace-length-of-a-technique (omn-list &key technique length) (flatten (loop for i in (single-events omn-list) when (equal (nth 3 i) technique) collect `(,(rnd-pick* length) ,(nth 1 i) ,(nth 2 i) ,(nth 3 i)) else collect i))) (replace-length-of-a-technique '(e. c4 p tasto d4 ponte e4) :technique 'tasto :length '(1/32)) (replace-length-of-a-technique '(e. c4 p tasto d4 ponte e4 d4 tasto f5 tasto) :technique 'tasto :length '(1/32 2/32 3/32)) ;; rnd
  10. if you want to change VELOCITY of a technique... (defun replace-velocity-of-a-technique (omn-list &key technique velocity) (flatten (loop for i in (single-events omn-list) when (equal (car (omn :articulation i)) technique) collect (pattern-map (list (list (list '? technique) (list velocity technique))) i) else collect i))) (replace-velocity-of-a-technique '(e. c4 p tasto d4 ponte e4) :technique 'tasto :velocity 'f)
  11. AM

    Merging ties

    nice, but didn't found this function in the library, so you has to code...
  12. when i evaluate this: (setf pianomainHarm (tonality-map (append (gen-repeat 4 '((scale2))) (gen-repeat 4 '((scale1))) (gen-repeat 4 '((scale3))) ) pianomain)) Error: > Error: scale2 is not a tonality or a chord. > While executing: make-tonality, in process Listener-1(6). > Type cmd-. to abort, cmd-\ for a list of available restarts. > Type :? for other options. so, take a look what is your scale2 etc or it's in YOUR library, so i can't test YOUR score/code
  13. AM

    Looking for a function that could do that

    i have to learn more about lisp :-)
  14. AM

    Looking for a function that could do that

    (apply #'mapcar #'(lambda (&rest all) all) lists)) this is really cool! :-)
  15. AM

    Looking for a function that could do that

    ;;; in "pure lisp" with NIL when lists have not the same length (defun trans* (lists) (loop repeat (car (last (sort-asc (mapcar 'length lists)))) for cnt = 0 then (incf cnt) collect (loop for i in lists collect (nth cnt i)))) (trans* '((1 2 3 4) (a b c d) (11 12 13 14) (k l m n))) (trans* '((1 2 3 4) (a b c d e) (11 12 13 14 14 16) (k l m n o p q r s t))) (trans* '((1 2 3 4) (a b c d e) (11 12 13 14) (k l m n r s t)))
  16. reset a pitch-sequence on a specific pitch (lowest, highest, middle pitch of the sequence) ;;;; SUB (defun center-position-in-list (list &key (get-value 'nil)) (let ((pos)) (progn (setf pos (if (evenp (length list)) (/ (length list) 2) (/ (1+ (length list)) 2))) (if (equal get-value 'nil) (append pos) (nth (1- pos) list))))) ;;; MAIN (defun reset-pitch-sequence (pitch-sequence pitch &key (type 'low)) (let ((pitch1 (cond ((equal type 'low) (car (find-ambitus pitch-sequence :type :pitch))) ((equal type 'high) (cadr (find-ambitus pitch-sequence :type :pitch))) ((equal type 'center) (center-position-in-list pitch-sequence :get-value t))))) (pitch-transpose (car (pitch-to-interval (list (if (chordp pitch1) (car (pitch-melodize pitch1)) (append pitch1)) pitch))) pitch-sequence))) (reset-pitch-sequence '(gs2 g2 a2 fs2 ds2 f2 e2) 'fs3 :type 'low) => (b3 bb3 c4 a3 fs3 gs3 g3) (reset-pitch-sequence '(gs2 g2 a2 fs2 ds2 f2 e2) 'fs3 :type 'high) => (f3 e3 fs3 eb3 c3 d3 cs3) (reset-pitch-sequence '(gs2 g2 a2 fs2 ds2 f2 e2) 'fs3 :type 'center) => (f3 e3 fs3 eb3 c3 d3 cs3)
  17. AM

    gen-integer-step*

    same with gen-integer-step (defun gen-integer-step* (n intervals &key (offset 0) (every-x 1) (reverse nil)) (let ((n (* n every-x)) (seq)) (setf seq (find-everyother every-x (subseq (gen-integer-step 0 (+ n offset) intervals) offset (+ n offset)))) (if (equal reverse nil) seq (reverse seq)))) (gen-integer-step* 20 '(1 -2 3 1)) => (0 1 -1 2 3 4 2 5 6 7 5 8 9 10 8 11 12 13 11 14) (gen-integer-step* 20 '(1 -2 3 1) :every-x 2) => (0 -1 3 2 6 5 9 8 12 11 15 14 18 17 21 20 24 23 27 26) (gen-integer-step* 20 '(1 -2 3 1) :offset 6 :every-x 4 :reverse t) => (59 56 53 50 47 44 41 38 35 32 29 26 23 20 17 14 11 8 5 2) ;;;; in combination with "reading-list-by-steps" (defun reading-list-by-steps (&key steps values (start (car values))) (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))))) (list-plot (reading-list-by-steps :steps (gen-repeat 5 '(1 2 -1 3 4 -1)) :values (gen-integer-step* 100 '(1 2 3 1) :offset 4 :reverse t)) :join-points t)
  18. AM

    fibonacci*

    same with fibonacci (defun fibonacci* (n &key (offset 0) (every-x 1) (reverse nil)) (let ((n (* n every-x)) (seq)) (setf seq (find-everyother every-x (subseq (fibonacci 0 (+ n offset)) offset (+ n offset)))) (if (equal reverse nil) seq (reverse seq)))) (fibonacci* 5 :offset 2) => (1 2 3 5 8) (fibonacci* 5 :offset 5 :every-x 2) => (5 13 34 89 233) (fibonacci* 5 :offset 5 :every-x 2 :reverse t) => (233 89 34 13 5) ;;;; in combination with "reading-list-by-steps" (defun reading-list-by-steps (&key steps values (start (car values))) (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))))) (list-plot (reading-list-by-steps :steps '(1 -1 4 -3 2 -1 3 -2 4 1 1 -1) :values (fibonacci* 14 :offset 6 :reverse t) :start 89) :join-points t)
  19. AM

    primes*

    a little prime-function-extension (defun primes* (n &key (offset 0) (every-x 1) (reverse nil)) (let ((n (* n every-x)) (seq)) (progn (setf seq (find-everyother every-x (subseq (primes (+ n offset)) offset (+ n offset)))) (if (equal reverse nil) seq (reverse seq))))) (primes* 4 :offset 0) => (2 3 5 7) (primes* 4 :offset 1) => (3 5 7 11) (primes* 6 :offset 8) => (23 29 31 37 41 43) (primes* 5 :offset 5 :every-x 2) => (13 19 29 37 43) (primes* 5 :offset 3 :every-x 4) => (7 19 37 53 71) (primes* 5 :offset 5 :every-x 3 :reverse t) => (61 47 37 23 13) ;;;; in combination with "reading-list-by-steps" (defun reading-list-by-steps (&key steps values (start (car values))) (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))))) (list-plot (reading-list-by-steps :steps '(1 2 -1 3 4 -1) :values (primes* 10 :offset 4 :reverse t)) :join-points t)
  20. ;;; alternative function for GEN-SYMMETRICAL: in combination ;;; with FIND-UNIQUE => symmetries with unique items (except ;;; what is generated by symmetry) (defun gen-symmetrical* (n list) (let ((list (rnd-order list)) (newlist (rest list)) (center (car list))) (if (> n (* 2 (length list))) 'list-has-too-few-items (if (evenp n) (progn (setf list (rnd-unique (/ n 2) newlist)) (append list (reverse list))) (progn (setf list (rnd-unique (/ (1- n) 2) (rest newlist))) (append list (list center) (reverse list))))))) (gen-symmetrical* 5 '(1 2 3 4 5 6 7 8)) (gen-symmetrical* 9 '(1 2 3 4 5 6 7 8)) (gen-symmetrical* 30 '(1 2 3 4 5 6 7 8)) => list-has-too-few-items ; error-message
  21. AM

    shift-proportions

    you are right, but it is okay for my use - if someone wants to make it smarter, it is very welcome - but I have to do some other things :-)
  22. AM

    shift-proportions

    ;;; CODE (defun shift-proportions (integer-seq shift &key (type 'primes)) (let ((number-seq)) (progn (setf number-seq (cond ((equal type 'primes) (primes 30)) ((equal type 'fibonacci) (fibonacci 1 20)) ((equal type 'decimal) (gen-integer-step 1 200 1)))) (setf number-seq (append (reverse (neg! number-seq)) number-seq)) (loop for i in integer-seq when (> i 0) collect (nth (+ (car (position-item i number-seq)) shift) number-seq) else collect (nth (- (car (position-item i number-seq)) shift) number-seq))))) ;;; EXAMPLE => the integer-seq must include only values from ":type"-system (shift-proportions '(1 2 3 4 5 -3 2 -1 3 -8) 1 :type 'decimal) => (2 3 4 5 6 -4 3 -2 4 -9) (shift-proportions '(1 2 -13 4 5 -3 2 -1 3 -8) 8 :type 'decimal) => (9 10 -21 12 13 -11 10 -9 11 -16) (shift-proportions '(3 5 -17 -11 23) 1 :type 'primes) => (5 7 -19 -13 29) (shift-proportions '(3 5 -17 -11 23) 5 :type 'primes) => (17 19 -37 -29 43) (shift-proportions '(-5 55 -34 233 -89) 1 :type 'fibonacci) => (-8 89 -55 377 -144) (shift-proportions '(-5 55 -34 233 -89) 3 :type 'fibonacci) => (-21 233 -144 987 -377)
  23. AM

    a simple lisp question

    THANX!!! andré
  24. is it possible to do such a (nonsense-function) with mapcar (then with loop)? -> how should i handle the &key (y 1) with mapcar? possible? a function without &key is clear but with &key ....??? thanx for a note (defun testfu (value &key (y 1)) (* (random 10) value y)) (loop for i in '(1 2 3 4 5) for j in '(1 2 3 4 5) collect (testfu i :y j))
  25. perhaps something like that? only a sketch... modify it... don't work in all cases... ;;; SUBFUNCTIONS ;;; TAKES A GIVEN TONAILTY AND EXPAND IT FOR X OCTAVES (defun multiple-expand-tonality (&key startpitch octaves tonality) (remove-duplicates (loop repeat octaves with pitch = startpitch with cnt = 0 when (= cnt (length tonality)) do (setq cnt 0) append (expand-tonality (list pitch (nth cnt tonality))) do (incf cnt) do (setq pitch (car (pitch-transpose 12 (list pitch))))))) ;;; EXPAND A TONALITY BY STEPS -> in a sense of schillinger? (defun tonality-with-scale-expansion (tonality expansion-nr) (let ((expansion (nth expansion-nr '(0 1 2 3 4 5 6)))) (reading-list-by-steps :steps (gen-repeat 53 expansion) :values (multiple-expand-tonality :startpitch 'c0 :octaves 8 :tonality (list tonality)) :start 'c0))) ;;; READS THE PITCHSEQUQNZ IN A TONALITY NOT AS INTERVALS , READS IT AS STEPS (IN A GIVEN PITCHFIELD) (defun get-steps (tonality pitches) (let ((tonality-space (multiple-expand-tonality :startpitch 'c0 :octaves 8 :tonality (list tonality)))) (difference (loop for i in pitches append (position-item i tonality-space))))) ;;; READS A LIST NY STEPS AND NOT BY INTERVALS -> USEFULL WHEN WORKING WITH PITCHFIELDS ;;; ALSO AVAILABLE IN TONALITY-MAP!!! (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))))) ;;; filter-pitches-octave-independent (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) collect (setq p2 (+ p2 12))))))) (loop for i in (pitch-to-midi pitches) when (not (null (member i search-field))) collect (midi-to-pitch i)))) ;;; MAIN_FUNCTION --------------------------------------------------------------------------------------------------------------------- (defun expand-melody (expansion-nr tonality melody) (let ((start-pitch (nth expansion-nr (expand-tonality (list 'c4 (car (list tonality)))))) (new-tonality (tonality-with-scale-expansion tonality expansion-nr))) (pitch-transpose-start start-pitch (reading-list-by-steps :steps (get-steps 'major melody) :values new-tonality :start (car (filter-pitches-octave-independent new-tonality (list start-pitch))))))) (expand-melody 1 'major '(c4 f4 e4 f4 g4 a4)) (expand-melody 2 'major '(c4 f4 e4 f4 g4 a4)) (expand-melody 3 'major '(c4 f4 e4 f4 g4 a4)) (expand-melody 4 'major '(c4 f4 e4 f4 g4 a4))
×