Jump to content
Sign in to follow this  
Stephane Boussuge

add-interval-if-length

Recommended Posts

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;       ADD-INTERVAL-IF-LENGTH                    ;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; USAGE
#|
(setf seq '((e c4 p stacc d4 stacc e4 stacc f4 stacc q g4 g3)
            (q c4 mf e c6 b5 a5 g5 f5 d5)
            (s e4 f4 e4 d4 q g4 b4 d5)
            (q g5 ff marc g4 marc h c5 )))

; with default parameters
(add-interval-if-length '(1/4 c4 d4 e4 1/8 e4 f4))
(add-interval-if-length seq)
; with specified condition
(add-interval-if-length seq :condition '<)
(add-interval-if-length seq :condition '=)
; with specifird conditions en length value specification
(add-interval-if-length seq :condition '= :length-val '1/4)
|#



;;; CODE
;;; ==============================================
;;; UTILITY FUNCTIONS
(defun add-interval-if-length-greater* (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      for i in (gen-trim (length s-events) interval-list)
      when (> (omn-encode (first e)) length-val)
      append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e)
      else append e)))

(defun add-interval-if-length-greater (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (if (listp (car omn))
    (mapcar (lambda(x) (add-interval-if-length-greater* x :length-val (omn-encode length-val) :interval-list interval-list)) omn)
    (add-interval-if-length-greater* omn :length-val (omn-encode length-val) :interval-list interval-list)))


;(add-interval-if-length-greater '((q c4 d4 e4 f4 e g4 a4)(e f4 e4 q d4 c4 a4 g4 f4)) :interval-list '(10 11))

;(add-interval-if-length-greater* '(q c4 d4 e4 f4 e g4 a4) :interval-list '(10 11))


(defun add-interval-if-length-lesser* (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      for i in (gen-trim (length s-events) interval-list)
      when (< (omn-encode (first e)) length-val)
      append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e)
      else append e)))

(defun add-interval-if-length-lesser (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (if (listp (car omn))
    (mapcar (lambda(x) (add-interval-if-length-lesser* x :length-val (omn-encode length-val) :interval-list interval-list)) omn)
    (add-interval-if-length-lesser* omn :length-val (omn-encode length-val) :interval-list interval-list)))


;(add-interval-if-length-lesser '((q c4 d4 e4 f4 e g4 a4)(e f4 e4 q d4 c4 a4 g4 f4)) :length-val '1/2 :interval-list '(10 11))

;(add-interval-if-length-lesser '(q c4 d4 e4 f4 e g4 a4) :length-val '1/4 :interval-list '(10 11))


(defun add-interval-if-length-equal* (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      for i in (gen-trim (length s-events) interval-list)
      when (equal (omn-encode (first e)) length-val)
      append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e)
      else append e)))

(defun add-interval-if-length-equal (omn &key (length-val '1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (if (listp (car omn))
    (mapcar (lambda(x) (add-interval-if-length-equal* x :length-val (omn-encode length-val) :interval-list interval-list)) omn)
    (add-interval-if-length-equal* omn :length-val (omn-encode length-val) :interval-list interval-list)))


;(add-interval-if-length-equal '((q c4 d4 e4 f4 e g4 a4)(e f4 e4 q d4 c4 a4 g4 f4)) :length-val '1/4 :interval-list '(10 11))

;(add-interval-if-length-equal '(q c4 d4 e4 f4 e g4 a4) :length-val '1/4 :interval-list '(10 11))

;(add-interval-if-length-equal '(q c4 d4 e4 f4 e g4 a4) :length-val 'q :interval-list '(10 11))



;;; MAIN FUNCTION
;;; =============================
(defun add-interval-if-length (omn &key (condition '>) (length-val '1/8)(interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (do-verbose
      ("add-interval-if-length")
    (if (equal condition '>)
      (add-interval-if-length-greater omn :length-val length-val :interval-list interval-list)
      (if (equal condition '<)
        (add-interval-if-length-lesser omn :length-val length-val :interval-list interval-list)
        (if (equal condition '=)
          (add-interval-if-length-equal omn :length-val length-val :interval-list interval-list)
          )))))



         
        
      

SB.

Share this post


Link to post
Share on other sites

Nice idea! I reduced your code a bit by using case instead of nested if statements, and in particular higher-order programming. This should do this same.

 

Moreover, you can now do things you could not do before like comparing with >=.

 

(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 h f4)) :interval-list '(3 4) :test #'>= :length-val 'q)

=> ((q c4eb4 mf q d4fs4 mf q e4g4 mf q f4a4 mf e g4 mf e a4 mf) (e f4 mf e e4 mf q d4f4 mf q c4e4 mf q a4c5 mf q g4b4 mf h f4gs4 mf))

 

Best,

Torsten

 

;;; ==============================================
;;; UTILITY FUNCTIONS
;;;
(defun add-interval-if-length-aux (omn &key (test #'>) (length-val 1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (let ((s-events (single-events omn)))
    (loop 
      for e in s-events
      for i in (gen-trim (length s-events) interval-list)
      when (funcall test (omn-encode (first e)) length-val)
      append (omn-replace :pitch (chord-interval-add (list i) (list (second e))) e)
      else append e)))

;(add-interval-if-length-aux '(q c4 d4 e4 f4 e g4 a4) :interval-list '(10 11))

;;; =============================
;;; MAIN FUNCTION
(defun add-interval-if-length (omn &key (test #'>) (length-val 1/8) (interval-list '(4 3 4 7 4 3 5 4 7 3)))
  (do-verbose ("add-interval-if-length")
    (let ((test-fn (case test
                     (> #'>)
                     (< #'<)
                     (= #'=)
                     (otherwise test))))
      (if (listp (car omn))
        (mapcar #'(lambda (x) 
                    (add-interval-if-length-aux x :test test-fn :length-val (omn-encode length-val) :interval-list interval-list)) 
                omn)
        (add-interval-if-length-aux omn :test test-fn :length-val (omn-encode length-val) :interval-list interval-list)))))
  

;(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 f4)) :interval-list '(10 11))
;(add-interval-if-length '((q c4 d4 e4 f4 e g4 a4) (e f4 e4 q d4 c4 a4 g4 h f4)) :interval-list '(3 4) :test #'>= :length-val 'q)

 

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  

×
×
  • Create New...