Jump to content

Featured Replies

Posted
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;       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.

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)

 

Create an account or sign in to comment


Copyright © 2014-2025 Opusmodus™ Ltd. All rights reserved.
Product features, specifications, system requirements and availability are subject to change without notice.
Opusmodus, the Opusmodus logo, and other Opusmodus trademarks are either registered trademarks or trademarks of Opusmodus Ltd.
All other trademarks contained herein are the property of their respective owners.

Powered by Invision Community

Important Information

Terms of Use Privacy Policy