Jump to content

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.

Link to comment
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)

 

Link to comment
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.

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy