AM

November 6, 2017

you're welcome :-)

greetings

andré

opmo · November 6, 2017

like that?

(setf lengths  '(1/2 1/16 7/16 1/8 3/8 3/16 5/16 1/4 1/4 5/16  3/16))
(setf pitches '(g4 gs4 fs4 a4 gs4 g4 f4 bb4 fs4 a4 g4 gs4 a4 fs4 e4 b4
                gs4 g4 f4 bb4 g4 gs4 fs4 a4 f4 bb4 gs4 g4 bb4 f4 eb4 c5
                fs4 a4 g4 gs4 a4 fs4 e4 b4 g4 gs4 fs4 a4 gs4 g4 f4 bb4
                a4 fs4 e4 b4 fs4 a4 g4 gs4 e4 b4 a4 fs4 b4 e4 d4 cs5 gs4
                g4 f4 bb4 g4 gs4 fs4 a4 f4 bb4 gs4 g4 bb4 f4 eb4 c5 g4
                gs4 fs4 a4 gs4 g4 f4 bb4 fs4 a4 g4 gs4 a4 fs4 e4 b4 f4
                bb4 gs4 g4))

;;; get the pitches
(loop for i in (append (list 0)
                       (cumulative-sums (loop for k in lengths collect (/ k 1/16))))
  collect (nth i pitches))

;;; a function which generates OMN-format
(defun superimpose (lengths pitches)
  (make-omn :length lengths
            :pitch (loop for i in (append (list 0)
                                          (cumulative-sums (loop for k in lengths
                                                             collect (/ k 1/16))))
                     collect (nth i pitches))))

;;; evaluate -> OMN output
(superimpose '(1/2 1/16 7/16 1/8 3/8 3/16 5/16 1/4 1/4 5/16 3/16)
             '(g4 gs4 fs4 a4 gs4 g4 f4 bb4 fs4 a4 g4 gs4 a4 fs4 e4
               b4 gs4 g4 f4 bb4 g4 gs4 fs4 a4 f4 bb4 gs4 g4 bb4 f4
               eb4 c5 fs4 a4 g4 gs4 a4 fs4 e4 b4 g4 gs4 fs4 a4 gs4
               g4 f4 bb4 a4 fs4 e4 b4 fs4 a4 g4 gs4 e4 b4 a4 fs4
               b4 e4 d4 cs5 gs4 g4 f4 bb4 g4 gs4 fs4 a4 f4 bb4 gs4
               g4 bb4 f4 eb4 c5 g4 gs4 fs4 a4 gs4 g4 f4 bb4 fs4 a4
               g4 gs4 a4 fs4 e4 b4 f4 bb4 gs4 g4))

October 29, 2017

would be also interesting for me/my work!

greetings

andré

User Extensions Source Code · September 24, 2017

i would only need the "FUNCTION" who starts the midi-play and the function which EVALUATEs (quasi the function behind the short-cuts)

thanx

User Extensions Source Code · September 23, 2017

question (from a non-programmer):

is there a possibility (a way) to evaluate and/or start-to-play with a delay (of x-seconds) in opusmodus/lisp?

would be interesting in the context of using POLYTEMPO NETWORK http://polytempo.zhdk.ch (virtual conductor) and LIVE-evaluation/play of an algorithm (and playing it live by an e-player) on/with a specific (delay-)time.

could be something like:

"do evaluate algorithm"

"do play it in 21.543 seconds"

any ideas or solutions?

thanx for help

andré

User Extensions Source Code · September 16, 2017

two functions i needed for working with POLYTEMPO-NETWORK

http://philippekocher.ch/#109

http://polytempo.zhdk.ch

greetings

andré

(defun length-to-decimal (alist &key (sum nil))
  (let ((list (loop for i in (omn :length alist)
                collect (float (* i 4)))))
      (if (equal sum t)
      (sum list)
      list)))

