+2004-11-21 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ * lily/stencil.cc (translate): remove absolute dimension.
+
+ * ly/titling-init.ly (oddFooterMarkup): new file. Generate titles
+ via markup.
+
+ * scm/page-layout.scm (marked-up-headfoot): create header/footer
+ field from user-supplied markup
+
+ * scm/define-markup-commands.scm (on-the-fly): new markup
+ command. Enter SCM markup procedure directly in Scheme.
+ (fromproperty): new markup command. Read markup from props argument.
+
+ * scm/titling.scm (marked-up-title): create title via
+ user-specified markup.
+
+ * scm/define-markup-commands.scm (column): remove empty stencils
+ from column.
+
+ * lily/ly-module.cc (LY_DEFINE): use ly_module_lookup(). This does
+ not have side-effect of creating variable stub.
+
+ * lily/stencil-scheme.cc (LY_DEFINE): add ly:stencil-empty?
+
2004-11-21 Jan Nieuwenhuizen <janneke@gnu.org>
* scm/encoding.scm (coding-alist):
@unnumbered New features in 2.5 since 2.4
@itemize @bullet
+@item
+Layout for titles, page header and footer can now be entered as
+@code{\markup} commands.
+
@item Positioning of slurs can now be adjusted manually
@item Grace notes are correctly quoted and formatted when using cue notes.
*/
#include "ly-module.hh"
-
+#include "warn.hh"
#include "main.hh"
#include "string.hh"
-#include "protected-scm.hh"
#define FUNC_NAME __FUNCTION__
entry_to_alist (void *closure, SCM key, SCM val, SCM result)
{
(void) closure;
- return scm_cons (scm_cons (key, scm_variable_ref (val)), result);
+ if (scm_variable_bound_p (val) == SCM_BOOL_T)
+ {
+ return scm_cons (scm_cons (key, scm_variable_ref (val)), result);
+ }
+ else
+ {
+ programming_error ("Unbound variable in module.");
+ return result;
+ }
}
LY_DEFINE (ly_module2alist, "ly:module->alist",
{
for (SCM s = modules; scm_is_pair (s); s = scm_cdr (s))
{
- SCM mod = scm_car (s);
- SCM v = scm_sym2var (sym, scm_module_lookup_closure (mod),
- SCM_UNDEFINED);
- if (SCM_VARIABLEP(v) && SCM_VARIABLE_REF(v) != SCM_UNDEFINED)
- return SCM_VARIABLE_REF(v);
+ SCM mod = scm_car (s);
+ SCM v = ly_module_lookup (mod, sym);
+ if (SCM_VARIABLEP (v) && SCM_VARIABLE_REF (v) != SCM_UNDEFINED)
+ return scm_variable_ref(v);
}
if (def != SCM_UNDEFINED)
}
+LY_DEFINE (ly_stencil_empty_p, "ly:stencil-empty?",
+ 1, 0, 0, (SCM stil),
+ "Return whether @var{stil} is empty ")
+{
+ Stencil *s = unsmob_stencil (stil);
+ SCM_ASSERT_TYPE (s, stil, SCM_ARG1, __FUNCTION__, "stencil");
+ return scm_from_bool (s->is_empty ());
+}
+
+
LY_DEFINE (ly_stencil_origin, "ly:stencil-origin",
2, 0, 0, (SCM stil, SCM axis),
"Return a pair of numbers signifying the origin @var{stil} in "
Axis a = X_AXIS;
while (a < NO_AXES)
{
- /* FIXME: 100CM should relate to paper size. */
- if (abs (o[a]) > 100 CM
- || isinf (o[a]) || isnan (o[a]))
+ if (isinf (o[a]) || isnan (o[a]))
{
- programming_error (String_convert::form_string ("Improbable offset for stencil: %f%s", o[a], INTERNAL_UNIT)
+ programming_error (String_convert::form_string ("Improbable offset for stencil: %f staff space", o[a])
+ "\n"
+ "Setting to zero.");
o[a] = 0.0;
outputscale = #1.7573
#(define-public score-title default-score-title)
- #(define-public user-title default-user-title)
- #(define-public book-title default-book-title)
+% #(define-public user-title default-user-title)
+% #(define-public book-title default-book-title)
+ #(define-public book-title (marked-up-title 'bookTitleMarkup))
+ #(define-public score-title (marked-up-title 'scoreTitleMarkup))
%%
%% ugh. hard coded?
#(define page-music-height default-page-music-height )
#(define page-make-stencil default-page-make-stencil )
- #(define make-header plain-header)
- #(define make-footer plain-footer)
+ #(define make-header (marked-up-headfoot 'oddHeaderMarkup 'evenHeaderMarkup))
+ #(define make-footer (marked-up-headfoot 'oddFooterMarkup 'evenFooterMarkup))
#(set-paper-dimension-variables (current-module))
+
+ \include "titling-init.ly"
}
--- /dev/null
+
+bookTitleMarkup = \markup {
+ \column <
+ \fill-line < \fromproperty #'header:dedication >
+ \fill-line <
+ \huge \bigger \bigger \bigger \bold \fromproperty #'header:title
+ >
+ \fill-line <
+ \override #'(baseline-skip . 3)
+ \column <
+ \fill-line <
+ \huge \bigger \bigger
+ \bold \fromproperty #'header:subtitle
+ >
+ \fill-line <
+ \huge \bigger
+ \bold \fromproperty #'header:subsubtitle
+ >
+ >
+ >
+ \fill-line <
+ \fromproperty #'header:poet
+ \fromproperty #'header:instrument
+ \column <
+ \fromproperty #'header:composer
+ \fromproperty #'header:arranger
+ >
+ >
+ >
+}
+
+scoreTitleMarkup = \markup {
+ \fill-line <
+ \fromproperty #'header:piece
+ \fromproperty #'header:opus
+ >
+}
+
+
+oddHeaderMarkup = \markup
+\fill-line <
+ ""
+ \fromproperty #'header:instrument
+ \fromproperty #'page:page-number-string
+>
+
+evenHeaderMarkup = \markup
+\fill-line <
+ \fromproperty #'page:page-number-string
+ \fromproperty #'header:instrument
+ ""
+>
+
+oddFooterMarkup = \markup {
+ \column <
+ \fill-line <
+ \on-the-fly #(lambda (layout props arg)
+ (if (= 1 (chain-assoc-get 'page:page-number props -1))
+ (interpret-markup layout props arg)
+ empty-stencil
+ ))
+ \fromproperty #'header:copyright
+ >
+ \fill-line <
+ \on-the-fly #(lambda (layout props arg)
+ (if (chain-assoc-get 'page:last? props #f)
+ (interpret-markup layout props arg)
+ empty-stencil
+ ))
+ \fromproperty #'header:tagline
+ >
+ >
+}
+
+
+
+
;;; * each markup function should have a doc string with
;; syntax, description and example.
+(define-public empty-stencil (ly:make-stencil '() '(1 . -1) '(1 . -1)))
(def-markup-command (stencil layout props stil) (ly:stencil?)
"Stencil as markup"
(def-markup-command (score layout props score) (ly:score?)
+ "Inline an image of music."
(let*
((systems (ly:score-embedded-format score layout)))
(def-markup-command (fill-line layout props markups)
(markup-list?)
"Put @var{markups} in a horizontal line of width @var{line-width}.
- The markups are spaced/flushed to fill the entire line."
+ The markups are spaced/flushed to fill the entire line.
+ If there are no arguments, return an empty stencil.
+"
- (let* ((stencils (map (lambda (x) (interpret-markup layout props x))
- markups))
+ (let* ((stencils (filter
+ (lambda (stc) (not (ly:stencil-empty? stc)))
+ (map (lambda (x) (interpret-markup layout props x))
+ markups)))
(text-width (apply + (map interval-length
(map (lambda (x)
(ly:stencil-extent x X))
stencils))))
- (word-count (length markups))
+ (word-count (length stencils))
(word-space (chain-assoc-get 'word-space props))
(line-width (chain-assoc-get 'linewidth props))
(fill-space (if (< line-width text-width)
(car stencils)
(ly:make-stencil '() '(0 . 0) '(0 . 0)) )
stencils)))
- (stack-stencils X RIGHT fill-space line-stencils)))
+
+ (if (null? stencils)
+ empty-stencil
+ (stack-stencils X RIGHT fill-space line-stencils))))
(define (font-markup qualifier value)
(lambda (layout props arg)
(prepend-alist-chain qualifier value props)
arg)))
+
(def-markup-command (line layout props args) (markup-list?)
"Put @var{args} in a horizontal line. The property @code{word-space}
determines the space between each markup in @var{args}."
(chain-assoc-get 'word-space props)
(map (lambda (m) (interpret-markup layout props m)) args)))
+(def-markup-command (fromproperty layout props symbol) (symbol?)
+ "Read the @var{symbol} from property settings, and produce a stencil from the markup contained within. If @var{symbol} is not defined, it returns an empty markup"
+ (let*
+ ((m (chain-assoc-get symbol props)))
+
+ (if (markup? m)
+ (interpret-markup layout props m)
+ (ly:make-stencil '() '(1 . -1) '(1 . -1) ))))
+
+
+(def-markup-command (on-the-fly layout props procedure arg) (symbol? markup?)
+ "Apply the @var{procedure} markup command to
+@var{arg}. @var{procedure} should take a single argument."
+ (let*
+ ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
+
+ (set-object-property! anonymous-with-signature
+ 'markup-signature
+ (list markup?))
+
+ (interpret-markup layout props (list anonymous-with-signature arg))
+ ))
+
+
(def-markup-command (combine layout props m1 m2) (markup? markup?)
"Print two markups on top of each other."
(let*
"Stack the markups in @var{args} vertically."
(stack-lines
-1 0.0 (chain-assoc-get 'baseline-skip props)
- (map (lambda (m) (interpret-markup layout props m)) args)))
+ (remove ly:stencil-empty?
+ (map (lambda (m) (interpret-markup layout props m)) args))))
(def-markup-command (dir-column layout props args) (markup-list?)
"Make a column of args, going up or down, depending on the setting
(interpret-markup layout props (make-fill-line-markup line))
'())))
+(define-public ((marked-up-headfoot what-odd what-even) layout scopes page-number last?)
+
+ "Read variables WHAT-ODD, WHAT-EVEN, and interpret them as
+markup. The PROPS argument will include variables set in SCOPES and
+page:last?, page:page-number-string and page:page-number
+"
+
+ (define (get sym)
+ (let ((x (ly:modules-lookup scopes sym)))
+ (if (markup? x) x #f)))
+ (define (interpret-in-page-env potential-markup)
+ (if (markup? potential-markup)
+ (let*
+ ((alists (map ly:module->alist scopes))
+ (prefixed-alists
+ (map (lambda (alist)
+ (map (lambda (entry)
+ (cons
+ (string->symbol
+ (string-append
+ "header:"
+ (symbol->string (car entry))))
+ (cdr entry)
+ ))
+ alist))
+ alists))
+ (pgnum-alist (list
+ (cons 'page:last? last?)
+ (cons 'page:page-number-string
+ (number->string page-number))
+ (cons 'page:page-number page-number)))
+ (props (append
+ (list pgnum-alist)
+ prefixed-alists
+ (page-properties layout)))
+ )
+
+ (interpret-markup layout props potential-markup))
+
+ empty-stencil))
+
+ (interpret-in-page-env
+ (if (and (even? page-number)
+ (markup? (get what-even)))
+ (get what-even)
+ (get what-odd))))
+
+
+
;; TODO: add publisher ID on non-first page.
(define-public (plain-footer layout scopes page-number last?)
"Standard footer. Empty, save for first (copyright) and last (tagline) page."
(ly:output-def-lookup layout 'text-font-defaults))))
;;;;;;;;;;;;;;;;;;
+
+
+(define-public ((marked-up-title what) layout scopes)
+ "Read variables WHAT from SCOPES, and interpret it as markup. The
+PROPS argument will include variables set in SCOPES (prefixed with
+`header:'
+"
+
+ (define (get sym)
+ (let ((x (ly:modules-lookup scopes sym)))
+ (if (markup? x) x #f)))
+
+ (let*
+ ((alists (map ly:module->alist scopes))
+ (prefixed-alist
+ (map (lambda (alist)
+ (map (lambda (entry)
+ (cons
+ (string->symbol
+ (string-append
+ "header:"
+ (symbol->string (car entry))))
+ (cdr entry)
+ ))
+ alist))
+ alists))
+ (props (append prefixed-alist
+ (page-properties layout)))
+
+ (markup (get what))
+ )
+
+ (if (markup? markup)
+ (interpret-markup layout props markup)
+ (ly:make-stencil '() '(1 . -1) '(1 . -1)))
+ ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; old
; titling.
(define-public (default-book-title layout scopes)
"Generate book title from header strings."
projects / lilypond.git / commitdiff