Stephane Boussuge Posted May 1, 2017 Share Posted May 1, 2017 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;; 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. AM 1 Quote Link to comment Share on other sites More sharing options...
torstenanders Posted May 1, 2017 Share Posted May 1, 2017 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) AM and Stephane Boussuge 2 Quote Link to comment Share on other sites More sharing options...
Stephane Boussuge Posted May 1, 2017 Author Share Posted May 1, 2017 Thank you very much Torsten ! all the best Stéphane Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.