Hello, Here is a proposal for a lilypond-like markup notation in scheme, in order to ease markup command definition by users.
For instance:
\markup { foo
\raise #0.2 \hbracket \bold bar
\override #'(baseline-skip . 4)
\bracket \column < baz bazr bla >
}
=== (proposed syntax)
(markup "foo"
#:raise 0.2 #:hbracket #:bold "bar"
#:override '(baseline-skip . 4)
#:bracket #:column ("baz" "bazr" "bla"))
=== (how it can be done today)
(make-line-markup
"foo"
(make-raise-markup 0.2 (make-hbracket-markup (make-bold-markup "bar")))
(make-override-markup '(baseline-skip . 4)
(make-bracket-markup (make-column-markup
(list "baz" "bazr" "bla")))))
The third expression may be less accessible than the second.
The following example shows how to translate LilyPond markup notation
into this scheme notation:
------------------------------------------------------
\score {
\notes {
\fatText
f'1-\markup {
foo
\raise #0.2 \hbracket \bold bar
\override #'(baseline-skip . 4)
\bracket \column < baz bazr bla >
\hspace #2.0
\override #'(font-family . music) {
\lookup #"noteheads-0"
\char #53
}
\musicglyph #"accidentals--1"
\combine "X" "+"
\combine "o" "/"
\box \column < { "string 1" } { "string 2" } >
"$\\emptyset$"
\italic Norsk
\super "2"
\dynamic sfzp
\huge { "A" \smaller "A" \smaller \smaller "A"
\smaller \smaller \smaller "A" }
\sub "alike"
}
\break
f'1-#(markup*
"foo"
#:raise 0.2 #:hbracket #:bold "bar"
#:override '(baseline-skip . 4)
#:bracket #:column ( "baz" "bazr" "bla" )
#:hspace 2.0
#:override '(font-family . music) #:line (#:lookup "noteheads-0"
#:char 53)
#:musicglyph "accidentals--1"
#:combine "X" "+"
#:combine "o" "/"
#:box #:column ("string 1" "string 2")
"$\\emptyset$"
#:italic "Norsk"
#:super "2"
#:dynamic "sfzp"
#:huge #:line ("A" #:smaller "A" #:smaller #:smaller "A"
#:smaller #:smaller #:smaller "A")
#:sub "alike")
}
\paper {
raggedright = ##t
indent = #0
\translator {
\StaffContext
\remove Time_signature_engraver
}
}
}
------------------------------------------------------
This one shows how to use the `markup' macro in order to define a
markup command:
------------------------------------------------------
#(define-public (number-or-string? obj)
(or (number? obj)
(string? obj)))
#(def-markup-command (tempo paper props tempo1 tempo2) (string? number-or-string?)
"Syntax: \\tempo duration-string number
or: \\tempo duration-string1 duration-string2
eg: \\tempo #\"4.\" #120 ==> quater = 120
or: \\tempo #\4.\" \"4\" ==> dotted-quater = quater"
(let ((markup1 (markup #:tiny #:note tempo1 0.7))
(markup2 (if (number? tempo2)
(number->string tempo2)
(markup #:tiny #:note tempo2 0.7))))
(interpret-markup paper props (markup markup1 "=" markup2))))
\score {
\notes {
\time 4/4
c''1^\markup \tempo #"4" #120
\time 6/8
c''2.^\markup \tempo #"4." #"4"
}
\paper { raggedright = ##t }
}
------------------------------------------------------
<<inline: tempo-example.preview.png>>
If you find that it might be interesting, here is a patch for new-markup.scm
--- new-markup.scm.~1.63.~ 2004-01-25 17:10:20.000000000 +0100
+++ new-markup.scm 2004-01-31 15:59:34.000000000 +0100
@@ -82,6 +82,123 @@
error-msg #f)
(cons markup-function args))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; markup constructors
+;;; lilypond-like syntax for markup construction in scheme.
+
+(use-modules (ice-9 optargs)
+ (ice-9 receive))
+
+(defmacro*-public markup (#:rest body)
+ "The `markup' macro provides a lilypond-like syntax for building markups.
+ - #:COMMAND is used instead of \\COMMAND
+ - #:lines ( ... ) is used instead of { ... }
+ - #:center ( ... ) is used instead of \\center < ... >
+ - etc.
+Example:
+ \\markup { foo
+ \\raise #0.2 \\hbracket \\bold bar
+ \\override #'(baseline-skip . 4)
+ \\bracket \\column < baz bazr bla >
+ }
+ <==>
+ (markup \"foo\"
+ #:raise 0.2 #:hbracket #:bold \"bar\"
+ #:override '(baseline-skip . 4)
+ #:bracket #:column (\"baz\" \"bazr\" \"bla\"))
+Use `markup*' in a \\notes block."
+ (car (compile-all-markup-expressions `(#:line ,body))))
+
+(defmacro*-public markup* (#:rest body)
+ "Same as `markup', for use in a \\notes block."
+ `(ly:export (markup ,@body)))
+
+
+(define (compile-all-markup-expressions expr)
+ "Return a list of canonical markups expressions, eg:
+ (#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23)
+ ===>
+ ((make-COMMAND1-markup arg11 arg12)
+ (make-COMMAND2-markup arg21 arg22 arg23) ...)"
+ (do ((rest expr rest)
+ (markps '() markps))
+ ((null? rest) (reverse markps))
+ (receive (m r) (compile-markup-expression rest)
+ (set! markps (cons m markps))
+ (set! rest r))))
+
+(define (keyword->make-markup key)
+ "Transform a keyword, eg. #:COMMAND, in a make-COMMAND-markup symbol."
+ (string->symbol (string-append "make-" (symbol->string (keyword->symbol key))
"-markup")))
+
+(define (compile-markup-expression expr)
+ "Return two values: the first complete canonical markup expression found in `expr',
+eg (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
+ (cond ((and (pair? expr)
+ (keyword? (car expr)))
+ ;; expr === (#:COMMAND arg1 ...)
+ (let* ((command (symbol->string (keyword->symbol (car expr))))
+ (sig (markup-command-signature (car (lookup-markup-command command))))
+ (sig-len (length sig)))
+ (do ((i 0 (1+ i))
+ (args '() args)
+ (rest (cdr expr) rest))
+ ((>= i sig-len)
+ (values (cons (keyword->make-markup (car expr)) (reverse args)) rest))
+ (cond ((eqv? (list-ref sig i) markup-list?)
+ ;; (car rest) is a markup list
+ (set! args (cons `(list ,@(compile-all-markup-expressions (car
rest))) args))
+ (set! rest (cdr rest)))
+ (else
+ ;; pick up one arg in `rest'
+ (receive (a r) (compile-markup-arg rest)
+ (set! args (cons a args))
+ (set! rest r)))))))
+ ((and (pair? expr)
+ (pair? (car expr))
+ (keyword? (caar expr)))
+ ;; expr === ((#:COMMAND arg1 ...) ...)
+ (receive (m r) (compile-markup-expression (car expr))
+ (values m (cdr expr))))
+ (else
+ ;; expr === (symbol ...) or ("string" ...) or ((funcall ...) ...)
+ (values (car expr)
+ (cdr expr)))))
+
+(define (compile-all-markup-args expr)
+ "Transform `expr' into markup arguments"
+ (do ((rest expr rest)
+ (args '() args))
+ ((null? rest) (reverse args))
+ (receive (a r) (compile-markup-arg rest)
+ (set! args (cons a args))
+ (set! rest r))))
+
+(define (compile-markup-arg expr)
+ "Return two values: the desired markup argument, and the rest arguments"
+ (cond ((null? expr)
+ ;; no more args
+ (values '() '()))
+ ((keyword? (car expr))
+ ;; expr === (#:COMMAND ...)
+ ;; ==> build and return the whole markup expression
+ (compile-markup-expression expr))
+ ((and (pair? (car expr))
+ (keyword? (caar expr)))
+ ;; expr === ((#:COMMAND ...) ...)
+ ;; ==> build and return the whole markup expression(s)
+ ;; found in (car expr)
+ (receive (markup-expr rest-expr) (compile-markup-expression (car expr))
+ (if (null? rest-expr)
+ (values markup-expr (cdr expr))
+ (values `(list ,markup-expr ,@(compile-all-markup-args
rest-expr))
+ (cdr expr)))))
+ ((and (pair? (car expr))
+ (pair? (caar expr)))
+ ;; expr === (((foo ...) ...) ...)
+ (values (cons 'list (compile-all-markup-args (car expr))) (cdr expr)))
+ (else (values (car expr) (cdr expr)))))
+
;;;;;;;;;;;;;;;
;;; Utilities for storing and accessing markup commands signature
;;; and keyword.
Changes: (markup) a macro that provides a LilyPond-like syntax in scheme for building markups, in order to help markup command definition. nicolas
_______________________________________________ Lilypond-devel mailing list [EMAIL PROTECTED] http://mail.gnu.org/mailman/listinfo/lilypond-devel
