fixed write tuning-cents into omn / extract them

[AM]

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)

 

Edited October 20, 2018 by AM
a small change - now you can write also 0ct for no detuning

[AM]

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

 

 

[AM]

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

 

Edited October 20, 2018 by AM
BUG in replace-map => should be :otherwise '0ct

[opmo]

The future pitch (v1.4) will look like: c4 c4[50] fs4[50] d6[-30] etc... chord c4fs5[50]

Every cents value which falls into microtonal notation (50, 30 -50 -75 ...) will be part of the notation all others will be written above the note: -43c

 

[AM]

great! will be the best solution!

[Yuichi Yamamoto]

Awesome! Thank you for sharing!

[opmo]

On 10/20/2018 at 12:02 PM, AM said:

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

 You should't use :span :pitch with tupets otherwise the time signature will be not much of a use.

 

[HenryT]

With this score I'm not getting the score quite right; negative cents values as e flat (changed to d sharp), a and b flat (changed to a sharp) do not come out right; on a sharp, on g sharp and d sharp the eighth-tone arrow should point downwards. The tuning is named "Prodigy", and cents values are copied and rounded from a SCALA file.

 

(setf pitches (filter-repeat 1 (rnd-repeat 100 '(c4 cs4 d4 eb4 e4 f4 fs4 g4 gs4 a4 bb4 b4))))
(setf puolivalmiit-pitches (rnd-octaves 'harp pitches))
(setf pitches2 (filter-repeat 1 (rnd-repeat 100 '(c4 cs4 d4 eb4 e4 f4 fs4 g4 gs4 a4 bb4 b4))))
(setf puolivalmiit-pitches2 (rnd-octaves 'harp pitches2))

(setf centlist (replace-map
      '(#|1|# ((cs1 cs2 cs3 cs4 cs5 cs6 cs7) 17)
        #|2|# ((d1 d2 d3 d4 d5 d6 d7) 33)
        #|3|# ((eb1 eb2 eb3 eb4 eb5 eb6 eb7) -33)
        #|4|# ((e1 e2 e3 e4 e5 e6 e7) 17)
        #|5|# ((fs1 fs2 fs3 fs4 fs5 fs6 fs7) 17)
        #|6|# ((gs1 gs2 gs3 gs4 gs5 gs6 gs7) -17)
        #|7|# ((a0 a1 a2 a3 a4 a5 a6 a7) 33)
        #|8|# ((bb0 bb1 bb2 bb3 bb4 bb5 bb6 bb7) -33)
        #|9|# ((b0 b1 b2 b3 b4 b5 b6 b7) 17)
        )             
                            puolivalmiit-pitches
                             :otherwise '0))

(setf centlist2 (replace-map 
      '(#|1|# ((cs1 cs2 cs3 cs4 cs5 cs6 cs7) 17)
        #|2|# ((d1 d2 d3 d4 d5 d6 d7) 33)
        #|3|# ((eb1 eb2 eb3 eb4 eb5 eb6 eb7) -33)
        #|4|# ((e1 e2 e3 e4 e5 e6 e7) 17)
        #|5|# ((fs1 fs2 fs3 fs4 fs5 fs6 fs7) 17)
        #|6|# ((gs1 gs2 gs3 gs4 gs5 gs6 gs7) -17)
        #|7|# ((a0 a1 a2 a3 a4 a5 a6 a7) 33)
        #|8|# ((bb0 bb1 bb2 bb3 bb4 bb5 bb6 bb7) -33)
        #|9|# ((b0 b1 b2 b3 b4 b5 b6 b7) 17)
        )           
                            puolivalmiit-pitches2
                             :otherwise '0))

(setf tuning (cent-to-tuning centlist))
(setf tuning2 (cent-to-tuning centlist2))
(setf quant-tuning (micro-quantize tuning :quantize 1/8))
(setf quant-tuning2 (micro-quantize tuning2 :quantize 1/8))
(setf rem (micro-quantize tuning :quantize 1/8 :remain t))
(setf rem2 (micro-quantize tuning2 :quantize 1/8 :remain t))
(setf cents (cent-to-attribute rem))
(setf cents2 (cent-to-attribute rem2))
(setf valmiit-pitches (pitch-transpose-n quant-tuning puolivalmiit-pitches))
(setf valmiit-pitches2 (pitch-transpose-n quant-tuning2 puolivalmiit-pitches2))
(setf lengths (quantize (gen-white-noise 50) '(2 3 4) :scale 0.8 :tolerance 0.02))
;(setf lengths2 (quantize (gen-white-noise 50) '(2 3 5) :scale 0.8 :tolerance 0.02))

(setf omn-seq (make-omn 
               :length lengths
               :pitch valmiit-pitches
;               :span :pitch
               :velocity (vector-to-velocity 0.3 0.77 (gen-white-noise 50))
               :articulation cents))

(setf omn-seq2 (make-omn 
               :length lengths
               :pitch valmiit-pitches2
 ;              :span :pitch
               :velocity (vector-to-velocity 0.3 0.77 (gen-white-noise 50))
               :articulation cents2))

(setf harp-rh-omn (ambitus-filter '(c4 c9) omn-seq))
(setf harp-lh-omn (ambitus-filter '(c1 b3) omn-seq))
(setf harp-rh-omn2 (ambitus-filter '(c4 c9) omn-seq2))
(setf harp-lh-omn2 (ambitus-filter '(c1 b3) omn-seq2))

;;; generating SCORE/MIDI
(def-score Prodigy
           (:title "Prodigy"
            :key-signature 'atonal   
            :time-signature '(4 4) 
            :tempo 60
            :layout (list 
                     (harp-single-layout 'harp1 :name "Harp 1" :abbr "Hp1")
                     (harp-single-layout 'harp2 :name "Harp 2" :abbr "Hp1")
                     (harp-single-layout 'harp3 :name "Harp 3" :abbr "Hp1")
                     (harp-single-layout 'harp4 :name "Harp 4" :abbr "Hp1")))
  
  (harp1
   :omn harp-rh-omn
;   :port 12
   :channel 1
   :sound 'gm
   :program 'Orchestral-Harp)
  
  (harp2
   :omn harp-lh-omn
;   :port 12
   :channel 2
   :sound 'gm
   :program 'Orchestral-Harp)
  (harp3
   :omn harp-rh-omn2
;   :port 12
   :channel 3
   :sound 'gm
   :program 'Orchestral-Harp)
  
  (harp4
   :omn harp-lh-omn2
;   :port 12
   :channel 4
   :sound 'gm
   :program 'Orchestral-Harp))

 

[opmo]

this will improve the time signature:
 

(setf harp-rh-omn (quantize (ambitus-filter '(c4 c9) omn-seq) '(1 2 3 4 5 8)))
(setf harp-lh-omn (quantize (ambitus-filter '(c1 b3) omn-seq) '(1 2 3 4 5 8)))
(setf harp-rh-omn2 (quantize (ambitus-filter '(c4 c9) omn-seq2) '(1 2 3 4 5 8)))
(setf harp-lh-omn2 (quantize (ambitus-filter '(c1 b3) omn-seq2) '(1 2 3 4 5 8)))

 

As for the microtonal symbols, we convert them to simplest and clearest notation.

[HenryT]

Time signatures are better now.

 

But concerning the 1/8-sharps and cents remains:

c sharp should have remain -8 (arrow up makes +25 cents and -8 added to that makes +17)

d sharp should have arrow down and remain -8 (makes -33 cents)

g sharp should have arrow down (together with +8 makes -17 cents)

a sharp should have arrow down and remain -8, with makes -33 cents

b should have remain -8, which with arrow up makes 17 cents.

 

D, e, f sharp and a come out right.

Edited September 7 by HenryT

[opmo]

This should explain the accidentals:
 

Sharp:

'(s cs4 cs4+. cs4+ cs4+..)
'(s cs4 cs4-. cs4- cs4-..)

 

Flat:

'(s cb4 cb4+. cb4+ cb4+..)
'(s cb4 cb4-. cb4- cb4-..)

Natural:

'(s c4 c4+. c4+ c4+..)
'(s c4 c4-. c4- c4-..)

The cent can be minus or plus on flat and sharp.

[HenryT]

The problem seems to be that micro-quantize drops out minus signs. There are positive and negative values in tuning and tuning2, but after micro-quantize in quant-tuning and quant-tuning2 all values are positive. 

How could the negative values be left negative?

[opmo]

Please give me a short expression example of the problem, not a score, just expression using micro-quantize.

I think I know what you mean

Let me look.

[HenryT]

I want: s gs4-. 8c

I get: s gs4. 8c

 

(setf tuning (cent-to-tuning centlist) >> (0.17 -0.33 0.17 0.17 0.0 0.0 -0.33 0.33 -0.17 0.17 0.17 0.0 -0.33 0.0 0.17 0.17 0.0 0.17 0.33 -0.33 0.0 0.0 0.17 0.17 -0.33 0.17 -0.33 0.0 0.17 0.33 -0.33 0.33 -0.33 0.33 -0.33 0.33 -0.17 0.17 0.17 -0.33 0.0 0.17 0.0 0.17 0.33 -0.17 0.17 0.17 0.0 0.33 0.17 0.33 0.0 -0.17 0.33 -0.17 0.33 0.17 0.33 0.17 0.17 0.0 0.17 0.17 0.17 0.0 0.17 0.17 -0.17 0.0 0.0 0.17 -0.17 0.17 0.0 0.33 0.33 0.0 0.0 0.33 -0.33 0.17 0.17 0.0 -0.33 0.0 0.0 0.17 0.0 -0.33))

 

(setf quant-tuning (micro-quantize tuning :quantize 1/8)) >> (0.25 0.25 0.25 0.25 0 0 0.25 0.25 0.25 0.25 0.25 0 0.25 0 0.25 0.25 0 0.25 0.25 0.25 0 0 0.25 0.25 0.25 0.25 0.25 0 0.25 0.25 0.25 0.25 0.25 0.25 0.25 0.25 0.25 0.25 0.25 0.25 0 0.25 0 0.25 0.25 0.25 0.25 0.25 0 0.25 0.25 0.25 0 0.25 0.25 0.25 0.25 0.25 0.25 0.25 0.25 0 0.25 0.25 0.25 0 0.25 0.25 0.25 0 0 0.25 0.25 0.25 0 0.25 0.25 0 0 0.25 0.25 0.25 0.25 0 0.25 0 0 0.25 0 0.25)

 

(setf rem (micro-quantize tuning :quantize 1/8 :remain t)) >> (-8 -8 -8 -8 0 0 -8 8 8 -8 -8 0 -8 0 -8 -8 0 -8 8 -8 0 0 -8 -8 -8 -8 -8 0 -8 8 -8 8 -8 8 -8 8 8 -8 -8 -8 0 -8 0 -8 8 8 -8 -8 0 8 -8 8 0 8 8 8 8 -8 8 -8 -8 0 -8 -8 -8 0 -8 -8 8 0 0 -8 8 -8 0 8 8 0 0 8 -8 -8 -8 0 -8 0 0 -8 0 -8)

 

 

s gs4-. 8.pdf s gs4. 8.pdf

[opmo]

Now:

(micro-quantize '(0.17 -0.33 0.17 0.17 -0.17) :quantize 1/8)
=> (0.25 -0.25 0.25 0.25 -0.25)

(micro-quantize '(0.17 -0.33 0.17 0.17 -0.17) :remain t :quantize 1/8)
=> (-8 -8 -8 -8 8)

 

[HenryT]

Here:

 

(micro-quantize '(0.17 -0.33 0.17 -0.17) :quantize 1/8)

=>  (0.25 0.25 0.25 0.25)

 

 

???

[opmo]

Naturally, this is a fix on my site
My questions was, is the result correct, which I think it is.

[HenryT]

Yes, it seems right!

[opmo]

I will make update soon, possibly later today. 

[opmo]

Fixed in 3.0.29365

[HenryT]

Thanks for this! The microtonal symbols are now correct, but one problem still remains:

 

With articulation markings, minus-sign means that the same articulation continues. But if a tuning contains notes that don't need extra cents, you would then like to see articulation "0c". Otherwise, there is a confusion: does this note have the same extra cents as the previous notes or not.

 

Instead of this:

(q c4 mf cs4. -8c d4. 8c d4.. -8c e4. -8c f4 fs4. -8c g4 g4.. 8c a4. 8c a4.. -8c b4. -8c)

this: 

(q c4 mf 0c cs4. -8c d4. 8c d4.. -8c e4. -8c f4 0c fs4. -8c g4 0c g4.. 8c a4. 8c a4.. -8c b4. -8c)

 

Instead of this:

(- -8c 8c -8c -8c - -8c - 8c 8c -8c -8c)

this:

(0c -8c 8c -8c -8c 0c -8c 0c 8c 8c -8c -8c)

 

I haven't succeeded in substituting 0c for -. How do you do that? And of course, zero should look like zero...

And negative values should not turn into positive values...

 

 

 

Instead of this....pdf this.pdf

[opmo]

Yes indeed, this attribute here needs to be nonsticky.

 

As for this:

(substitute-map '- '0c '(0c -8c 8c -8c -8c 0c -8c 0c 8c 8c -8c -8c))
=> (- -8c 8c -8c -8c - -8c - 8c 8c -8c -8c)

 

[opmo]

The nonsticky cent attributes fixed in 3.0.29366

[HenryT]

Thanks a lot!