Hi Kieren,

2014-03-17 3:24 GMT+01:00 Kieren MacMillan <kieren_macmil...@sympatico.ca>:
> Hi Harm,
>
>> do you already have results from your real-world testings?
>> If 'line-parts' is useful, I'd like to turn it into a patch.
>> Or do you notice some issues?
>
> Haven't had the chance to stress-test it yet -- sorry.
> Give me a few days, and I'll get back to you with the results.

Meanwhile I found a use case where line-parts gave unexpected output.
Additionally I thought it would be nice not only being able to
reformat a given markup or list, but to edit it as desired.

Therefore I wrote the markup-list-commands:
  delete-lines
  extract-lines
  lines-tail
  lines-head

Together with the fixed line-parts in the attached file.

Cheers,
  Harm
\version "2.19.1"

%#(use-modules (ice-9 pretty-print))
%#(use-modules (srfi srfi-1))

#(define (get-certain-list-elts number-list lst)
  (cond ((null? number-list) lst)
        ((or (number? number-list)
             (number-list? number-list))
         (let* ((new-number-list 
                 (if (number? number-list) 
                     (list number-list)
                     number-list))
                (sorted-number-list (sort new-number-list >)))
           (if (or (> (car sorted-number-list) (length lst))
                   (<= (car (last-pair sorted-number-list)) 0))
               (ly:error "The deserved line is not part of the markup.")
               (map
                 (lambda (x) (list-ref lst (- x 1)))
                 new-number-list))))
        (else 
          (ly:error 
            "number-list has to be a single number or a list of numbers."))))

