Jump to content

AM

Members
  • Content Count

    544
  • Joined

  • Last visited

Posts posted by AM


  1. 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)) (omn-to-measure omnseq measure)) '(1/4))))))
    
    
    
    (setf mat '((e c4 cs4 d4 ds4 e4 f4 fs4 g4) 
                (e c3 cs3 d3 ds3 e3 f3 fs3 g3) 
                (e c6 cs6 d6 ds6 e6 f6 fs6 g6)))
    
    
    
    (copy-omn-seq mat '((2 3))) ;; bar 2 from beat 3 until end of bar
    => ((e e3 f3 e fs3 g3))
    
    (copy-omn-seq mat '((1 1)) :span 2) ;; bar 1 from beat 1 for 2 quarters
    => ((e c4 cs4 e d4 ds4))
    
    (copy-omn-seq mat '((1 2) (2 3) (3 4))) ;; same thing with more then ONE filterings
    => ((e d4 ds4 e e4 f4 e fs4 g4) (e e3 f3 e fs3 g3) (e fs6 g6))
    
    (copy-omn-seq mat '((1 2) (2 3) (3 4)) :span 1) ;; same - every filtering with span 1
    => ((e d4 ds4) (e e3 f3) (e fs6 g6))

     


  2. ;;; 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+span))
             (divided-intseq (gen-divide spanseq intseq)))
    
        (length-rational-quantize (flatten (gen-length divided-intseq rhyseq)) :round round)))
    
    
    
    
    (change-time-structure '(2/44 -2/44 3/44 5/44 6/44) '((32 2) (20 2) (28 3)) :basic-rhy 44)
    => (1/16 -1/16 -1/8 3/20 1/4 -1/10 3/14 -1/28)
    
    (change-time-structure '(2/32 -2/32 3/32 5/32 6/32) '((20 2) (44 2) (28 3)) :basic-rhy 32)
    => (1/10 -1/10 -1/20 3/44 5/44 -3/44 3/14 -1/28)

     

    could be done better -> go for it 🙂

    greetings

    andré


  3. something like that?

     

    (defun length-to-binary (lengthlist n)
      (let ((newlist (loop for i in (omn :length lengthlist)
                        collect (/ i n))))
        (loop for x in newlist
          when (> x 0)
          append (append (list 1) (gen-repeat (1- x) '0))
          else append  (gen-repeat (abs x) '0))))
        
    
    (length-to-binary '(-q q e) 1/16)
    => (0 0 0 0 1 0 0 0 1 0)
    
    (length-to-binary '(-q s s q e) 1/16)
    => (0 0 0 0 1 1 1 0 0 0 1 0)

     


  4. 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)

     


  5. 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)

     

     

     


  6. 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)

     

     


  7. (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)

     


  8. (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)

     


  9. 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)
    

     


  10. ...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)
    

     

     

     


  11. 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
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

     


  12. 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:

     

    screen.jpeg

     

     

     

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

     

     

×
×
  • Create New...