From e249f3c55170776943a2e2fbd943e516bcacfec6 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Tue, 12 Jul 2005 20:46:24 +0000 Subject: [PATCH] * scm/define-markup-commands.scm (justify-field): add. * scm/define-grobs.scm (all-grob-descriptions): decrease font size. --- ChangeLog | 6 ++++ THANKS | 6 ++++ scm/define-grobs.scm | 1 + scm/define-markup-commands.scm | 19 ++++++++++- scm/framework-scm.scm | 2 ++ scm/framework-socket.scm | 15 ++++----- scm/output-socket.scm | 61 ++++++++++++++++++++++++++++++---- 7 files changed, 94 insertions(+), 16 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1602dd7508..5897557246 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2005-07-12 Han-Wen Nienhuys + + * scm/define-markup-commands.scm (justify-field): add. + + * scm/define-grobs.scm (all-grob-descriptions): decrease font size. + 2005-07-11 Han-Wen Nienhuys * lily/lookup.cc (filled_box): express filled_box with diff --git a/THANKS b/THANKS index 37488a8a4a..4712da10e6 100644 --- a/THANKS +++ b/THANKS @@ -22,6 +22,12 @@ Sven Axelsson +BUG HUNTERS/SUGGESTIONS + +Erlend Aasland + + + Release 2.6 *********** diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index 60ca3f1170..91dc17cc1e 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -1236,6 +1236,7 @@ . ( (print-function . ,Text_interface::print) (Y-offset-callbacks . (,Staff_symbol_referencer::callback)) + (font-size . -2) (stem-attachment-function . ,tablature-stem-attachment-function) (font-series . bold) (meta . ((interfaces diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index 98d2161c37..df97c7d41c 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -507,7 +507,24 @@ determines the space between each markup in @var{args}." (def-markup-command (justify-string layout props arg) (string?) "Justify a string. Paragraphs may be separated with double newlines" (wordwrap-string layout props #t arg)) - + + +(def-markup-command (wordwrap-field layout props symbol) (symbol?) + (let* ((m (chain-assoc-get symbol props))) + (if (string? m) + (interpret-markup layout props + (list wordwrap-string-markup m)) + (ly:make-stencil '() '(1 . -1) '(1 . -1))))) + +(def-markup-command (justify-field layout props symbol) (symbol?) + (let* ((m (chain-assoc-get symbol props))) + (if (string? m) + (interpret-markup layout props + (list justify-string-markup m)) + (ly:make-stencil '() '(1 . -1) '(1 . -1))))) + + + (def-markup-command (combine layout props m1 m2) (markup? markup?) "Print two markups on top of each other." (let* ((s1 (interpret-markup layout props m1)) diff --git a/scm/framework-scm.scm b/scm/framework-scm.scm index 3454a18a5d..d1ee804cd8 100644 --- a/scm/framework-scm.scm +++ b/scm/framework-scm.scm @@ -25,6 +25,8 @@ (pretty-print (ly:stencil-expr page) file)) (ly:paper-book-pages book)))) +(define-public output-classic-framework output-framework) + (define-public (convert-to-ps . args) #t) (define-public (convert-to-pdf . args) #t) diff --git a/scm/framework-socket.scm b/scm/framework-socket.scm index a2a000e1e2..799e95d77b 100644 --- a/scm/framework-socket.scm +++ b/scm/framework-socket.scm @@ -13,19 +13,18 @@ (define-public (output-framework channel book scopes fields ) (let* - ( - (ctor-arg (if (string? channel) + ((ctor-arg (if (string? channel) (open-output-file (format "~a.socket" channel)) channel)) (outputter (ly:make-paper-outputter ctor-arg - "socket"))) - - (for-each - (lambda (page) - (ly:outputter-dump-stencil outputter page)) - (ly:paper-book-pages book)))) + "socket")) + (systems (ly:paper-book-systems book))) + (if (pair? systems) + (ly:outputter-dump-stencil outputter + (ly:paper-system-stencil (car systems)))) + )) (define-public output-classic-framework output-framework) diff --git a/scm/output-socket.scm b/scm/output-socket.scm index 54bf5d1342..74451f3aa8 100644 --- a/scm/output-socket.scm +++ b/scm/output-socket.scm @@ -19,23 +19,70 @@ (ly:all-stencil-expressions)) + +(define-public (draw-line thick x1 y1 x2 y2) + (format "drawline ~a ~a ~a ~a ~a" + thick x1 y2 x2 y2)) + + (define-public (named-glyph font glyph) - (format "~a ~a glyphshow" glyph - (ly:font-name font))) + (format "glyphshow ~a \"~a\" ~a" + (ly:font-glyph-name-to-charcode font glyph) + (ly:font-name font) + (modified-font-metric-font-scaling font) + )) (define-public (placebox x y s) - (format "place at ~a ~a: ~a\n" x y s)) + (format "at ~a ~a ~a\n" x y s)) -(define-public (round-filled-box x y width height blotdiam) - (format "~a ~a ~a ~a ~a draw_round_box" - x y width height blotdiam +(define-public (round-filled-box breapth width depth height blot-diameter) + (format "draw_round_box ~a ~a ~a ~a ~a" + breapth width depth height blot-diameter )) +(define (music-cause grob) + (let* + ((cause (ly:grob-property grob 'cause))) + + (cond + ((ly:music? cause) cause) + ((ly:grob? cause) (music-cause cause)) + (else + #f)))) + +(define (grob-bbox grob offset) + (let* + ((x-ext (ly:grob-extent grob grob X)) + (y-ext (ly:grob-extent grob grob Y)) + (x (car offset)) + (y (cdr offset)) + ) + + (list (+ x (car x-ext)) + (+ y (car y-ext)) + (+ x (cdr x-ext)) + (+ y (cdr y-ext))) + )) + +(define-public (no-origin) + "nocause\n") + +(define-public (grob-cause offset grob) + (let* + ((cause (music-cause grob))) + (if (and cause (integer? (ly:music-property cause 'input-tag))) + (apply format + (append + (list "cause ~a ~a ~a ~a ~a\n" (ly:music-property cause 'input-tag)) + (grob-bbox grob offset) + )) + ""))) + (define-public (glyph-string postscript-font-name size cid? x-y-named-glyphs) - (format "~a ~a text: ~a " postscript-font-name size + (format "text \"~a\" ~a ~a " postscript-font-name size (string-join (map (lambda (xyn) (caddr xyn)) x-y-named-glyphs)))) -- 2.39.5