Jump to content

AM

Members
 View Profile  See their activity

  • Posts

    793

  • Joined

  • Last visited

 Content Type 

Posts posted by AM

    copy-omn-seq

    in User Extensions Source Code

    Posted

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

     

    change-time-structures

    in User Extensions Source Code

    Posted 

    ;;; 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é

    Help needed Binary Length values

    in Function Examples

    Posted

    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)

     

    filter-omn-by-intervals

    in User Extensions Source Code

    Posted

    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)

     

    rest-diminution/augmentation

    in User Extensions Source Code

    Posted

    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)

     

     

     

    filter-events-by-length

    in User Extensions Source Code

    Posted

    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)

     

     

    replace-lengths-of-a-pitch-sequence

    in User Extensions Source Code

    Posted 

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

     

    omn-sieve-filter

    in User Extensions Source Code

    Posted 

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

     

    binary-filter

    in User Extensions Source Code

    Posted

    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)

     

    neg-sieve

    in User Extensions Source Code

    Posted

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

     

     

     

    logikgatter / logic gates (completed)

    in User Extensions Source Code

    Posted

    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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

     

    vector-range-drift

    in User Extensions Source Code

    Posted

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

     

     

    how to code a NAND gate?

    in User Extensions Source Code

    Posted

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

     

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy

  I accept