Reviewers: ,
Message:
Hey all,
I'm working on a piece w/ scripted SVG, and this'll make it easier for
me to parse the file in Python and move things around. Try it with:
\relative c' {
\override NoteHead #'framing-comments =
#'("NoteHead coming up." . "NoteHead finished.")
\repeat unfold 16 { f }
}
Then use the svg or ps backend and look for these comments.
Cheers,
MS
Description:
Allows for framing comments in LilyPond backends.
Please review this at http://codereview.appspot.com/5450086/
Affected files:
M lily/grob.cc
M lily/stencil-interpret.cc
M scm/define-grob-properties.scm
M scm/framework-svg.scm
M scm/output-ps.scm
M scm/output-svg.scm
Index: lily/grob.cc
diff --git a/lily/grob.cc b/lily/grob.cc
index
567bd0015f4309d8c77f75933347b7d082d11d05..b4c7b0c9a65cd20343a9b41d044ed0dd04c131a4
100644
--- a/lily/grob.cc
+++ b/lily/grob.cc
@@ -170,6 +170,17 @@ Grob::get_print_stencil () const
= *unsmob_stencil (scm_call_1 (ly_lily_module_constant
("stencil-whiteout"),
retval.smobbed_copy ()));
}
+
+ SCM framing_comments = get_property ("framing-comments");
+ if (scm_is_pair (framing_comments))
+ {
+ SCM expr = scm_list_3 (ly_symbol2scm ("framing-comments"),
+ framing_comments,
+ retval.expr ());
+
+ retval = Stencil (retval.extent_box (), expr);
+ }
+
}
return retval;
@@ -779,6 +790,7 @@ ADD_INTERFACE (Grob,
"avoid-slur "
"axis-group-parent-X "
"axis-group-parent-Y "
+ "framing-comments "
"before-line-breaking "
"cause "
"color "
Index: lily/stencil-interpret.cc
diff --git a/lily/stencil-interpret.cc b/lily/stencil-interpret.cc
index
e85ad90f43a2904374d7d9c402890036c24b4611..b8754b814a2dadc903fdae21969e30c149d17a91
100644
--- a/lily/stencil-interpret.cc
+++ b/lily/stencil-interpret.cc
@@ -74,6 +74,18 @@ interpret_stencil_expression (SCM expr,
return;
}
+ else if (head == ly_symbol2scm ("framing-comments"))
+ {
+ SCM framing_comments = scm_cadr (expr);
+ string head_comment = ly_scm2string (scm_car (framing_comments));
+ string tail_comment = ly_scm2string (scm_cdr (framing_comments));
+
+ (*func) (func_arg, scm_list_2 (ly_symbol2scm ("comment"),
ly_string2scm (head_comment)));
+ interpret_stencil_expression (scm_caddr (expr), func, func_arg,
o);
+ (*func) (func_arg, scm_list_2 (ly_symbol2scm ("comment"),
ly_string2scm (tail_comment)));
+
+ return;
+ }
else if (head == ly_symbol2scm ("rotate-stencil"))
{
SCM args = scm_cadr (expr);
Index: scm/define-grob-properties.scm
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index
c26bd3cae19a503c10ee9e3eb7c586e8498adc9a..7114f9e253da3e643f207ff76201a4d31c56414a
100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -306,6 +306,8 @@ note. This is used by
@rinternals{note-collision-interface}.")
various ligature engravers.")
(fraction ,fraction? "Numerator and denominator of a time
signature object.")
+ (framing-comments ,pair? "A pair of comments to go around the
+stencilfied of a grob in a given backend.")
(french-beaming ,boolean? "Use French beaming style for this
stem. The stem stops at the innermost beams.")
(fret-diagram-details ,list? "An alist of detailed grob
Index: scm/framework-svg.scm
diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm
index
ad707a7b894f924bf42198fe222345b16761ec14..678ac7a385c7e44737c3dec006088f91f2abc59b
100644
--- a/scm/framework-svg.scm
+++ b/scm/framework-svg.scm
@@ -113,6 +113,11 @@ src: url('~a');
(ec 'style)
(ec 'defs)))
+;; code dup from output-svg.scm, but necessary because comment
+;; is a stencil and cannot use define-public
+(define (comment s)
+ (string-append "<!--" s "-->\n"))
+
(define (dump-page paper filename page page-number page-count)
(let* ((outputter (ly:make-paper-outputter (open-file
filename "wb") 'svg))
(dump (lambda (str) (display str (ly:outputter-port outputter))))
@@ -132,7 +137,7 @@ src: url('~a');
(module-remove! (ly:outputter-module outputter) 'paper))
(if (ly:get-option 'svg-woff)
(dump (woff-header paper (dirname filename))))
- (dump (comment (format #f "Page: ~S/~S" page-number page-count)))
+ (dump (comment (format #f " Page: ~S/~S " page-number page-count)))
(ly:outputter-output-scheme outputter
`(begin (set! lily-unit-length ,unit-length)
""))
Index: scm/output-ps.scm
diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index
3e376bbe672186e6f3bf35b69d59a3607d3d0f42..6cf9f8a9e5980b430ea00d4c5bb40aed46c1bddf
100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -77,6 +77,9 @@
"false")
radius thick))
+(define (comment s)
+ (string-append "%" s "\n"))
+
(define (dashed-line thick on off dx dy phase)
(ly:format "~4f ~4f ~4f [ ~4f ~4f ] ~4f draw_dashed_line"
dx
@@ -248,6 +251,12 @@
;; restore color from stack
(define (resetcolor) "grestore\n")
+;; open a node
+(define (open-node n) n)
+
+;; close a node
+(define (close-node n) n)
+
;; rotation around given point
(define (setrotation ang x y)
(ly:format "gsave ~4l translate ~a rotate ~4l translate\n"
Index: scm/output-svg.scm
diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index
d993c356358c94fa21fe70f57c09e28cce49687b..6df9bc8b68df9673fc2c13813bdd516f2169e0e4
100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -70,8 +70,8 @@
"c = close"
(format #f "</~S>\n" entity))
-(define-public (comment s)
- (string-append "<!-- " s " -->\n"))
+(define (comment s)
+ (string-append "<!--" s "-->\n"))
(define-public (entity entity string . attributes-alist)
(if (equal? string "")
@@ -300,7 +300,7 @@
(char-lookup (format #f "&#~S;" charcode))
(glyph-by-name (eoc 'altglyph `(glyphname . ,expr)))
(apparently-broken
- (comment "FIXME: how to select glyph by name, altglyph is broken?"))
+ (comment " FIXME: how to select glyph by name, altglyph is broken? "))
(text (string-regexp-substitute "\n" ""
(string-append glyph-by-name apparently-broken char-lookup))))
(define alist '())
@@ -469,7 +469,7 @@
(char-lookup (format #f "&#~S;" charcode))
(glyph-by-name (eoc 'altglyph `(glyphname . ,g)))
(apparently-broken
- (comment "XFIXME: how to select glyph by name, altglyph is
broken?")))
+ (comment " XFIXME: how to select glyph by name, altglyph is
broken? ")))
;; what is W?
(ly:format
"<text~a font-family=\"~a\" font-size=\"~a\">~a</text>"
_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-devel
