Andre Meier's Lenght-Staccato

Sometime ago, I was searching for a function that would be the exact opposite function of length-legato.

 

Lenght-legato turns this:

 

 

onto this:

 

 

I wanted exactly the reverse:

Changing this:

to this:

 

In the ocasion, Andre Meier came with this code below:

 

Janusz, do you think a good idea to include a function like this in the library ?

Or there is also something similar that I dont know ?

I still need it in a easy way...

 

Best,

 

Julio

 

(defun length-staccato (n alist)
  (let ((newlengths)
        (new-omn (omn-merge-ties (flatten  alist)))
        (time-sign (get-time-signature alist)))
    (progn 
      (setf newlengths (loop for i in (omn :length new-omn)
                         when (> i 0)
                         append (if (= n i)
                                  (list i)
                                  (list n (* -1 (abs (- i n)))))
                         
                         else collect i))
      (if (omn-formp alist)
        (omn-to-time-signature (make-omn :length newlengths
                                         :pitch (omn :pitch new-omn)
                                         :velocity (omn :velocity new-omn)
                                         :articulation (omn :articulation new-omn))
                               time-sign)
        newlengths))))


(length-staccato 1/16 '(q -q q q))
(length-staccato 1/16 '(q e4 mp q tasto q -q q q))
(length-staccato 1/16 '((e. c4 eb4 fs4 a4 tie) (s a4 e. cs4 e4 g4 e bb4 tie) (e bb4 e. d4 f4 gs4 s b4)))