code gen-pitch-line (from vector)

[Stephane Boussuge]

;;; ------------------------------------------------------------------------------
;;; GEN-PITCH-LINE
;;; Pitch generation function based on noise vectors conversion with a large choice of 
;;; types of noises, compress ratio for the vector, filtering repetitions and ambitus. 

(defun gen-pitch-line (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat (type :white))
  (do-verbose
      ("gen-pitch-line")
    (rnd-seed seed)
    (labels ((white  (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat type)
               (if filter-repeat
                 (gen-trim
                  nb-pitch
                  (filter-repeat 
                   filter-repeat
                   (vector-to-pitch ambitus (vector-smooth compress (gen-white-noise nb-pitch :seed seed :type type)))))
                 (vector-to-pitch ambitus (vector-smooth compress (gen-white-noise nb-pitch :seed seed :type type)))))
             
             (pink  (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat)
               (if filter-repeat
                 (gen-trim
                  nb-pitch
                  (filter-repeat 
                   filter-repeat
                   (vector-to-pitch ambitus (vector-smooth compress (gen-pink-noise nb-pitch :seed seed)))))
                 (vector-to-pitch ambitus (vector-smooth compress (gen-pink-noise nb-pitch :seed seed)))))
             )
      (cond 
       ((equal type ':white)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :normal))
       
       ((equal type ':binary)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :binary))
       
       ((equal type ':cauchy)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :cauchy))
       
       ((equal type ':chi-square-2)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :chi-square-2))
       
       ((equal type ':double-exponential)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :double-exponential))
       
       ((equal type ':exponential)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :exponential))
       
       ((equal type ':extreme)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :extreme))
       
       ((equal type ':gaussian)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :gaussian))
       
       ((equal type ':logistic)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :logistic))
       
       ((equal type ':lognormal)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :lognormal))
       
       ((equal type ':triangular)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :triangular))
       
       ((equal type ':low-pass)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :low-pass))
       
       ((equal type ':high-pass)
        (white nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type :high-pass))
       
       ((equal type ':pink)
        (pink nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed)))))))


#| USAGE
(gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1)
(gen-pitch-line 24 :compress 0.42 :type :pink :filter-repeat 1)
(gen-pitch-line 24 :compress 0.42 :type :extreme :filter-repeat 1)
(gen-eval 
 8
 '(make-omn
   :pitch (gen-pitch-line 24 :compress 0.42 :type :white :filter-repeat 1)
   :length (euclidean-rhythm 16 1 16 's :type 2)
   )
 :seed 33)
|#
;;; ------------------------------------------------------------------------------   

SB.

[Rangarajan]

SB,

Thanks. Useful function, I am sure.

 

Thought I could re-write the function slightly differently, hope you don't mind:

(defun gen-pitch-line2 (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat (type :white))
  (let (pitches)
    (do-verbose
      ("gen-pitch-line2")
    (rnd-seed seed)
    (labels ((white-or-pink (nb-pitch seed type)
               (if (eq type ':pink)
                 (gen-pink-noise nb-pitch :seed seed)
                 (gen-white-noise nb-pitch :seed seed :type (if (eq type ':white) :normal type))))

             (process  (nb-pitch &key (compress 1) (ambitus '(c4 c6)) seed filter-repeat type)
               (setf pitches (vector-to-pitch ambitus (vector-smooth compress (white-or-pink nb-pitch seed type)))) 
               (when filter-repeat
                 (setf pitches (gen-trim nb-pitch (filter-repeat filter-repeat pitches))))
               pitches)
             )
      (process nb-pitch :compress compress :ambitus ambitus :filter-repeat filter-repeat :seed (seed) :type type)))))

 

I hope I haven't messed up the logic!

 

Regards,

Rangarajan

[Stephane Boussuge]

Thank you very much Rangarajan for your help.

As you can see i am more musician than programmer ;-)

Your version is more concise.

 

SB.

[Rangarajan]

I am the other way, so it helps to keep balance in the forum!

 

-Rangarajan