;;; result: q = 1 / h. = 3 ...etc...
(length-to-decimal '(h. h. 3q 5e 3h))
=> (3.0 3.0 0.33333334 0.1 0.6666667)

(length-to-decimal '(h. h. 3q 5e 3h) :sum t)
=> 7.1

(defun length-to-sec (alist tempo &key (sum nil))
  (let ((list (loop for i in (omn :length alist)
                collect (* (/ 60 tempo) (float (* i 4))))))
    (if (equal sum t)
      (sum list)
      list)))

(length-to-sec '(h. h. 3q 5e 3h) 60)
=> (3.0 3.0 0.33333334 0.1 0.6666667)

(length-to-sec '(h. h. 3q 5e 3h) 51)
=> (3.5294118 3.5294118 0.3921569 0.11764707 0.7843138)

(length-to-sec '(h. h. 3q 5e 3h) 51 :sum t)
=> 8.3529415

User Extensions Source Code · August 22, 2017

"I changed your keyword arguments to plain arguments, because in my code I retain keyword arguments for named optional arguments, but the arguments of this function are not optional (there is no default value)."

sometimes i'm using keyword arguments for "better understandig"/legibility/overview of the function. but i see it's not "state of the art", thanks for the hint! :-)

User Extensions Source Code · August 22, 2017

thanx!! you are totally right... :smile: i have documanted it in my OM-library (but not in the code)

...will answer you later...

have also a look to:

it's more useful for me

grettings

andré

hujairi · August 7, 2017

an output-seq of "a little stupid bot" (works with stochastic broken-symmetrical elements and PM..) - could produce for eternety (never ending)...

it works and i am going for holidays now

greetings

andré

July 22, 2017

hi wim, thank you for the link...

also interesting are "non-trivial machines" (heinz von förster / radical constructivism):

http://www.cybsoc.org/heinz.htm

greetings

andré

July 18, 2017

that is clear to me ... I tried only to find out what the motivation / idea behind the question of WIM is.

July 18, 2017

okay, i understand your wish... you would like to have some code which produces/composes a "nearly complete piece" for you - like a bot (for my own use i call this programs BOTS and code it by myself).

such bots: a nightmare or a dream for a composer :-)

some important books/links TORSTEN already listed. maybe we should not forget DAVID COPE - with his EMMY-things ...

https://www.youtube.com/channel/UC2Ma0T4VZtmtB6kMmNw7QIA
https://en.wikipedia.org/wiki/David_Cope

p.s. i am not convinced of such "style exercises" (using TOOLS to imitate musical styles), it is perhaps just as if you translate with the google-translater: you understand what is meant, but it often sounds quite strange (as also this text :-))...

it is usually more interesting in a scientific/technological or "produce efficient", than in an aesthetic/artistic context; but it does not make it in my opinion generally unimportant, but only the goal or the idea behind it is another. (Google Translate)

best wishes

andré

July 17, 2017

could you tell me your exact definition/specification of OM-"out-of-the-box"-algorithms?

User Extensions Source Code · July 5, 2017

(defun merge-voices** (seq &key insert bar/beat)
   (car 
    (last
     (let ((bar) (beat) (distance))
       (progn
         (setf bar (loop for i in bar/beat collect (car i))
               beat (loop for j in bar/beat collect (cadr j)))
         (loop 
           for ba in bar 
           for be in beat
           for ins in insert
           with time-sign = (get-time-signature seq)
           with ord-time-sign = (get-time-signature seq)
           
          do (setf time-sign (if (listp (car time-sign))
                               (loop for i in time-sign
                                 when (> (caddr i) 1)
                                 append (loop repeat (caddr i)
                                          collect (list (car i) (cadr i)))
                                 else collect (list (car i) (cadr i)))
                               (append time-sign))
                   
                   distance (if (listp (car time-sign))
                              (+ (sum (loop repeat (- ba 1)
                                        for i in time-sign
                                        collect (/ (car i) (cadr i))))
                                 (/ (1- (car be)) (cadr be)))
                              (+ (* (1- ba) (/ (car time-sign) (cadr time-sign)))
                                 (/ (1- (car be)) (cadr be)))))

           do (setf ins (append (list (neg! distance)) ins))
           do (setf seq (omn-to-time-signature 
                         (length-rest-merge 
                          (flatten (merge-voices (omn-merge-ties seq) ins)))
                          ord-time-sign))
           collect seq
           do (setf time-sign ord-time-sign)))))))

(merge-voices** '((q c4 c4 c4 c4) (q c4 c4 c4 c4) (q c4 c4 c4 c4))
                :insert '((q a4 a4 a4))
                :bar/beat '((2 (2 8))))

(merge-voices** '((q c4 c4 c4 c4) (q c4 c4 c4 c4) (q c4 c4 c4 c4) (q c4 c4 c4 c4))
                :insert '((q b5 b5 b5)
                          (e a4 a4 a4))
                :bar/beat '((2 (2 8))
                            (3 (2 16))))

July 4, 2017

i know POSITION-ATTRIBUTE, but the output-format seems to be a bit different.

one of the "problems" for coding the function is to distinguish the "pattern-match" (=> multiple-values of pitches/lengths/... comibinations of these parameters)

that's seems not very simple, single-values are okay...

...but at the moment i have other things to do (composing/playing), so it will take some time, but perhaps anyone else would create such a function (stéphane, thorsten..? :cool: )

opmo · July 1, 2017

dear janusz

what do you think about the idea(s) to work with "bar/beat" for post-processing the scores. i see that's - in my momentary work - very useful...

for example: insert at bar/beat, cut-out bar/beat/span, overwrite bar/beat, pattern-matching bar/beat/span ... ?

by the way i'm coding a little bit on a function which gets me the positions of perhaps a pattern-match (single values and patterns), in the format (bar (beat)), for example (1 (3 4)), but it's not so simple... (a lot of specialities, and i can't put it into ONE code)

...

greetings

andré

Posted July 1, 2017 · July 1, 2017

thanky you, stephane, i'll test it today!

User Extensions Source Code · July 1, 2017

added!

Posted June 30, 2017 · June 30, 2017

i would like to "structure" my user-library in "UTILITIES", there are so many functions in there so i would like to organize it more specific...

like:

PATTERN MATCHING

SYMMETRIES

EDITING SCORE

etc...

is there a possibility?

thanx

andré

User Extensions Source Code · June 30, 2017

;;; SPLITS CHORDS INTO APP/ACC

;;; SUB -> could be replaced by an original-OPMPO-function

(defun omn-component-replace (omn-sequence replace-component)
  (make-omn :length (if (lengthp (car replace-component))
                     (append replace-component)
                     (omn :length omn-sequence))
            :pitch (if (or (pitchp (car replace-component)) (chordp (car replace-component)))
                     (append replace-component)
                     (omn :pitch omn-sequence))
            :velocity (if (velocityp (car replace-component))
                        (append replace-component)
                        (omn :velocity omn-sequence))
            :articulation (if (articulationp (car replace-component))
                            (append replace-component)
                            (omn :articulation omn-sequence))))



;;; MAIN

(defun split-chord-to-app/acc (omn-list &key (type 'app))  
  (let ((i))
    (loop  repeat (length (single-events (flatten omn-list)))
      for cnt = 0 then (incf cnt)
      
      do (setf i (nth cnt (single-events (flatten omn-list))))
      when (chordp (car (omn :pitch i)))
      append (append (list (append (list type) (list'e)  (butlast (melodize (car (omn :pitch i))))))
                     (omn-component-replace i (last (melodize (car (omn :pitch i))))))
      and do (incf cnt)
      and do (setf i (nth cnt (single-events (flatten omn-list))))
      else append i)))


(split-chord-to-app/acc '(e c4 ppp d4 ff pizz e4f4 g4 a4) :type 'acc)
(split-chord-to-app/acc '(e c4 ppp d4 ff pizz e4f4 g4 a4) :type 'app)

(split-chord-to-app/acc '(e c4 ppp d4 ff pizz e4f4c5 g4 a4) :type 'acc)
(split-chord-to-app/acc '(e c4 ppp d4 ff pizz e4f4c5 g4 a4) :type 'app)

User Extensions Source Code · June 29, 2017

here is a function that can be used for "post-..." of an OMN score...

you could INSERT a sequence by BAR/BEAT (a slightly modified variant of OVERWRITE), so you can

place your insert exactly!

greetings

andré

;;; INSERTING

(defun get-resolution2 (be)
  (cond ((member (cadr be) '(3 6 12 24 48))
         1/24)
        ((member (cadr be) '(1 2 4 8 16 32))
         1/16)
        ((member (cadr be) '(5 10 20 40))
         1/20)
        ((member (cadr be) '(7 14 28 56 1))
         1/28)))

(defun insert (seq &key insert bar/beat)
   (car 
    (last
     (let ((bar) (beat) (resolution) (distance))
       (progn
         (setf bar (loop for i in bar/beat collect (car i))
               beat (loop for j in bar/beat collect (cadr j)))
         (loop 
           for ba in bar 
           for be in beat
           for ins in insert
           with time-sign = (get-time-signature seq)
           with ord-time-sign = (get-time-signature seq)
           ;with ins-rounded = '(0)
           with ins-add = '(0)
           
          do (setf resolution (get-resolution2 be)
                   time-sign (if (listp (car time-sign))
                               (loop for i in time-sign
                                 when (> (caddr i) 1)
                                 append (loop repeat (caddr i)
                                          collect (list (car i) (cadr i)))
                                 else collect (list (car i) (cadr i)))
                               (append time-sign))
                   
                   distance (if (listp (car time-sign))
                              (+ (sum (loop repeat (- ba 1)
                                        for i in time-sign
                                        collect (/ (/ (car i) (cadr i))
                                                   (get-resolution2 be))))
                                 (/ (/ (1- (car be)) (cadr be)) 
                                    (get-resolution2 be))
                                 ;;; ins-rounded add
                                 (/ (get-span (flatten ins-add))
                                    (get-resolution2 be))
                                 )
                              
                              (+ (/ (* (1- ba) (/ (car time-sign) (cadr time-sign))) 
                                       (get-resolution2 be))
                                 (/ (/ (1- (car be)) (cadr be)) 
                                       (get-resolution2 be))
                                 ;;; ins-rounded add
                                 (/ (get-span (flatten ins-add))
                                    (get-resolution2 be)))
                                 ))
           
          do (setf seq 
                   (omn-to-time-signature 
                    (length-rest-merge 
                      (flatten
                       (loop repeat (length (omn-to-time-signature seq 
                                                                   (list (numerator resolution) 
                                                                         (denominator resolution))))
                         for cnt = 0 then (incf cnt)
                         
                         with new-seq = (omn-to-time-signature seq (list (numerator resolution) 
                                                                         (denominator resolution)))
                         with ins-rounded = (append ins 
                                                    (rest (length-rational-quantize
                                                           (list (apply '+ (mapcar 'abs (omn :length ins))))
                                                           :round resolution)))
                         when (= cnt distance) collect ins-rounded and do (setf ins-add (append ins-rounded ins-add))
                         else collect (nth cnt new-seq))))
                    ord-time-sign))
          do (setf time-sign ord-time-sign)
          collect (omn-merge-ties seq)))))))



;;; EXAMPLES:

;;; with changing time-signatures

(insert '((e c6 a5 h b5 q tie) (q b5 b5 a5 tie) (q a5 q a5) (h. g5))
                        :insert '((-3q 3q c5 b4 bb4 a4) 
                                  (-3q 3q c4 b3 bb3 a3))
						;;; bar numbers has to be in ascending order!
                        :bar/beat '((1 (1 12)) 
                                    (3 (1 12))))


(insert '((e c6 a5 h b5 q tie) (q b5 b5 a5 tie) (q a5 q a5) (h. g5))
                        :insert '((-2/12))
                        :bar/beat '((2 (2 12)))) 


;;; with constant time-signature

(insert '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5))
                        :insert '((3q c5 b4 bb4 a4) 
                                  (-3q 3q c4 b3 bb3 a3))
						;;; bar numbers has to be in ascending order!
                        :bar/beat '((1 (7 12)) 
                                    (3 (2 12))))


(insert '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5))
                        :insert '((-h.))
                        :bar/beat '((2 (1 4))))

User Extensions Source Code · June 29, 2017

an "old user-function" from my library - just "habit", better with MEMBER. it's now replaced

User Extensions Source Code · June 28, 2017

i think, it works like that :-)

now, you could OVERWRITE you original OMN sequentially with inserts... (it's very useful for "post-production" of your generated score!).

i have changed the input-format (bar/beat), and it also works with changing time-signatures... i know, janusz or the opmp-programmers could code it smarter, but my concept/code seems to work... so take it and optimize it!!!

greetings

andré

p.s. when wil be approx. the release of vers 2 of OPMO?

;;; OVERWRITING

(defun get-resolution2 (be)
  (cond ((member (cadr be) '(3 6 12 24 48))
         1/24)
        ((member (cadr be) '(1 2 4 8 16 32))
         1/16)
        ((member (cadr be) '(5 10 20 40))
         1/20)
        ((member (cadr be) '(7 14 28 56 1))
         1/28)))

(defun overwrite (seq &key insert bar/beat)
   (car 
    (last
     (let ((bar) (beat) (resolution) (distance))
       (progn
         (setf bar (loop for i in bar/beat collect (car i))
               beat (loop for j in bar/beat collect (cadr j)))
         (loop 
           for ba in bar 
           for be in beat
           for ins in insert
           with time-sign = (get-time-signature seq)
           with ord-time-sign = (get-time-signature seq)
           
          do (setf resolution (get-resolution2 be)
                   time-sign (if (listp (car time-sign))
                               (loop for i in time-sign
                                 when (> (caddr i) 1)
                                 append (loop repeat (caddr i)
                                          collect (list (car i) (cadr i)))
                                 else collect (list (car i) (cadr i)))
                               (append time-sign))
                   
                   distance (if (listp (car time-sign))
                              (+ (sum (loop repeat (- ba 1)
                                        for i in time-sign
                                        collect (/ (/ (car i) (cadr i))
                                                   (get-resolution2 be))))
                                 (/ (/ (1- (car be)) (cadr be)) 
                                    (get-resolution2 be)))
                              
                              (+ (/ (* (1- ba) (/ (car time-sign) (cadr time-sign))) 
                                    (get-resolution2 be))
                                 (/ (/ (1- (car be)) (cadr be)) 
                                    (get-resolution2 be)))))
          
          do (setf seq 
                   (omn-to-time-signature 
                    (length-rest-merge 
                     (omn-merge-ties 
                      (flatten
                       (loop repeat (length (omn-to-time-signature seq 
                                                                   (list (numerator resolution) 
                                                                         (denominator resolution))))
                         for cnt = 0 then (incf cnt)
                         
                         with new-seq = (omn-to-time-signature seq (list (numerator resolution) 
                                                                         (denominator resolution)))
                         with ins-rounded = (append ins 
                                                    (rest (length-rational-quantize
                                                           (list (apply '+ (omn :length ins)))
                                                           :round resolution)))
                         when (= cnt distance) collect ins-rounded 
                         and do (setf cnt (+ (/ (get-span (flatten ins-rounded)) resolution) 
                                             cnt -1))
                         else collect (nth cnt new-seq)))))
                    ord-time-sign))
          do (setf time-sign ord-time-sign)
          collect seq))))))



;;; EXAMPLES:

;;; with changing time-signatures

(overwrite '((e c6 a5 h b5 q tie) (q b5 b5 a5 tie) (q a5 q a5) (h. g5))
                        :insert '((3q c5 b4 bb4 a4) 
                                  (3q c4 b3 bb3 a3))

                        :bar/beat '((1 (2 12)) 
                                    (3 (1 12))))

;;; with constant time-signature
(overwrite '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5))
                        :insert '((3q c5 b4 bb4 a4) 
                                  (3q c4 b3 bb3 a3))

                        :bar/beat '((1 (7 12)) 
                                    (3 (2 12))))

User Extensions Source Code · June 23, 2017

EXAMPLE 3 -> inserts "by hand"

;;; -----------------------------------------------------------------------------
;;; EXAMPLE 3 PLACING BY HAND AT BAR/BEAT
;;; -----------------------------------------------------------------------------

(init-seed 5)
;(init-seed (random 5))


;;; GENERATING A "NONSENSE STRUCTURAL NET"

(setf basic-mat (omn-to-time-signature
                 (make-omn :pitch (integer-to-pitch (rnd-row))
                           :length (flatten (gen-mix (gen-length (gen-repeat 12 1) 1/16) 
                                                    (gen-length (mapcar '1+ (rnd-row)) -1/8)))
                           :velocity '(ppp))
                 '(4 4)))

;;; -----------------------------------------------------------------------------

;;; YOU WANT TO PUT AN INSERT at BAR 3 on the 2/16 beat
(setf mat0 (inserting-on-bar/beat* (length-rest-merge basic-mat)
                                   :insert (rnd-sample-seq 5 (make-omn :pitch (integer-to-pitch (rnd-row))
                                                                       :length (rnd-repeat 12 '(1/32))
                                                                       :velocity '(fff)))
                                   :time-sign '(4 4)
                                   :bar 3
                                   :beat '(2 16)))

;;; -----------------------------------------------------------------------------


;;; YOU WANT TO PUT AN INSERT at BAR 2 on the 3/20 beat
(setf mat0 (inserting-on-bar/beat* (length-rest-merge mat0)
                                   :insert (rnd-sample-seq 5 (make-omn :pitch (integer-to-pitch (rnd-row))
                                                                       :length (rnd-repeat 12 '(1/20))
                                                                       :velocity '(fff)))
                                   :time-sign '(4 4)
                                   :bar 2
                                   :beat '(3 20)))

;;; -----------------------------------------------------------------------------


;;; YOU WANT TO PUT AN INSERT at BAR 6 on the 5/24 beat
(setf mat0 (inserting-on-bar/beat* (length-rest-merge mat0)
                                   :insert (rnd-sample-seq 5 (make-omn :pitch (integer-to-pitch (rnd-row))
                                                                       :length (rnd-repeat 12 '(1/24))
                                                                       :velocity '(fff)))
                                   :time-sign '(4 4)
                                   :bar 6
                                   :beat '(5 24)))

(setf mat0 (length-rest-merge mat0))

;;; -----------------------------------------------------------------------------
;;; SCORE
;;; -----------------------------------------------------------------------------


(def-score solo-trumpet
           (:title "solo trumpet"
                   :key-signature 'atonal  
                   :time-signature '(4 4)
                   :tempo 134
                   :layout (bracket-group 
                            (treble-layout 'original)
                            (treble-layout 'overwrite1)))  

  (original 
   :omn basic-mat; ORIGINAL
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (overwrite1; ORIGINAL WITH INSERTS/OVERWRITES 
   :omn mat0
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))

added 1 minute later

it's not perfect, some bugs from time to time (if you do something "special")... try to fix it...

greetings

andré

User Extensions Source Code · June 23, 2017

;;; -----------------------------------------------------------------------------
;;; EXAMPLE -> an abstract example how it works (get-position/inserting-on-bar/beat*)
;;; -----------------------------------------------------------------------------


;;; SUB

(defun get-position (seq value &key (get 'all))
  (let ((beat)
        (bar (car
              (loop for i in seq
                for bar = 1 then (incf bar)
                append (loop for j in (single-events i)
                         when (pattern-matchp j (list value))
                         collect bar)))))
    (progn
      (setf beat (loop for k in (loop for i in (single-events (nth (1- bar) seq))
                                  when (not (pattern-matchp i (list value)))
                                  append (omn :length i)
                                  else collect 'match)
                   when (numberp k)
                   collect (abs k) into bag
                   when (equal k 'match)
                   do (return (list (1+ (numerator (abs (sum bag))))
                                    (denominator (abs (sum bag))))))))
    (cond ((equal get 'all)
           (list bar beat))
          ((equal get 'bar)
           (append bar))
          ((equal get 'beat)
           (append beat)))))

(defun get-resolution2 (beat)
  (cond ((memberp (cadr beat) '(3 6 12 24 48))
         1/24)
        ((memberp (cadr beat) '(1 2 4 8 16 32))
         1/16)
        ((memberp (cadr beat) '(5 10 20 40))
         1/20)
        ((memberp (cadr beat) '(7 14 28 56))
         1/28)))



;;; MAIN: INSERTING SEQ WITH OVERWRITE

(defun inserting-on-bar/beat* (seq &key insert time-sign bar beat)
  (let ((resolution (get-resolution2 beat))
        (ord-time-sign time-sign)
        (time-sign (if (listp (car time-sign))
                     (loop for i in time-sign
                       when (> (caddr i) 1)
                       append (loop repeat (caddr i)
                                collect (list (car i) (cadr i)))
                       else collect (list (car i) (cadr i)))
                     (append time-sign)))
        (distance (if (listp (car time-sign))
                    (+ (car (loop repeat (- bar 1)
                              for i in time-sign
                              collect (/ (* (1- bar) (/ (car i) (cadr i))) (get-resolution2 beat))))
                       (/ (/ (1- (car beat)) (cadr beat)) (get-resolution2 beat)))
                    
                    (+ (/ (* (1- bar) (/ (car time-sign) (cadr time-sign))) (get-resolution2 beat))
                       (/ (/ (1- (car beat)) (cadr beat)) (get-resolution2 beat))))))
    
    (omn-to-time-signature 
     (omn-merge-ties 
      (flatten
       (loop repeat (length (omn-to-time-signature seq 
                                                   (list (numerator resolution) (denominator resolution))))
         for cnt = 0 then (incf cnt)
         
         with new-seq = (omn-to-time-signature seq (list (numerator resolution) (denominator resolution)))
         with insert-rounded = (append insert 
                                       (rest (length-rational-quantize
                                              (list (apply '+ (omn :length insert)))
                                              :round resolution)))
         when (= cnt distance) collect insert-rounded 
         and do (setf cnt (+ (/ (get-span (flatten insert-rounded)) resolution) 
                             cnt -1))
         else collect (nth cnt new-seq))))
     ord-time-sign)))



;;; -----------------------------------------------------------------------------
;;; THE EXAMPLE 
;;; -----------------------------------------------------------------------------


(init-seed (random 20))

;;; GENERATING A "NONSENSE STRUCTURAL NET"

(setf basic-mat (omn-to-time-signature
                 (make-omn :pitch (integer-to-pitch (rnd-row))
                          :length (flatten (gen-mix (gen-length (gen-repeat 12 1) 1/16) 
                                                    (gen-length (mapcar '1+ (rnd-row)) -1/16)))
                          :velocity '(ppp))
                 '(4 4)))

;;; -----------------------------------------------------------------------------

;;; THE "GET-POSITION" searchs the position (bar/beat) of a specific value)
;;; and "inserting-on-bar/beat*" overwrites the basic OMN, and the iNSERT
;;; is sproutet at the  VALUE-point => here is an example with axiom and 4 generations

;;; FIRST GENERATION -> VALUE 'b4
(setf mat0 (inserting-on-bar/beat* basic-mat
                                   :insert '(s b4 ff cs5 ds5 e5 e fs5 fs5)  
                                   :time-sign '(4 4) 
                                   :bar (get-position basic-mat 'b4 :get 'bar)
                                   :beat (get-position basic-mat 'b4 :get 'beat)))

;;; SECOND GENERATION -> VALUE 'gs4
(setf mat1 (inserting-on-bar/beat* mat0
                                   :insert (pitch-transpose -3 (pitch-invert '(s b4 ff cs5 ds5 e5 e fs5 fs5) ) )
                                   :time-sign '(4 4) 
                                   :bar (get-position mat0 'gs4 :get 'bar)
                                   :beat (get-position mat0 'gs4 :get 'beat)))


;;; THIRD GENERATION -> VALUE 'g4
(setf mat2 (inserting-on-bar/beat* mat1
                                   :insert '(q g4 ff e4 h e4 q f4 d4 h d4)  
                                   :time-sign '(4 4) 
                                   :bar (get-position mat1 'g4 :get 'bar)
                                   :beat (get-position mat1 'g4 :get 'beat)))

;;; FOURTH GENERATION -> VALUE 'ds5 (is an elemnt of the INSERT in first generation!)
(setf mat3 (inserting-on-bar/beat* mat2
                                   :insert (pitch-transpose 4 (pitch-invert '(s b4 ff cs5 ds5 e5 e fs5 fs5) ) )
                                   :time-sign '(4 4) 
                                   :bar (get-position mat2 'ds5 :get 'bar)
                                   :beat (get-position mat2 'ds5 :get 'beat)))



(def-score solo-trumpet
           (:title "solo trumpet"
                   :key-signature 'atonal  
                   :time-signature '(4 4)
                   :tempo 134
                   :layout (bracket-group 
                            (treble-layout 'original)
                            (treble-layout 'overwrite1) ; gen1
                            (treble-layout 'overwrite2) ; gen2
                            (treble-layout 'overwrite3) ; gen 3
                            (treble-layout 'overwrite4))) ; gen 4
  

  (original 
   :omn basic-mat
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (overwrite1 
   :omn mat0
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (overwrite2 
   :omn mat1
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)
    (overwrite3 
   :omn mat2
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)
  (overwrite4 
   :omn mat3
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))

added 12 minutes later

another, easy-to-understand example

;;; -----------------------------------------------------------------------------
;;; EXAMPLE2 
;;; -----------------------------------------------------------------------------


(init-seed (random 20))

;;; GENERATING A "NONSENSE STRUCTURAL NET"

(setf basic-mat (omn-to-time-signature
                 (make-omn :pitch (integer-to-pitch (rnd-row))
                           :length (flatten (gen-mix (gen-length (gen-repeat 12 1) 1/16) 
                                                    (gen-length (mapcar '1+ (rnd-row)) -1/16)))
                           :velocity '(ppp))
                 '(4 4)))

;;; -----------------------------------------------------------------------------


;;; PICKING A PITCH RANDOMLY
(setf value (rnd-pick (flatten (omn :pitch basic-mat))))


;;; INSERTS AT THE POSITION OF THE RANDOMLY CHOSEN PITCH
(setf mat0 (inserting-on-bar/beat* basic-mat
                                   :insert (make-omn :pitch (pitch-transpose-start value 
                                                                                   '(b4 cs5 ds5 e5 e fs5 fs5 gs5 gs5 gs5 gs5 fs5)) 
                                                     :length '(s s s s  e e s s s s  q)
                                                     :velocity '(fff))
                                   :time-sign '(4 4) 
                                   :bar (get-position basic-mat value :get 'bar)
                                   :beat (get-position basic-mat value :get 'beat)))


(def-score solo-trumpet
           (:title "solo trumpet"
                   :key-signature 'atonal  
                   :time-signature '(4 4)
                   :tempo 134
                   :layout (bracket-group 
                            (treble-layout 'original)
                            (treble-layout 'overwrite1)))  

  (original 
   :omn basic-mat
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (overwrite1 
   :omn mat0
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))

Forums

Events

Store

Video Gallery

Posts posted by AM

Important Information