CVSROOT: /cvsroot/lilypond
Module name: lilypond
Branch:
Changes by: Han-Wen Nienhuys <[EMAIL PROTECTED]> 05/06/29 09:49:33
Modified files:
. : ChangeLog
scm : define-markup-commands.scm
Log message:
remove encoded-simple.
remove font-markup.
(fontsize): remove old version of fontsize.
(wordwrap): new markup function. Wrap into paragraphs.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/lilypond/lilypond/ChangeLog.diff?tr1=1.3838&tr2=1.3839&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/lilypond/lilypond/scm/define-markup-commands.scm.diff?tr1=1.94&tr2=1.95&r1=text&r2=text
Patches:
Index: lilypond/ChangeLog
diff -u lilypond/ChangeLog:1.3838 lilypond/ChangeLog:1.3839
--- lilypond/ChangeLog:1.3838 Wed Jun 29 08:36:20 2005
+++ lilypond/ChangeLog Wed Jun 29 09:49:32 2005
@@ -3,6 +3,7 @@
* scm/define-markup-commands.scm: remove encoded-simple.
remove font-markup.
(fontsize): remove old version of fontsize.
+ (wordwrap): new markup function. Wrap into paragraphs.
* VERSION: Branch lilypond_2_6
(MINOR_VERSION): go to 2.7.0
Index: lilypond/scm/define-markup-commands.scm
diff -u lilypond/scm/define-markup-commands.scm:1.94
lilypond/scm/define-markup-commands.scm:1.95
--- lilypond/scm/define-markup-commands.scm:1.94 Wed Jun 29 08:36:20 2005
+++ lilypond/scm/define-markup-commands.scm Wed Jun 29 09:49:33 2005
@@ -12,12 +12,13 @@
(use-modules (ice-9 regex))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; utility functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
(define-public empty-stencil (ly:make-stencil '() '(1 . -1) '(1 . -1)))
(define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
-(def-markup-command (stencil layout props stil) (ly:stencil?)
- "Stencil as markup"
- stil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; geometric shapes
@@ -155,6 +156,10 @@
;; importing graphics.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-markup-command (stencil layout props stil) (ly:stencil?)
+ "Stencil as markup"
+ stil)
+
(define bbox-regexp
(make-regexp "%%BoundingBox: ([0-9-]+) ([0-9-]+) ([0-9-]+) ([0-9-]+)"))
@@ -272,17 +277,9 @@
(define-public empty-markup
(make-simple-markup ""))
-
-(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.
- If there are no arguments, return an empty stencil.
-"
-
-
- (define (get-fill-space word-count line-width text-widths)
- "Calculate the necessary paddings between each two adjacent texts.
+;; helper for justifying lines.
+(define (get-fill-space word-count line-width text-widths)
+ "Calculate the necessary paddings between each two adjacent texts.
The lengths of all texts are stored in @var{text-widths}.
The normal formula for the padding between texts a and b is:
padding = line-width/(word-count - 1) - (length(a) + length(b))/2
@@ -290,26 +287,31 @@
whole length of the first or last text.
Return a list of paddings.
"
- (cond
- ((null? text-widths) '())
-
- ;; special case first padding
- ((= (length text-widths) word-count)
- (cons
- (- (- (/ line-width (1- word-count)) (car text-widths))
- (/ (car (cdr text-widths)) 2))
- (get-fill-space word-count line-width (cdr text-widths))))
- ;; special case last padding
- ((= (length text-widths) 2)
- (list (- (/ line-width (1- word-count))
- (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
- (else
- (cons
- (- (/ line-width (1- word-count))
- (/ (+ (car text-widths) (car (cdr text-widths))) 2))
- (get-fill-space word-count line-width (cdr text-widths))))))
-
+ (cond
+ ((null? text-widths) '())
+
+ ;; special case first padding
+ ((= (length text-widths) word-count)
+ (cons
+ (- (- (/ line-width (1- word-count)) (car text-widths))
+ (/ (car (cdr text-widths)) 2))
+ (get-fill-space word-count line-width (cdr text-widths))))
+ ;; special case last padding
+ ((= (length text-widths) 2)
+ (list (- (/ line-width (1- word-count))
+ (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
+ (else
+ (cons
+ (- (/ line-width (1- word-count))
+ (/ (+ (car text-widths) (car (cdr text-widths))) 2))
+ (get-fill-space word-count line-width (cdr text-widths))))))
+(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.
+ If there are no arguments, return an empty stencil."
+
(let* ((orig-stencils
(map (lambda (x) (interpret-markup layout props x))
markups))
@@ -318,13 +320,13 @@
(if (ly:stencil-empty? stc)
point-stencil
stc)) orig-stencils))
- (text-widths
- (map (lambda (stc)
- (if (ly:stencil-empty? stc)
- 0.0
- (interval-length (ly:stencil-extent stc X))))
- stencils))
- (text-width (apply + text-widths))
+ (text-widths
+ (map (lambda (stc)
+ (if (ly:stencil-empty? stc)
+ 0.0
+ (interval-length (ly:stencil-extent stc X))))
+ stencils))
+ (text-width (apply + text-widths))
(word-count (length stencils))
(word-space (chain-assoc-get 'word-space props))
(line-width (chain-assoc-get 'linewidth props))
@@ -369,6 +371,89 @@
(remove ly:stencil-empty? stencils))))
+(def-markup-command (wordwrap layout props args) (markup-list?)
+ "Perform simple wordwrap on @var{args}"
+
+ (define (take-list width space stencils
+ accumulator accumulated-width)
+ "Return (head-list . tail) pair, with head-list fitting into width"
+ (if (null? stencils)
+ (cons accumulator stencils)
+ (let*
+ ((first (car stencils))
+ (first-wid (cdr (ly:stencil-extent (car stencils) X)))
+ (newwid (+ space first-wid accumulated-width))
+ (word-space (chain-assoc-get 'word-space props))
+ )
+
+ (if
+ (or (null? accumulator)
+ (< newwid width))
+
+ (take-list width space
+ (cdr stencils)
+ (cons first accumulator)
+ newwid)
+ (cons accumulator stencils))
+ )))
+
+ (let*
+ ((line-width (chain-assoc-get 'linewidth props))
+ (justify (chain-assoc-get 'word-wrap-justify props #f))
+ (base-space (chain-assoc-get 'word-space props))
+ (space (if justify
+
+ ;; justify only stretches lines.
+ (* 0.7 base-space)
+ base-space))
+
+ (baseline-skip (chain-assoc-get 'baseline-skip props)))
+
+ (let loop
+ ((lines '())
+ (todo
+ (remove ly:stencil-empty?
+ (map (lambda (m) (interpret-markup layout props m)) args))))
+
+ (let*
+ ((line-break (take-list line-width space todo
+ '() 0.0))
+ (line-stencils (car line-break))
+ (space-left (- line-width (apply + (map (lambda (x) (cdr
(ly:stencil-extent x X)))
+ line-stencils))))
+
+ (line-word-space (cond
+ ((not justify) space)
+
+ ;; don't stretch last line of paragraph.
+ ((null? (cdr line-break))
+ base-space)
+ ((null? line-stencils) 0.0)
+ ((null? (cdr line-stencils)) 0.0)
+ (else (/ space-left (1- (length line-stencils))))))
+
+ (line (stack-stencil-line
+ line-word-space
+ (reverse line-stencils))))
+
+ (if (pair? (cdr line-break))
+ (loop (cons line lines)
+ (cdr line-break))
+
+ (stack-lines DOWN 0.0 baseline-skip (reverse (cons line lines)))
+ ))
+
+ )))
+
+
+
+(def-markup-command (justify layout props args) (markup-list?)
+ "Like wordwrap, but with lines stretched to justify the margins."
+
+ (interpret-markup layout
+ (prepend-alist-chain 'word-wrap-justify #t props)
+ (list wordwrap-markup args)
+ ))
(def-markup-command (combine layout props m1 m2) (markup? markup?)
"Print two markups on top of each other."
@@ -941,7 +1026,8 @@
(apply min (map (lambda (x) (car (ly:stencil-extent x axis))) ss))
(apply max (map (lambda (x) (cdr (ly:stencil-extent x axis))) ss))))
- (define (stack-stencils stencils bskip last-stencil)
+
+ (define (stack-stencils-vertically stencils bskip last-stencil)
(cond
((null? stencils) '())
((not (ly:stencil? last-stencil))
@@ -954,7 +1040,7 @@
orig
0.1 bskip)))
- (cons new (stack-stencils (cdr stencils) bskip new))))))
+ (cons new (stack-stencils-vertically (cdr stencils) bskip new))))))
(define (make-brackets stencils indices acc)
(if (and stencils
@@ -989,7 +1075,7 @@
x)) args))
(leading
(chain-assoc-get 'baseline-skip props))
- (stacked (stack-stencils
+ (stacked (stack-stencils-vertically
(remove ly:stencil-empty? stencils) 1.25 #f))
(brackets (make-brackets stacked indices '())))
_______________________________________________
Lilypond-cvs mailing list
Lilypond-cvs@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-cvs
