AM Posted August 10, 2016 Share Posted August 10, 2016 (edited) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; modify time-signatures like '(1 4 3) to (3 4 1), ;;; helps me after (split-tuplet-lengths) to clean up ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; with the :exclude and :threshold ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun modify-time-signature-repetitions (time-signature-seq &key (exclude '((0 0))) (threshold '10/4) (numerator-threshold 20)) (loop for i in time-signature-seq when (and (> (third i) 1) (< (/ (first i) (second i)) threshold) (< (* (first i) (third i)) numerator-threshold) (not (if (listp (first exclude)) (loop for x in exclude when (equal (butlast i) x) collect t) (equal (butlast i) exclude)))) collect (list (* (first i) (third i)) (second i) 1) else collect i)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq bars '((5 4 4) (1 4 2) (3 4 2) (1 8 5) (1 32 8))) (modify-time-signature-repetitions bars) (modify-time-signature-repetitions bars :exclude '(1 4)) (modify-time-signature-repetitions bars :exclude '((1 4) (1 8))) (modify-time-signature-repetitions bars :exclude '((1 32)) :threshold '4/4) (modify-time-signature-repetitions bars :numerator-threshold 7) ;; because i don't want 200/4 - bars :-) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Edited August 10, 2016 by AM extended version 2 Stephane Boussuge 1 Quote Link to comment Share on other sites More sharing options...
opmo Posted August 10, 2016 Share Posted August 10, 2016 I will add the MODIFY-TIME-SIGNATURE function to our system - thank you. I too will add other function as well: COMPRESS-TIME-SIGNATURE (setq bars '((1 4 4) (1 4 4) (1 4 4) (3 4 2) (1 8 5) (1 8 5))) (compress-time-signatures bars) => ((1 4 12) (3 4 2) (1 8 10)) (modify-time-signature bars) => ((4 4 1) (4 4 1) (4 4 1) (6 4 1) (5 8 1) (5 8 1)) (compress-time-signatures (modify-time-signature bars)) => ((4 4 3) (6 4 1) (5 8 2)) (modify-time-signature (compress-time-signatures bars)) => ((12 4 1) (6 4 1) (10 8 1)) Interesting Stephane Boussuge 1 Quote Link to comment Share on other sites More sharing options...
AM Posted August 10, 2016 Author Share Posted August 10, 2016 perfect...! a kind of... (compress-time-signatures bars) was my next step... so... thanx to you!! perhaps, both in ONE? Quote Link to comment Share on other sites More sharing options...
opmo Posted August 10, 2016 Share Posted August 10, 2016 Maybe I do that - both in one. Stephane Boussuge 1 Quote Link to comment Share on other sites More sharing options...
opmo Posted August 10, 2016 Share Posted August 10, 2016 Final function: (defun modify-time-signature (time-signature &key compress (exclude '((0 0))) (span '10/4) (numerator 20)) (do-verbose ("modify-time-signature") (let ((ts (if compress (compress-time-signatures time-signature) time-signature))) (loop for i in ts when (and (> (third i) 1) (< (/ (first i) (second i)) span) (< (* (first i) (third i)) numerator) (not (if (listp (first exclude)) (loop for x in exclude when (equal (butlast i) x) collect t) (equal (butlast i) exclude)))) collect (list (* (first i) (third i)) (second i) 1) else collect i)))) #| (setq bars '((5 4 4) (1 4 2) (1 4 4) (1 4 4) (1 4 4) (3 4 2) (1 8 19) (1 32 8) (1 8 5) (1 8 5))) (modify-time-signature bars) => ((5 4 4) (2 4 1) (4 4 1) (4 4 1) (4 4 1) (6 4 1) (19 8 1) (8 32 1) (5 8 1) (5 8 1)) (modify-time-signature bars :compress t) => ((5 4 4) (14 4 1) (6 4 1) (19 8 1) (8 32 1) (10 8 1)) (modify-time-signature bars :exclude '(1 4)) => ((5 4 4) (1 4 2) (1 4 4) (1 4 4) (1 4 4) (6 4 1) (19 8 1) (8 32 1) (5 8 1) (5 8 1)) (modify-time-signature bars :exclude '((1 4) (1 8)) :compress t) => ((5 4 4) (1 4 14) (6 4 1) (1 8 19) (8 32 1) (1 8 10)) (modify-time-signature bars :exclude '((1 32)) :span '4/4) => ((5 4 4) (2 4 1) (4 4 1) (4 4 1) (4 4 1) (6 4 1) (19 8 1) (1 32 8) (5 8 1) (5 8 1)) (modify-time-signature bars :numerator 7) => ((5 4 4) (2 4 1) (4 4 1) (4 4 1) (4 4 1) (6 4 1) (1 8 19) (1 32 8) (5 8 1) (5 8 1)) |# Stephane Boussuge and AM 2 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.