[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
}
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- aleatoric box / frameEngraver, Karol Majewski, 2013/07/13
- Re: aleatoric box / frameEngraver, Karol Majewski, 2013/07/14
- Re: aleatoric box / frameEngraver, Thomas Morley, 2013/07/14
- Re: aleatoric box / frameEngraver,
Karol Majewski <=
- Re: aleatoric box / frameEngraver, David Nalesnik, 2013/07/15
- Re: aleatoric box / frameEngraver, Karol Majewski, 2013/07/20
- Re: aleatoric box / frameEngraver, David Nalesnik, 2013/07/29
- Re: aleatoric box / frameEngraver, David Nalesnik, 2013/07/30
- Re: aleatoric box / frameEngraver, David Nalesnik, 2013/07/30