pattern-match with overwrite -> question

[AM]

hi all

 

i'm trying to code a PM-function with an OVERWRITE, so that the global-lengths stays correct... i'm working this evening with some ideas for that and this is only a first sketch of a basic idea, don't know if it will work later...

 

i have one little ordinary problem: to find/insert/overwrite i have to split the original sequence into small parts... that's the RESOLUTION, so i have a list with OMN-events in the span of the resolution. and a lot of TIEs -> at the end i would like to remove the tied-lengths by ordinary lengths? how? filter-tie works not with all insert-examples.... what can i do...?

 

thanx

andré

 

;;; --------------------------------------------------------------------------------------------
;;; OVERWRITE -> überschreibt eine sequenz bei PM -> resolution einstellbar
;;; --------------------------------------------------------------------------------------------

;;; ausgangs-sequenz
(setf seq '(q c4 d4 e. e4 s f4 h g4))

;;; inserts => test different INSERTS
(setf insert '(t gs5 g5 fs5 f5 e5))
;(setf insert '(q gs5 -e e gs5))
;(setf insert '(1/24 gs5 1/24 1/24))

;;; pattern => if such a pattern matched => now INSERT starting at PITCH f4
(setf pattern '(? f4))

;;; resolution of SCANNING/INSERTING
(setf resolution 1/16)

;;; --------------------------------------------------------------------------------------------
(setf omn-old seq)
(setf omn-new (loop repeat (length (omn-to-time-signature seq (list (numerator resolution) (denominator resolution))))
                for cnt = 0 then (incf cnt)
                with new-seq = (omn-to-time-signature seq (list (numerator resolution) (denominator resolution)))
                with insert-rounded = (append insert 
                                              (rest (length-rational-quantize
                                                     (list (apply '+ (omn :length insert)))
                                                     :round resolution)))
                
                when (pattern-matchp (nth cnt new-seq) pattern) collect insert-rounded
                and do (incf cnt (/ (apply '+ (abs! (omn :length insert-rounded))) resolution))
                collect (nth cnt new-seq)))

(setf omn-new (flatten omn-new))

;;; --------------------------------------------------------------------------------------------
(def-score test
           (:title "test"
                   :key-signature 'atonal
                   :time-signature '(4 4)
                   :tempo 90
                   :layout (bracket-group 
                            (treble-layout 'new)
                            (treble-layout 'old)))
  (new 
   :omn omn-new
   :channel 1
   :port 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (old 
   :omn omn-old
   :channel 1
   :port 1
   :sound 'gm
   :program 'acoustic-grand-piano))

 

added 4 minutes later

some other ideas to the main problems or some great solutions are very welcome :-)

[Stephane Boussuge]

Hi,

 

i don't know if this could help you but just in case, here's how i use pattern-map inside some of my functions:

 

;;; =============================================
;;; ARTICULATION-MAP
;;; AJOUTE DES ARTICULATIONS SUR DES LISTES OMN
;;; BASÉES SUR DU PATTERN MATCHING.
;;; =============================================

(defun articulation-map (map omn &key (otherwise '-))
  (do-verbose
      ("articulation-map")
  (let* ((plist (disassemble-omn omn)))
         (setf (getf plist :articulation)
               (pattern-map map (getf plist :length) :otherwise otherwise :swallow t))
    (apply 'make-omn plist))))

#| USAGE
(setf mat '((q c4 p d4 e e4 f4 s g4 f a4 g4 f4 q e4)(e d4 mp c4 s d4 e4 f4 e4 q d4 e c4 b3)(h a3 f -h)))

(setf prules '(
               ((s s s) (leg leg leg))
               ((s s)(leg leg))
               ((s e)(- -))
               ((s q)(- stacc))
               ((q) (stacc))
               ((e) (-))
               ))

(setf out (articulation-map prules mat))
|#

Cheers.

 

Stéphane.

[AM]

thanx...!!! the concrete question was... i could eliminate the TIEs in such a sequence... (and add the tied 1/16-lengths) -> simplify the notation

 

'(s c4 tie s c4 tie s c4 tie s c4 s d4 tie s d4 tie s d4 tie s d4 s e4 tie s e4 tie s e4 t gs5 g5 fs5 f5 e5 -1/32 s g4 tie s g4 tie s g4 tie s g4 tie s g4 tie s g4)

 

[Stephane Boussuge]

(setf seq '(s c4 tie s c4 tie s c4 tie s c4 s d4 tie s d4 tie s d4 tie s d4 s e4 tie s e4 tie s e4 t gs5 g5 fs5 f5 e5 -1/32 s g4 tie s g4 tie s g4 tie s g4 tie s g4 tie s g4))

(filter-tie seq)

S.

[AM]

yes, but wrong with this...

 

'(s c4 tie s c4 tie s c4 tie s c4 s d4 tie s d4 tie s d4 tie s d4 s e4 tie s e4 tie s e4 1/24 gs5 1/24 1/24 s g4 tie s g4 tie s g4 tie s g4 tie s g4 tie s g4 tie s g4)

because of the 1/24... why?

[opmo]

(omn-merge-ties
'(s c4 tie s c4 tie s c4 tie s c4 s d4 tie s d4 tie s d4 tie
   s d4 s e4 tie s e4 tie s e4 t gs5 g5 fs5 f5 e5 -1/32
   s g4 tie s g4 tie s g4 tie s g4 tie s g4 tie s g4))
=> (q c4 d4 e. e4 t gs5 g5 fs5 f5 e5 - q. g4)

(omn-merge-ties
'(s c4 tie s c4 tie s c4 tie s c4 s d4 tie s d4 tie s d4 tie
    s d4 s e4 tie s e4 tie s e4 1/24 gs5 1/24 1/24 s g4 tie
    s g4 tie s g4 tie s g4 tie s g4 tie s g4 tie s g4))
=> (q c4 d4 e. e4 3e gs5 gs5 gs5 q.. g4)

I will make a doc for the function soon.

[AM]