]> git.donarmstrong.com Git - lilypond.git/blobdiff - input/regression/scheme-text-spanner.ly
Imported Upstream version 2.18.0
[lilypond.git] / input / regression / scheme-text-spanner.ly
index a83bec87aa74c642c8e21e115aefeb1307ee4667..14e095e9549fea00fa45554183e33dd510e0b49b 100644 (file)
@@ -1,4 +1,4 @@
-\version "2.16.0"
+\version "2.17.6"
 
 \header {
   texidoc = "Use @code{define-event-class}, scheme engraver methods,
@@ -6,27 +6,7 @@ and grob creation methods to create a fully functional text spanner
 in scheme."
 }
 
-#(define my-grob-descriptions '())
-
-#(define my-event-classes (ly:make-context-mod))
-
-defineEventClass =
-#(define-void-function (parser location class parent)
-   (symbol? symbol?)
-   (ly:add-context-mod
-    my-event-classes
-    `(apply
-      ,(lambda (context class parent)
-        (ly:context-set-property!
-         context
-         'EventClasses
-         (event-class-cons
-          class
-          parent
-          (ly:context-property context 'EventClasses '()))))
-      ,class ,parent)))
-
-\defineEventClass #'scheme-text-span-event #'span-event
+#(define-event-class 'scheme-text-span-event 'span-event)
 
 #(define (add-grob-definition grob-name grob-entry)
    (let* ((meta-entry   (assoc-get 'meta grob-entry))
@@ -49,9 +29,9 @@ defineEventClass =
      (set! meta-entry (assoc-set! meta-entry 'interfaces
                                   ifaces-entry))
      (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
-     (set! my-grob-descriptions
+     (set! all-grob-descriptions
            (cons (cons grob-name grob-entry)
-                 my-grob-descriptions))))
+                 all-grob-descriptions))))
 
 #(add-grob-definition
   'SchemeTextSpanner
@@ -126,66 +106,65 @@ start and stop.")
          grob
          (if (eq? axis X)
              ly:side-position-interface::x-aligned-side
-             ly:side-position-interface::y-aligned-side)
+             side-position-interface::y-aligned-side)
          (axis-offset-symbol axis)))))
 
 schemeTextSpannerEngraver =
 #(lambda (context)
    (let ((span '())
          (finished '())
-         (current-event '())
-         (event-drul '(() . ())))
+         (event-start '())
+         (event-stop '()))
      (make-engraver
       (listeners ((scheme-text-span-event engraver event)
-                 (if (= START (ly:event-property event 'span-direction))
-                     (set-car! event-drul event)
-                     (set-cdr! event-drul event))))
+                  (if (= START (ly:event-property event 'span-direction))
+                      (set! event-start event)
+                      (set! event-stop event))))
       (acknowledgers ((note-column-interface engraver grob source-engraver)
-                     (if (ly:spanner? span)
-                         (begin
-                           (ly:pointer-group-interface::add-grob span 'note-columns grob)
-                           (add-bound-item span grob)))
-                     (if (ly:spanner? finished)
-                         (begin
-                           (ly:pointer-group-interface::add-grob finished 'note-columns grob)
-                           (add-bound-item finished grob)))))
+                      (if (ly:spanner? span)
+                          (begin
+                            (ly:pointer-group-interface::add-grob span 'note-columns grob)
+                            (add-bound-item span grob)))
+                      (if (ly:spanner? finished)
+                          (begin
+                            (ly:pointer-group-interface::add-grob finished 'note-columns grob)
+                            (add-bound-item finished grob)))))
       ((process-music trans)
-       (if (ly:stream-event? (cdr event-drul))
-          (if (null? span)
-              (ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
-              (begin (set! finished span)
-                     (ly:engraver-announce-end-grob trans finished current-event)
-                     (set! span '())
-                     (set! current-event '())
-                     (set-cdr! event-drul '()))))
-       (if (ly:stream-event? (car event-drul))
-          (begin (set! current-event (car event-drul))
-                 (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner current-event))
-                 (set-axis! span Y)
-                 (set-car! event-drul '()))))
+       (if (ly:stream-event? event-stop)
+           (if (null? span)
+               (ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
+               (begin (set! finished span)
+                      (ly:engraver-announce-end-grob trans finished event-start)
+                      (set! span '())
+                      (set! event-stop '()))))
+       (if (ly:stream-event? event-start)
+           (begin (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner event-start))
+                  (set-axis! span Y)
+                  (set! event-start '()))))
       ((stop-translation-timestep trans)
        (if (and (ly:spanner? span)
-               (null? (ly:spanner-bound span LEFT)))
-          (set! (ly:spanner-bound span LEFT)
-                (ly:context-property context 'currentMusicalColumn)))
+                (null? (ly:spanner-bound span LEFT)))
+           (set! (ly:spanner-bound span LEFT)
+                 (ly:context-property context 'currentMusicalColumn)))
        (if (ly:spanner? finished)
-          (begin
-            (if (null? (ly:spanner-bound finished RIGHT))
-                (set! (ly:spanner-bound finished RIGHT)
-                      (ly:context-property context 'currentMusicalColumn)))
-            (set! finished '())
-            (set! event-drul '(() . ())))))
+           (begin
+             (if (null? (ly:spanner-bound finished RIGHT))
+                 (set! (ly:spanner-bound finished RIGHT)
+                       (ly:context-property context 'currentMusicalColumn)))
+             (set! finished '())
+             (set! event-start '())
+             (set! event-stop '()))))
       ((finalize trans)
        (if (ly:spanner? finished)
-          (begin
-            (if (null? (ly:spanner-bound finished RIGHT))
-                (set! (ly:spanner-bound finished RIGHT)
-                      (ly:context-property context 'currentMusicalColumn)))
-            (set! finished '())))
+           (begin
+             (if (null? (ly:spanner-bound finished RIGHT))
+                 (set! (ly:spanner-bound finished RIGHT)
+                       (ly:context-property context 'currentMusicalColumn)))
+             (set! finished '())))
        (if (ly:spanner? span)
-          (begin
-            (ly:warning "I think there's a dangling scheme text spanner :-(")
-            (ly:grob-suicide! span)
+           (begin
+             (ly:warning "I think there's a dangling scheme text spanner :-(")
+             (ly:grob-suicide! span)
             (set! span '())))))))
 
 schemeTextSpannerStart =
@@ -197,8 +176,7 @@ schemeTextSpannerEnd =
 \layout {
   \context {
     \Global
-    \grobdescriptions #my-grob-descriptions
-    #my-event-classes
+    \grobdescriptions #all-grob-descriptions
   }
   \context {
     \Voice
@@ -210,7 +188,7 @@ schemeTextSpannerEnd =
   a4 b\schemeTextSpannerStart c d |
   \repeat unfold 20 { a4 b c d | }
   a4 b c\schemeTextSpannerEnd d |
-  \override SchemeTextSpanner #'to-barline = ##t
+  \override SchemeTextSpanner.to-barline = ##t
   a4\schemeTextSpannerStart b d c |
   \repeat unfold 20 { a4 b c d | }
   a1\schemeTextSpannerEnd |