Jump to content

AM

core_group_3
  • Content Count

    515
  • Joined

  • Last visited

  • Days Won

    108

Posts posted by AM


  1. often helpful in PATTERN MATCH things... (like in OPMO pattern-match-functions)

     

    here is a short IDEA for an octave-independent PITCH-PATTERN-MATCHP with possible WILDCARD, perhaps could help you...

     

    ;;;-------------------------------------------------------------- 
    ;;; PITCH PATTERN-MATCHP octave-independent
    ;;;-------------------------------------------------------------- 
    
    ;;; SUB
    (defun convert-pitch (pitches)
      (loop for i in pitches
        when (pitchp i)
        collect (compress (butlast (explode i)))
        else collect i))
    
    ;;; MAIN
    
    (defun pitch-pattern-matchp (pitchlist pattern)
      (let ((pitchlist (convert-pitch pitchlist))
            (pattern (convert-pitch pattern)))
        (pattern-matchp pitchlist pattern)))
    
    (pitch-pattern-matchp '(c4 d4 eb4 f4 g4) '(c ? e))
    => nil
    
    (pitch-pattern-matchp '(c4 d4 eb4 f4 g4) '(c ? eb))
    => t

     


  2. a kind of MERGE-SORT -> sorry for bad coding i didn't find a better solution -> perhaps a new SORT for GEN-SORT...

     

    (defun kind-of-merge-sort (alist)
      (progn 
        (setf alist (mcflatten (loop repeat 30
                                 do (setf alist (loop for i in (gen-divide 2 alist)
                                                  collect (sort-asc (flatten i))))
                                 
                                 collect alist)))
        
        (loop repeat (length alist)
          for cnt = 0 then (incf cnt)
          when (not (equal (nth cnt alist) (nth (1+ cnt) alist)))
          collect (nth cnt alist))))
    
    
    
    (list-plot (flatten (kind-of-merge-sort (rnd-order (gen-integer 0 20)))) :join-points t :point-radius 0 :style :fill)

     

    merge.jpeg


  3. thanx stephane! ...but when you have a look on the output...

     

     

    (gen-retrograde durations1 :omn t)

    => ((t s t) (t 13/96 3q) (5h = 3/35 7q = = = = 3/35 5h =) (3q 13/96 t) (t s t))

     

    Ohne Titel.jpeg

     

    or with FLATTEN: (gen-retrograde (flatten durations1) :omn t)

    => (t s t 3q 13/96 t 5h = 3/35 7q = = = = 3/35 5h = t 13/96 3q t s t)

     

    Ohne Titel 2.jpeg

     

     

     

    the "original notation" with no troubles

    => ((t s t) (3q 3e_s. t) (5h 5h 5q_7q 7q 7q 7q 7q 7q 7q_5q 5h 5h) (t s._3e 3q) (t s t))

     

    Ohne Titel.jpeg


  4. for some score-display it would be very very useful if when EVAL etc... (or use any of the OPMO-functions) OMN-notation would be displayed and not changing to RATIOS...

    have a look to this example: it's written like that, because then the display is very smart. when i use "rnd-pick" or other functions it changes from OMN to RATIO... very ugly then.

     

    is there an internal solution for that or another trick?

    thanx for help

    a.

     

    ;; NICE DISPLAY BY CMD3
    (setf durations1 (list 
                     '(t s t) 
                     '(3q 3e_s. t) 
                     '(5h 5h 5q_7q 7q 7q 7q 7q 7q 7q_5q 5h 5h) 
                     '(t s._3e 3q) 
                     '(t s t)
                     ))
    => ((t s t) (3q 3e_s. t) (5h 5h 5q_7q 7q 7q 7q 7q 7q 7q_5q 5h 5h) (t s._3e 3q) (t s t))
    
    
    ;;; UGLY DISPLAY BY CMD3 because of the OPMO-fuction
    (gen-retrograde durations1) ;; should result the same rhythm
    => ((1/32 1/16 1/32) (1/32 13/96 1/12) (1/10 1/10 3/35 1/28 1/28 1/28 1/28 1/28 3/35 1/10 1/10) (1/12 13/96 1/32) (1/32 1/16 1/32))
    
    
    ;;; the same
    (rnd-pick durations1)
    => (1/32 13/96 1/12)
    
    ;;; OKAY because LISP and not OPMO
    (nth 0 durations1)
    => (t s t)

     

    a practical example:

     

    ;;; WORKS => because in the last step it's on LISP-level
    (setf durations (list 
                     '(t s t) 
                     '(3q 3e_s. t) 
                     '(5h 5h 5q_7q 7q 7q 7q 7q 7q 7q_5q 5h 5h) 
                     '(t s._3e 3q) 
                     '(t s t)
    
                     '(t t t t)
                     '(5q 5q 5q 5q 5q)
                     '(3q 3q 3q)
                     '(7q 7q 7q 7q 7q 7q 7q)))
    
    (setf morph-list (flatten (gen-morph 7 '(0 1 2 3) '(4 5 6 7))))
    
    ;;cmd3
    (setf newdurations (loop for i in morph-list
                         append (nth i durations)))
    

    works.jpeg

     

    ;;; DON'T WORK => because OMPO chanhig the format to RATIOS
    
    (setf durations1 (list 
                     '(t s t) 
                     '(3q 3e_s. t) 
                     '(5h 5h 5q_7q 7q 7q 7q 7q 7q 7q_5q 5h 5h) 
                     '(t s._3e 3q) 
                     '(t s t)))
    
    
    (setf durations2 (list
                      '(t t t t)
                      '(5q 5q 5q 5q 5q)
                      '(3q 3q 3q)
                      '(7q 7q 7q 7q 7q 7q 7q)))
    
    ;;cmd3
    (setf newdurations  (flatten (gen-morph 7 durations1 durations2)))

    dontwork.jpeg

     

     


  5. thanx for the span-ignore-pause-HINT! ...but it makes no sense to me - when you are working with EVENTS (by numbering it) - to ignore some of them 😉

    the idea behind this concept is, that you could work with a (finished) score by changing some parameters or enlarge rests - like a kind of "post-production". in this way it's not necessary to go deep inside you generating-algorithms, you can only change things a little bit like in a notation-software (i think it's on that level). some months ago i had the idea to do such changes (post...) by positions with BARS/BEATS - but at the moment i think it's much better to signify the EVENTS and work directly on them. less errors and easy to code such post...-functions.

     


  6. the same idea with INSERT/REPLACE

     

    
    (defun replace-on-event-number (omn-list &key position/list (type 'replace) (output nil))
      (progn 
        (setf omn-list (loop 
                         for i in (single-events omn-list)
                         for cnt = 0 then (incf cnt)
                         with position-list = (loop for x in position/list collect (car x))
                         with list = (loop for y in position/list collect (rest y))
                         with cnt2 = 0
                         
                         
                         when (= cnt (nth cnt2 position-list))
                         collect (cond ((equal type 'replace) 
                                        (if (listp (nth cnt2 list))
                                          (flatten (nth cnt2 list))
                                          (nth cnt2 list)))
                                       ((equal type 'add)
                                        (list i (nth cnt2 list))))
                         
                         else collect i
                         
                         when (and (= cnt  (nth cnt2 position-list))
                                   (< cnt (car (last position-list))))
                         do (incf cnt2)))
        (if (equal output 'flatten)
          (flatten omn-list)
          omn-list)))
        
        
    
    ;;; EXAMPLES REPLACE
    
    (replace-on-event-number '(q g4 -q q g4 g4 g4 -q g4 g4 g4 g4)
                               :position/list '((1 (q g5d5))
                                                (5 -q))
                               :type 'replace)
    
    => ((q g4 mf) (q g5d5) (q g4 mf) (q g4 mf) (q g4 mf) (-q) (q g4 mf) (q g4 mf) (q g4 mf) (q g4 mf))
    
    
    
    (replace-on-event-number '(q g4 -q q g4 g4 g4 -q g4 g4 g4 g4)
                               :position/list '((1 (q g5d5))
                                                (5 -q))
                               :type 'replace
                               :output 'flatten)
    
    => (q g4 mf q g5d5 q g4 mf q g4 mf q g4 mf -q q g4 mf q g4 mf q g4 mf q g4 mf)
    
    
    ;;; EXAMPLES ADD
    
    (replace-on-event-number '(q g4 -q q g4 g4 g4 -q g4 g4 g4 g4)
                               :position/list '((1 -e.)
                                                (5 -w))
                               :type 'add
                               :output nil)
    
    => ((q g4 mf) ((-q) (-e.)) (q g4 mf) (q g4 mf) (q g4 mf) ((-q) (-w)) (q g4 mf) (q g4 mf) (q g4 mf) (q g4 mf))
    
    
    
    (replace-on-event-number '(q g4 -q q g4 g4 g4 -q g4 g4 g4 g4)
                               :position/list '((1 (w g6 ffff))
                                                (5 -w))
                               :type 'add
                               :output 'flatten)
    
    
    => (q g4 mf -q w g6 ffff q g4 mf q g4 mf q g4 mf -q -w q g4 mf q g4 mf q g4 mf q g4 mf)
    
    ;;;;

     


  7. it's not a common solution, only a specific for my project... 

     

    1) it should also work with chords - because it's made for EVENTS it's always one chord = one event

    2) of course, you have to decide/check if you like to merge rests or not => because i'm filtering the texture by a binary-seq (binaries from a jpeg, like a sieve) it's not the idea to merge the rests, but you could do that in a seperate step. but in my case every note/event (before filtering) is numbered, so with/when BINARY-FILTER/SIEVE you will keep the numbering concise.

     


  8. what you could do with it? 

    a precise "projection on a curve" of a generated OMN (in this example: a 12-tone-row, which is been permuted (by a SORTING-algorithm) from start to end, till it's a symmetrical scale)

     

    curve.jpeg


  9. greetings

    andré

     

    ;;; ---------------------------------------------------------------------------------------------------
    ;;; because i'm working with numbered-events (to have some more control) i has to code
    ;;; a specific tranposition-function, which is transposing on specific spans/positions
    ;;; ---------------------------------------------------------------------------------------------------
    
    ;;; SUB
    
    (defun and-span (n a b)
      (and (>= n a)
           (<= n b)))
    
    ;;; MAIN
    
    (defun transpose-on-event-number (omn-list &key positions/transpose-list)
      (loop 
        for i in (single-events omn-list)
        for cnt = 0 then (incf cnt)
        with position-list = (loop for x in positions/transpose-list collect (car x))
        with transpose-list = (loop for y in positions/transpose-list collect (rest y))
        with cnt2 = 0
    
    
        when (and (and-span cnt (car (nth cnt2 position-list)) (cadr (nth cnt2 position-list)))
                  (not (length-restp (car (omn :length i)))))
    
        collect (pitch-transpose-n (nth cnt2 transpose-list)  i)
        else collect i
    
        when (and (= cnt  (cadr (nth cnt2 position-list)))
                  (< cnt (cadar (last position-list))))
        do (incf cnt2)))
        
    
    ;;; ZERO-based (like in lisp)
    (transpose-on-event-number '(q g4 -q q g4 g4 g4 g4 g4 g4 g4 g4)
                               :positions/transpose-list '(((0 5) 1)
                                                           ((6 7) -3)
                                                           ((8 9) 12)))
    
    => ((q gs4 mf) (-q) (q gs4 mf) (q gs4 mf) (q gs4 mf) (q gs4 mf) (q e4 mf) (q e4 mf) (q g5 mf) (q g5 mf))

     


  10. i think it's good and important to see that opusmodus is not a notation software (like sibelius/finale/dorico...). the potential is rightly in another area and i believe that it is important to keep the basic idea of opusmodus in focus (it's important to have restrictions/limitations) - and i think the development team is very aware of that .

    you can not have everything, but what is possible should be very very smart in its kind.

     

    the longer i work with opusmodus, the more i realize, for what i can use it ...and when I have to switch to another platform. 

    and because it is so open, it is then possible for me to find solutions for my specific needs, by being able to program myself and not simply having to do what the existing tools / functions allow.

     

    okay i admit i'm a big fan of opusmodus, although i do not even compose with it but can try/simulate basic ideas of my work - doing abstract/new things and see what happens - like working in an LAB 🙂

     


  11. i coded a new/alternative version of LENGTH-INVERT. i used it for a so called BINARY-FILTER (for events) - have a look to the example and you see the reason.

    in some cases you will have a much better DISPLAY/SCORE, is there an OPMO version for that?

     

    greetings

    andré

     

    ;;; --------------------------------------------------------
    ;;; VERSION WITH OPMO length-invert
    ;;; --------------------------------------------------------
    
    (defun binary-filter-old (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 (list (length-invert (car i)))))))
    
    
    ;;; --------------------------------------------------------
    ;;; VERSION WITH OWN length-invert
    ;;; --------------------------------------------------------
    
    (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 (list (length-invert** (car i)))))))
             
    (defun length-invert** (length-val)
      (append (compress (list '- length-val))))   

     

     

    EXAMPLE WITH THE ORIGINAL VERSION:

     

    
    ;;; EXAMPLE => complex rhythms 
    
    (setf omn-seq (make-omn :length '(t s t 3q 3e_s. t 5h 5h 5q_7q 7q 7q 7q 7q 7q 7q_5q 5h 5h t s._3e 3q t s t)
                            :pitch '(a4)))
    
    
    ;;; when you use my BINARY-FILTER_OLD which has the OPMO length-invert you will get a strange display-result (looks bad)
    ;; have a look with cmd3
    
    (binary-filter-old omn-seq '(0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 1 1 1 1 1))
    
    => (-1/32 s a4 mf -1/32 3q a4 mf -13/96 t a4 mf -1/10 5h a4 mf -3/35 7q a4 mf -1/28 7q a4 mf -1/28 7q a4 mf 7q_5q a4 mf 5h a4 mf 5h a4 mf t a4 mf s._3e a4 mf 3q a4 mf)

    old.jpeg

     

     

     

    EXAMPLE WITH USING THE ALTERNATIVE VERSION:

     

    ;;; EXAMPLE => complex rhythms 
    (setf omn-seq (make-omn :length '(t s t 3q 3e_s. t 5h 5h 5q_7q 7q 7q 7q 7q 7q 7q_5q 5h 5h t s._3e 3q t s t)
                            :pitch '(a4)))
    
    ;;; when you use the new BINARY-FILTER with the new length-invert**
    ;; have a look with cmd3
    
    (binary-filter* omn-seq '(0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 1 1 1 1 1))
    
    => (-t s a4 mf -t 3q a4 mf -3e_s. t a4 mf -5h 5h a4 mf -5q_7q 7q a4 mf -7q 7q a4 mf -7q 7q a4 mf 7q_5q a4 mf 5h a4 mf 5h a4 mf t a4 mf s._3e a4 mf 3q a4 mf)
    
    ;;; you see the FORMAT (-3e_s.) didn't changed in the rests (not -13/96), so it will be displayed well

    new.jpeg

     


  12. i get an error... when i evaluate this

     

    (setf with-ch1 (omn-articulation-processor
                    map 
                    (pitch-ornament
                     (make-chord-if-length
                      flow1
                      :interval-list '((-7 -19 3 9)(-4 -16 3 7)
                                       (-5 -17 4 12)(-3 -15 7))
                      :cycle nil
                      :relative t
                      :seed 729358
                      ))))

     

    > Error: OMN Parse Error: fail
    > While executing: omn-to-ast, in process Listener-2(13).
    > Type cmd-. to abort, cmd-\ for a list of available restarts.
    > Type :? for other options.

    ... problem seems to be: "omn-articulation-processor"

     


  13. OVERWRITE FUNCTION: first time i'm working with this function (i coded it a year ago)... to overwrite the output/score => INSERTS....

    - and it's very useful, perhaps JANUSZ could code an official OPMO-version of this which works perfect?

     

    greetings

    andré

    ;;; OVERWRITE!! ----------------------------------------------
    
    (defun memberp (n liste)
      (not (equal 'nil (member n liste))))
    
    (defun get-resolution2 (be)
      (cond ((memberp (cadr be) '(3 6 12 24 48))
             1/24)
            ((memberp (cadr be) '(1 2 4 8 16 32))
             1/16)
            ((memberp (cadr be) '(5 10 20 40))
             1/20)
            ((memberp (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))))))
    

     

     

     

    TWO EXAMPLES:

     

    
    ;;; in a 3/4
    
    (setf seq1 '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5)))
    (overwrite seq1
               :insert '((3q c5 b4 bb4 a4) 
                         (3q c4 b3 bb3 a3))
               
               :bar/beat '((2 (2 12)) 
                           (3 (7 12))))
    
    
    ;;; with changing time-signatures
    
    (setf seq2 '((e c6 a5 h b5 q tie) (q b5 b5 a5 tie) (q a5 q a5) (h. g5)))
    (overwrite seq2
               :insert '((3q c5 b4 bb4 a4) 
                         (3q c4 b3 bb3 a3))
               
               :bar/beat '((1 (2 12)) 
                           (3 (1 12))))

     

     

     

     


  14. short information about this from CT:

     

    "Currently, only the VST plugin does the pitch bend correctly, there was some reason why I did not fix the problem with the Max version, but I'll take it now.
    In the short term, you can also solve it by sending the pitchbend value immediately after each noteon.
    Pitchbend + - tritone. "

     

    https://www.contimbre.com/en/

     

    but how to how to send "the pitchbend value immediately after each noteon. Pitchbend + - tritone." ...i have no idea, i will wait for the UPDATE


  15. another EXAMPLE, with mapped pitches/cents

     

    ;;; -----------------------------------------------------------------------------------------
    ;;; MAPPED CENTS/PITCHES
    ;;; -----------------------------------------------------------------------------------------
    
    ;(setf pitches (rnd-repeat 100 '(d1 c2 g3 c4 d4 e4 f4 g4 gs4 bb4 c5 d5 e5 f5 g5 gs5 bb5)))
    (setf pitches (rnd-repeat 100 '(e4 f4 g4 gs4 bb4 c5 d5 e5 f5 g5 gs5 bb5)))
    (setf centlist (replace-map '(((bb4 bb5) -31ct)
                                  ((c4 c5 c2) 0ct)
                                  ((d1 d4 d5) 2ct)
                                  ((e4 e5) -14ct)
                                  ((f4 f5) 50ct)
                                  ((g3 g4 g5) 5ct)
                                  ((gs4 gs5) 41ct))
                                
                                pitches
     							:otherwise '0ct))
    
    
    (setf omn-seq (make-omn 
                   :length (quantize (gen-white-noise 50) '(2 3 5) :scale 0.8 :tolerance 0.02)
                   :pitch (filter-repeat 1 pitches)
                   :span :pitch
                   :velocity (vector-to-velocity 0.1 0.99 (gen-white-noise 50))
                   :articulation centlist))
    
    ;;; generating SCORE/MIDI
    
    (def-score microtonal
               (:title "microtonal"
                       :key-signature 'atonal   
                       :time-signature '(4 4) 
                       :tempo 160)
      
      (instr
       :omn omn-seq
       :channel 1
       :tuning (get-tuning-from-omn* omn-seq centlist)
       :sound 'gm
       :program 'acoustic-grand-piano))

     


  16. EXAMPLE, very easy to use...

     

    ;;; EXAMPLE HOW TO USE <get-tuning-from-omn*>
    
    
    (setf centlist (add-cents-tuning-to-text-atrributes :type :float))
    
      
    ;;; generating a omn-seq with mictronoes (by using articulation-SLOT
     
    (setf omn-seq (make-omn 
                   :length (quantize (gen-white-noise 50) '(2 3 5) :scale 1.4 :tolerance 0.02)
                   :pitch (filter-repeat 1 (vector-to-pitch '(c2 b6) (gen-white-noise 50)))
                   :span :pitch
                   :velocity (vector-to-velocity 0.1 0.99 (gen-white-noise 50))
                   :articulation (rnd-repeat 50 '(0ct 7ct -5ct 16ct -31ct -14ct 50ct -50ct))))
    
    ;;; generating SCORE/MIDI
    
    (def-score microtonal
               (:title "microtonal"
                       :key-signature 'atonal   
                       :time-signature '(4 4) 
                       :tempo 120)
      
      (instr
       :omn omn-seq
       :channel 1
       :tuning (get-tuning-from-omn* omn-seq centlist)
       :sound 'gm
       :program 'acoustic-grand-piano))

     

     


  17. with these functions you could write your CENTS for tuning directly into OMN-attributes, and extract it afterwards

     

    1. generate by add-cents-tuning-to-text-atrributes the cent values into text-attributes (only one time), you could decide if it will be shown in the score "as CENTS or as FLOAT"

    2. now you could write your CENTS for tuning into OMN-attributes like 50ct, -34ct ...also in combination with other text-attributes legno+50ct, pizz+-65ct, -45ct+batt

    3. you could EXTRACT afterwards your LIST for TUNING directly from OMN by   get-tuning-from-omn*.if an EVENT has no cent-attribute it will be unchangend (= 0 cents)

     

     

    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; this function adds CENTS or FLOATS to text-attributes, in this way you can notate 
    ;;; - have a look how it's written in the score -> all combinations of attributes possible
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; -------------------------------------------------------------------------------------------------------------------
    
    
    (defun add-cents-tuning-to-text-atrributes (&key (centlist nil) (type nil))
      (loop for i in (loop for x in (if (null centlist)
                                      (append (loop for i from 0 upto 99 collect i) (loop for i from 1 upto 99 collect (neg! i)))
                                      centlist)
                       collect (compress (list x 'ct)))
        append (add-text-attributes (list i (write-to-string (if (equal type :float) 
                                                               (float (/ (append (compress (if (equal (car (explode i)) '-)
                                                                                             (if (= (length (explode i)) 5)
                                                                                               (filter-first 3 (explode i))
                                                                                               (filter-first 2 (explode i)))
                                                                                             (if (= (length (explode i)) 4)
                                                                                               (filter-first 2 (explode i))
                                                                                               (filter-first 1 (explode i)))
                                                                                             ))) 100))
                                                               i))))))
    
    
    
    
    ;;; EXAMPLES
    
    (add-cents-tuning-to-text-atrributes :type :float)
    ;; have a look to notation: cmd3
    (-q -q  e c4 fff q c4 mf 50ct e c4 mf -40ct e c5 ff)
    
    
    (add-cents-tuning-to-text-atrributes :type :cents) ;; cents are written
    ;; have a look to notation: cmd3
    (-q -q  e c4 fff q c4 mf 50ct e c4 mf -40ct e c5 ff)
    
    
    
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; this function get out all notated microtones for TUNING ;;; if there is nothing written it will be 0 cents (0)
    ;;; you can combine all kinds of attributes
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; -------------------------------------------------------------------------------------------------------------------
    
    (defun memberp (n liste)
      (not (equal 'nil (member n liste))))
    
    (defun find-duplicates (lst)
      (cond ((null lst) '())
            ((member (car lst) (cdr lst)) (cons (car lst) (find-duplicates (cdr lst))))
            (t (find-duplicates (cdr lst)))))
    
    
    (defun get-tuning-from-omn* (omnlist centlist)
      (loop for i in (single-events (length-rest-remove omnlist))
        with n = 0
        when (not (null (find-duplicates (append (disjoin-attributes (car (last i))) centlist))))
        do (setf n  (float (/ (append (compress 
                                       (remove-if-not #'numberp (explode (car 
                                                                          (find-duplicates 
                                                                           (append (disjoin-attributes (car (last i)))
                                                                                   centlist))))))) 
                              100)))
    
        and collect (if (equal (car (explode (car (find-duplicates  (append (disjoin-attributes (car (last i))) 
                                                                            centlist)))))
                               '-)
                      (* -1 n)
                      n)
    
        else collect 0))
    
    
    
    
    
    ;;; EXAMPLES
    
    (setf centlist (add-cents-tuning-to-text-atrributes :type :float))
    
    ;;; evaluate this and you will get the tuning-list with all combinations of attributes
    (get-tuning-from-omn* '(-q -q  e c4 fff q c4 mf legno+50ct+num1 e c4 mf -50ct+legno+batt e c5 ff pizz+-34ct) centlist)
    => (0 0.5 0.5 -0.34)
    
    (get-tuning-from-omn* '(-q -q  e c4 fff -34ct+pizz q c4 mf legno+50ct e c4 mf -50ct+legno+batt e c5 ff pizz+-34ct) centlist)
    => (-0.34 0.5 -0.5 -0.34)
    
    (get-tuning-from-omn* '(-q -q  e c4 fff -34ct+pizz+num11 q c4 mf legno+50ct e c4 mf -50ct+legno+batt e c5 ff pizz+-34ct) centlist)
    => (-0.34 0.5 -0.5 -0.34)
    
    
    
    ;;; cmd3 for LAYOUT/SCORE
    (-q -q  e c4 fff -34ct+pizz+num11 q c4 mf legno+50ct e c4 mf -50ct+legno+batt e c5 ff pizz+-34ct)
    (-q -q  e c4 fff q c4 mf legno+50ct+num1 e c4 mf -50ct+legno+batt+num2 e c5 ff pizz+legno+-34ct)

     


  18. here is a solution - on attributes-level. next step will be to do/code it with "JOINED-attributes"... 

    thanxs for tests and hints! 🙂

     

    
    
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; this function adds CENTS or FLOATS to text-attributes, in this way you can notate 
    ;;; - have a look how ii's written in the score
    ;;; 
    
    (defun add-cents-tuning-to-text-atrributes (&key (centlist nil) (type nil))
      (loop for i in (loop for x in (if (null centlist)
                                      (append (loop for i from 1 upto 99 collect i) (loop for i from 1 upto 99 collect (neg! i)))
                                      centlist)
                       collect (compress (list x 'ct)))
        append (add-text-attributes (list i (write-to-string (if (equal type :float) 
                                                               (float (/ (append (compress (if (equal (car (explode i)) '-)
                                                                                             (if (= (length (explode i)) 5)
                                                                                               (filter-first 3 (explode i))
                                                                                               (filter-first 2 (explode i)))
                                                                                             (if (= (length (explode i)) 4)
                                                                                               (filter-first 2 (explode i))
                                                                                               (filter-first 1 (explode i)))
                                                                                             ))) 100))
                                                               i))))))
    
    
    ;;; EXAMPLES
    
    (add-cents-tuning-to-text-atrributes :type :float)
    ;; have a look to notation: cmd3
    (-q -q  e c4 fff q c4 mf 50ct e c4 mf -40ct e c5 ff)
    
    
    (add-cents-tuning-to-text-atrributes :type :cents) ;; cents are written
    ;; have a look to notation: cmd3
    (-q -q  e c4 fff q c4 mf 50ct e c4 mf -40ct e c5 ff)
    
    
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; -------------------------------------------------------------------------------------------------------------------
    ;;; this function get out all notated microtones for TUNING ;;; if there is nothing written it will be 0 cents (0)
    
    (defun memberp (n liste)
      (not (equal 'nil (member n liste))))
    
    (defun get-tuning-from-events (omnlist centlist)
      (loop for i in (single-events (length-rest-remove omnlist))
        when (memberp (car (last i)) centlist)
        do (setf n  (float (/ (append (compress (remove-if-not #'numberp (explode (car (last i)))))) 100)))
        and collect (if (equal (car (explode (car (last i)))) '-)
                      (* -1 n)
                      n)
        else collect 0))
    
    
    (setf centlist (add-cents-tuning-to-text-atrributes :type :float))
    
    ;;; evaluate this and you will get the tuning-list
    (get-tuning-from-events '(-q -q  e c4 fff q c4 mf 50ct e c4 mf -40ct e c5 ff) centlist)
    => (0 0.5 -0.4 0)  
    
    
    

     


  19. this is the simple solution...

    (defun add-numbers-to-text-attributes (a b)
      (loop for i from a to b
        append (add-text-attributes (list (compress (list 'nr i)) (write-to-string i)))))
    
    (add-numbers-to-text-attributes 12 23)
    => (nr12 nr13 nr14 nr15 nr16 nr17 nr18 nr19 nr20 nr21 nr22 nr23)

     

×