\include "articulate.ly"

Beat_performer =
#(define-scheme-function (strong weak) ((index? 25) (index?))
   "Return a performer intended for instantiation in @samp{Voice}-like
contexts.  @var{strong} indicates an additional MIDI velocity to be
applied on the first beat of the measure, @var{weak} applies on the
other beats, taking @code{beatStructure} into account where
applicable.

If @var{weak} is skipped by writing @code{\\default}, it is assumed
to be 60% of @var{strong}.  If both are skipped, @var{strong} is taken
as @code{25}.

Off-beat manual use of @code{\\accent} or @code{\\marcato} causes
autogeneration of the next on-beat accent to be skipped."
   (define (closest-beat ctx mp)
     ;; return the first on-beat measure position not before mp
     (let* ((mp (ly:moment-main mp))
	    (tf (ly:context-property ctx 'timeSignatureFraction '(4 . 4)))
	    (bmm (ly:context-property ctx 'baseMoment))
	    (bm (if (ly:moment? bmm)
		    (ly:moment-main bmm)
		    (/ (cdr tf))))
	    (bs (ly:context-property ctx 'beatStructure)))
       (let loop ((pos 0) (bs bs))
	 (cond ((>= pos mp) (ly:make-moment pos))
	       ((pair? bs)
		(loop (+ pos (* bm (car bs))) (cdr bs)))
	       (else
		(loop (+ pos bm) bs))))))
   (if (not weak)
       (set! weak (floor (* #e0.6 strong))))
   (lambda (ctx)
     (define fired #f)
     (define timeout #f)
     (define (emit strong?)
       (set! fired
	     (ly:make-stream-event
	      (ly:make-event-class 'articulation-event)
	      `(
		;; We differentiate the "visuals" of the generated
		;; events for debugging purposes: the performer is not
		;; intended to be used while typesetting, but a
		;; wrapper may add an "is-layout" property
		(articulation-type . ,(if strong? "marcato" "accent"))
		(midi-extra-velocity . ,(if strong? strong weak)))))
       (ly:broadcast (ly:context-event-source ctx) fired))
     
     (make-performer
      ((stop-translation-timestep c) (set! fired #f))
      ((process-music performer)
       ;; No syncope tracking across cadenze
       (and timeout (not (ly:context-property ctx 'timing))
	    (set! timeout #f)))
      (listeners
       ;; we have a listener for explicit articulation events in order
       ;; to let syncopated accents silence the next "regular" stress
       ((articulation-event performer event)
	(cond ((eq? fired event))	; ignore our own events
	      ((member (ly:event-property event 'articulation-type)
		       '("accent" "marcato"))
	       (let ((mp (ly:context-property ctx
					      'measurePosition ZERO-MOMENT))
		     (now (ly:context-current-moment ctx)))
		 (set! timeout (ly:moment-add (closest-beat ctx mp)
					      (ly:moment-sub now mp)))))))
       
       ;; Listener for note events.
       ((note-event performer event)
	(and (not fired)
	     (ly:context-property ctx 'timing)
	     (not (and timeout (moment<=? (ly:context-current-moment ctx)
					  timeout)))
	     (let ((mp (ly:context-property ctx 'measurePosition ZERO-MOMENT)))
	       (if (equal? mp (closest-beat ctx mp))
		   (emit (equal? mp ZERO-MOMENT))))))))))
				       
\score {
  \articulate
  \drums
  {
    sn1:32 | 1:32 | 1:32 | 1 |
    8 \repeat unfold 3 { <>-> 4:32 } <>-> 8:32 | 1:32 | 1:32 | 1 |
  }
  \midi {
    \tempo 4=80
    \context {
      \DrumVoice
      \consists \Beat_performer \default
    }
  }
  \layout {
    \context {
      \DrumVoice
      \consists #(lambda (c) `((is-layout . #t) ,@((Beat_performer *unspecified*) c)))
    }
  }
}
I am typing some drum parts for our accordion orchestra into MIDI, and
multi-measure drum rolls become completely incoherent (or rather
completely coherent) without this.  Try leaving off the performer...

-- 
David Kastrup

Reply via email to