lilypond-user
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: aleatoric box / frameEngraver


From: Karol Majewski
Subject: Re: aleatoric box / frameEngraver
Date: Mon, 15 Jul 2013 12:56:50 +0200

Sorry, Thomas... I forgot to mention that I want to place repeat signs in the 
middle of the bar! Mea culpa. That's why at first I tried to modify 
frameEngraver. It would be great to have something like:

\repeatStart c'4 d' e' \repeatStop
s4*3 \repeatExtenderStop

Here is function that I try to modify:

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\version "2.16.2"

#(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 #'frame-event #'span-event

\defineEventClass #'frame-extender-event #'span-event

#(define
  (add-grob-definition grob-name grob-entry)
  (let*
    ((meta-entry
        (assoc-get 'meta grob-entry))
      (class
        (assoc-get 'class meta-entry))
      (ifaces-entry
        (assoc-get 'interfaces meta-entry)))
    (set-object-property! grob-name 'translation-type? list?)
    (set-object-property! grob-name 'is-grob? #t)
    (set! ifaces-entry
      (append
        (case class
          ((Item)
            '(item-interface))
          ((Spanner)
            '(spanner-interface))
          ((Paper_column)
            '((item-interface paper-column-interface)))
          ((System)
            '((system-interface spanner-interface)))
          (else
            '(unknown-interface))) ifaces-entry))
    (set! ifaces-entry
      (uniq-list
        (sort ifaces-entry symbol<?)))
    (set! ifaces-entry
      (cons 'grob-interface ifaces-entry))
    (set! meta-entry
      (assoc-set! meta-entry 'name grob-name))
    (set! meta-entry
      (assoc-set! meta-entry 'interfaces ifaces-entry))
    (set! grob-entry
      (assoc-set! grob-entry 'meta meta-entry))
    (set! my-grob-descriptions
      (cons
        (cons grob-name grob-entry) my-grob-descriptions))))

#(define
  (define-grob-property symbol type? description)
  (if
    (not
      (equal?
        (object-property symbol 'backend-doc) #f))
    (ly:error
      (_ "symbol ~S redefined") symbol))
  (set-object-property! symbol 'backend-type? type?)
  (set-object-property! symbol 'backend-doc description) symbol)

#(map
  (lambda
    (x)
    (apply define-grob-property x))
  `((extend-line ,number? "offset to endpoint of frame extender line")
    (extra-padding ,pair? "extra room on left and right of frame")
    (extender-Y-offset ,number? "vertical displacement of extender line from 
center staff line")))

#(define frame-types
  '((FrameEvent .
      ((description . "Used to signal where frames start and stop.")
        (types .
          (general-music frame-event span-event event))))))

#(define frame-extender-types
  '((FrameExtenderEvent .
      ((description . "Used to signal where a frame extender line stops.")
        (types .
          (general-music frame-extender-event span-event event))))))

#(set! frame-types
  (map
    (lambda
      (x)
      (set-object-property!
        (car x) 'music-description
        (cdr
          (assq 'description
            (cdr x))))
      (let
        ((lst
            (cdr x)))
        (set! lst
          (assoc-set! lst 'name
            (car x)))
        (set! lst
          (assq-remove! lst 'description))
        (hashq-set! music-name-to-property-table
          (car x) lst)
        (cons
          (car x) lst))) frame-types))

#(set! frame-extender-types
  (map
    (lambda
      (x)
      (set-object-property!
        (car x) 'music-description
        (cdr
          (assq 'description
            (cdr x))))
      (let
        ((lst
            (cdr x)))
        (set! lst
          (assoc-set! lst 'name
            (car x)))
        (set! lst
          (assq-remove! lst 'description))
        (hashq-set! music-name-to-property-table
          (car x) lst)
        (cons
          (car x) lst))) frame-extender-types))

#(set! music-descriptions
  (append frame-types music-descriptions))

#(set! music-descriptions
  (append frame-extender-types music-descriptions))

#(set! music-descriptions
  (sort music-descriptions alist<?))

#(define
  (frame-stencil grob) "Draw a box around a group of notes for use in frame 
notation."
  (let*
    ((elts
        (ly:grob-object grob 'elements))
      (box-padding
        (ly:grob-property grob 'padding))
      (extra-padding
        (ly:grob-property grob 'extra-padding))
      (padding-L
        (car extra-padding))
      (padding-R
        (cdr extra-padding))
      (height
        (ly:axis-group-interface::height grob))
      (axis-group-width
        (ly:axis-group-interface::width grob))
      (axis-group-width
        (coord-translate axis-group-width
          (cons padding-L padding-R)))
      (stencil
        (ly:make-stencil '() axis-group-width height))
      (stencil
        (box-stencil stencil 0.3 box-padding))) stencil))

#(define
  (frame-extender-stencil grob) "Draw an extender line with arrow on a frame."
  (let*
    ((refp
        (ly:grob-system grob))
      (frame
        (ly:grob-object grob 'frame))
      (frame-ext
        (if
          (ly:grob? frame)
          (ly:grob-extent frame frame X)
          '(0 . 0)))
      (left-bound
        (ly:spanner-bound grob LEFT))
      (right-bound
        (ly:spanner-bound grob RIGHT))
      (left-bound-ext
        (ly:grob-extent left-bound left-bound X))
      (left-offset
        (if
          (grob::has-interface left-bound 'note-column-interface) 0.0
          (1+
            (cdr left-bound-ext))))
      (left-bound-coord
        (ly:grob-relative-coordinate
          (ly:spanner-bound grob LEFT) refp X))
      (right-bound-coord
        (ly:grob-relative-coordinate
          (ly:spanner-bound grob RIGHT) refp X))
      (arrow-head
        (grob-interpret-markup grob
          (markup #:arrow-head X RIGHT #t)))
      (arrow-head-stil-ext
        (ly:stencil-extent arrow-head X))
      (arrow-head-offset -0.2)
      (right-offset
        (+
          (interval-length arrow-head-stil-ext) arrow-head-offset 1.0))
      (extender
        (make-line-stencil 0.3
          (+ left-offset
            (cdr frame-ext)) 0
          (- right-bound-coord left-bound-coord right-offset) 0))
      (extender
        (ly:stencil-combine-at-edge extender X RIGHT
          (grob-interpret-markup grob
            (markup #:arrow-head X RIGHT #t)) -0.2))) extender))

#(ly:add-interface 'frame-interface "A box for frame notation." '())

#(ly:add-interface 'frame-extender-interface "An extender line (with arrow) for 
frame notation." '())

#(add-grob-definition 'Frame
  `((extender-length . 0)
    (extra-padding .
      (0 . 0))
    (padding . 0.8)
    (stencil . ,frame-stencil)
    (meta .
      ((class . Spanner)
        (interfaces .
          (frame-interface line-interface))))))

#(add-grob-definition 'FrameExtender
  `((width . ,ly:axis-group-interface::width)
    (stencil . ,frame-extender-stencil)
    (meta .
      ((class . Spanner)
        (interfaces .
          (frame-extender-interface line-interface))))))

#(define
  (add-bound-item spanner item)
  (if
    (null?
      (ly:spanner-bound spanner LEFT))
    (ly:spanner-set-bound! spanner LEFT item)
    (ly:spanner-set-bound! spanner RIGHT item)))

frameEngraver =
#(lambda
  (context)
  (let
    ((frame '())
      (extender '())
      (finished '())
      (extender-event '())
      (event-drul
        (cons '() '())))
    (make-engraver
      (listeners
        ((frame-event engraver event)
          (if
            (= START
              (ly:event-property event 'span-direction))
            (set-car! event-drul event)
            (set-cdr! event-drul event)))
        ((frame-extender-event engraver event)
          (if
            (= STOP
              (ly:event-property event 'span-direction))
            (set! extender-event event))))
      (acknowledgers
        ((note-column-interface engraver grob source-engraver)
          (if
            (ly:spanner? frame)
            (begin
              (ly:pointer-group-interface::add-grob frame 'elements grob)
              (add-bound-item frame grob)))
          (if
            (ly:spanner? extender)
            (begin
              (ly:pointer-group-interface::add-grob extender 'elements grob)
              (if
                (null?
                  (ly:spanner-bound extender LEFT))
                (ly:spanner-set-bound! extender LEFT grob)))))
        ((script-interface engraver grob source-engraver)
          (if
            (ly:spanner? frame)
            (ly:pointer-group-interface::add-grob frame 'elements grob)))
        ((dynamic-interface engraver grob source-engraver)
          (if
            (ly:spanner? frame)
            (ly:pointer-group-interface::add-grob frame 'elements grob)))
        ((inline-accidental-interface engraver grob source-engraver)
          (if
            (ly:spanner? frame)
            (ly:pointer-group-interface::add-grob frame 'elements grob))))
      ((process-music trans)
        (if
          (ly:stream-event?
            (car event-drul))
          (begin
            (set! frame
              (ly:engraver-make-grob trans 'Frame
                (car event-drul)))
            (set! extender
              (ly:engraver-make-grob trans 'FrameExtender
                (car event-drul)))
            (ly:grob-set-object! extender 'frame frame)
            (set-car! event-drul '())))
        (if
          (ly:stream-event?
            (cdr event-drul))
          (if
            (null? frame)
            (ly:warning "No start to this box.")
            (begin
              (set! finished extender)
              (set! extender '())
              (ly:engraver-announce-end-grob trans frame
                (cdr event-drul)))))
        (if
          (ly:stream-event? extender-event)
          (begin
            (ly:spanner-set-bound! finished RIGHT
              (ly:context-property context 'currentCommandColumn))
            (ly:engraver-announce-end-grob trans finished extender-event)
            (set! extender-event '()))))
      ((stop-translation-timestep trans)
        (if
          (ly:stream-event?
            (cdr event-drul))
          (begin
            (set! frame '())
            (set-cdr! event-drul '())))
        (if
          (ly:stream-event? extender-event)
          (begin
            (set! extender '())))))))

frameStart =
#(make-span-event 'FrameEvent START)

frameStop =
#(make-span-event 'FrameEvent STOP)

frameExtenderStop =
#(make-span-event 'FrameExtenderEvent STOP)

\layout {
  \context {
    \Global
    \grobdescriptions #my-grob-descriptions
    #my-event-classes
  }
  \context {
    \Voice
    \consists \frameEngraver
  }
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%






reply via email to

[Prev in Thread] Current Thread [Next in Thread]