#(define-markup-list-command (line-parts layout props args)(markup-list?)
  (let* ((make-stencil-list
           (lambda (a)
             (let ((fromproperty-markup? 
                      (lambda (m) (if (procedure? m) 
                                  (eq? 'fromproperty-markup (procedure-name m))
                                  #f)))
                   (line-markup? 
                      (lambda (m) (if (procedure? m) 
                                      (eq? 'line-markup (procedure-name m))
                                      #f))))
               (cond 
                  ;; what to do, if the argument is not of type 
                  ;; fromproperty/line-markup:
                  ((and (list? a)
                        (not (null? a)) ;; hmm, can arg ever be null?
                        (not (fromproperty-markup? (car a)))
                        (not (line-markup? (car a))))
                   (interpret-markup-list layout props (list a)))
                   
                  ;; fromproperty-markup needs to be special-cased, because it's 
                  ;; argument is not a line-markup, but a symbol, looked up in 
                  ;; props.
                  ;;
                  ;; hmm, do I need to do:
                  ;;  (cons 
                  ;;     (list 
                  ;;       (cons symbol `(,property-recursive-markup ,symbol))) 
                  ;;     props)
                  ;; again? (it's already done in the fromproperty-def)
                  ((and (list? a)
                        (not (null? a)) ;; hmm, can the argument ever be null?
                        (fromproperty-markup? (car a)))
                        
                   (let* ((prop-arg (chain-assoc-get (last a) props))
                          (fromprop-arg (if (not (list? prop-arg))
                                            (list prop-arg)
                                            prop-arg)))
                     (if prop-arg
                       (interpret-markup-list layout props 
                            (if (procedure? (car fromprop-arg))
                                (last fromprop-arg)
                                fromprop-arg))
                       (list empty-stencil))))
                                
                  ;; what to do with a line-markup:
                  ((and (list? a)
                        (not (null? a)) 
                        (line-markup? (car a)))
                   (interpret-markup-list layout props (last a)))
                   
                  ;; in any other case return empty-stencil.
                  ;; hmm, are other cases thinkable at all?
                  (else (list empty-stencil)))))))
                  
    (flatten-list (map make-stencil-list args))))

#(define-markup-list-command (extract-lines layout props whichs args)
    (number-or-pair? markup-list?)
  (let ((stil-list (line-parts-markup-list layout props args)))
      (get-certain-list-elts whichs stil-list)))
      
#(define-markup-list-command (delete-lines layout props whichs args)
    (number-or-pair? markup-list?)
  (let* ((stil-list (line-parts-markup-list layout props args))
         (lines-to-delete (get-certain-list-elts whichs stil-list)))
      (lset-difference eq? stil-list lines-to-delete)))
      
#(define-markup-list-command (lines-head layout props which args)
    (number? markup-list?)
  (let ((stil-list (line-parts-markup-list layout props args)))
  (if (> which (length stil-list))
      (ly:error "The deserved lines are not entirely part of the markup.")
      (list-head stil-list which))))
      
#(define-markup-list-command (lines-tail layout props which args)
    (number? markup-list?)
  (let ((stil-list (line-parts-markup-list layout props args)))
  (if (or (> which (length stil-list)) (<= which 0))
      (ly:error "The deserved lines are not entirely part of the markup.")
      (list-tail stil-list (- which 1)))))
      
%%%%%%%%%%%%
%% TESTS
%%%%%%%%%%%%

\paper { 
  bookTitleMarkup = 
  \markup 
  \box
  \column {
    \fill-line { \bold \fontsize #4 \fromproperty #'header:dedication }
    \vspace #2
    \fontsize #5 \fill-line  \line-parts { \fromproperty #'header:title }
    \with-color #red
    \fontsize #15 \fill-line { \line-parts { \fromproperty #'header:subtitle } }
    \with-color #green
    \fontsize #15 \line { \line-parts { \fromproperty #'header:subsubtitle } }
    \with-color #yellow
    \fontsize #15 
      \fill-line { \line-parts { \fromproperty #'header:subsubsubtitle } }
    \fill-line { 
      \abs-fontsize #12 
      \center-column { \line-parts { \fromproperty #'header:meter } }
      \right-column { \line-parts { \fromproperty #'header:composer } }
    }
  }
	
 oddHeaderMarkup = 
 \markup 
   \column {
     \abs-fontsize #12 
     \fill-line {
     	\rounded-box
     	\center-column {
     	  \bold \fontsize #4 "page-header-test" 
     	  \line-parts { \fromproperty #'header:title } 
     	  \fromproperty #'header:meter
          \right-column { \line-parts { \fromproperty #'header:composer } }
     	}
     }
   }
}

\header { 
  dedication = "TESTING BOOKTITLE"
  title = \markup { "Aaa" "Bbb" "Ccc" }
%  subtitle = "asdfg" 
%  subsubtitle = #'("bla" "blub")
  %subsubsubtitle = "xxxxxxxxxxxx"
  meter = \markup { 
  	   \line { \with-color #red \rotate #3 "Crazy" }
  	   \line { \rotate #-3 "Whatever" }
  }
  composer = \markup #'("which" "composer")
}
 
\markup 
  \column { \vspace #2 \box \bold \fontsize #4 "testing toplevel markups:" }

testOne = \markup { \fontsize #4 "X|X" \italic "YyyyY" \column { a b } }
testTwo = \markup { \fontsize #2 "--|--" \bold "xXXx" \column { x y } }
%%{
%% The following two markups should return the same output:
\markup 
  \with-color #green
  \box { 
    \line { 
      \line-parts { 
        \fontsize #4 "X|X" \italic "YyyyY" \column { a b } 
        \fontsize #2 "--|--" \bold "xXXx" \column { x y }
      } 
    } 
  }
  %}
\markup \box { \line { \line-parts { \testOne \testTwo } } }
%%{
%% Testing some use-cases:
\markup \box { \fill-line { \line-parts { \testOne } } }
\markup \box { \center-column { \line-parts { \testOne } } }

%% Should not give an error:
%\markup \line { \line-parts {  } }
%}

\markup 
  \column { 
    \vspace #2 
    \box \bold \fontsize #4 "testing with score-lines markup:" 
  }

sc =
\markup 
  \score-lines {
    \new Staff \relative c' { 
      \set Score.barNumberVisibility = 
      #all-bar-numbers-visible
      \bar ""
      c1\break
      d,\break
      e'\break
      f \break
      g \break
      b \break
    }
    \layout { 
      indent = 0
      line-width = 50 
      \override Score.BarNumber.break-visibility =
      ##(#f #t #t)
      %\override Score.BarNumber.X-extent = #'(0 . 0)
    }
  }

\markup 
  \column { 
    \box \column \delete-lines #'(2) { \sc }
    \box \column \extract-lines #2 { \sc }
    \box \lines-tail #3 { \testOne }
  }
  
\markuplist % \override #'(baseline-skip . 13)
  \column-lines {
    \fill-line \box \lines-head #3 { \sc }
    \fill-line \box \lines-tail #4 { \sc }
    \box "Why is the above moved to the right?"
    \box \extract-lines #'(1 3 5) { \sc }
  }
  
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user

Reply via email to