Jump to content

Color Gradient using Postscript

From LilyPond wiki

Lilypond has no way of creating color gradients. This markup function duplicates the path markup, converts it to postscript and uses postscript's rectclip to crop the duplicates, then colors each one a step to create a smooth gradient. The variable 'res' defines the resolution of the gradient. A larger number here makes the gradient smoother, but takes longer to compile. Bigger gradients and larger paths will need a larger resolution to look smooth.

It has NOT been tested with relative path commands.

\version "2.24.0"

#(define path->ps 
  (lambda (cmds) 
    (apply string-append 
           (map
             (lambda (f)
               (string-append 
                 (apply string-append 
                        (append 
                          (map 
                            (lambda (e) 
                              (string-append 
                                (number->string (exact->inexact e)) 
                                " ")) 
                            (cdr f))
                          (cons (symbol->string (car f)) '())))
                 " "))
             cmds))))
             
#(define-markup-command 
  (gradient-path layout props startr startg startb endr endg endb path res) 
  (number? number? number? number? number? number? list? integer?)
   (let*
    ((ps (path->ps path))
     (markup-test 
       (ly:text-interface::interpret-markup 
         layout props (markup #:line (#:path 0.1 path))))
     (xextnt (ly:stencil-extent markup-test X))
     (yextnt (ly:stencil-extent markup-test Y))
     (xlen (- (cdr xextnt) (car xextnt)))
     (ylen (- (cdr yextnt) (car yextnt)))
     (xstep (/ xlen res))
     (rshadestep (/ (- endr startr) res))
     (gshadestep (/ (- endg startg) res))
     (bshadestep (/ (- endb startb) res))
     (xlist (iota res (car xextnt) xstep))
     (xextls (map (lambda (e) (cons e xlen)) xlist))
     (rshadelist (iota res startr rshadestep))
     (gshadelist (iota res startg gshadestep))
     (bshadelist (iota res startb bshadestep))
     (mkps 
       (map 
         (lambda (a) 
           (markup 
             #:line 
               (#:postscript 
                 (string-append 
                   (number->string (exact->inexact (car a))) 
                   " -1000 " 
                   (number->string (exact->inexact (- (cdr a) (car a))))
                   " 2000 rectclip " 
                   ps 
                   " fill")))) 
         xextls))
     (colored 
       (map 
         (lambda (a r g b) (markup #:line (#:with-color (list r g b) a)))
         (reverse mkps) 
         rshadelist 
         gshadelist 
         bshadelist))
     (finalmkp (reduce make-combine-markup empty-markup colored)))
    (interpret-markup layout props finalmkp)))

samplePath =
#'((moveto 0 0)
   (lineto -10 10)
   (lineto 10 10)
   (lineto 10 -10)
   (curveto -50 -50 -50 50 -10 0)
   (closepath))
   
\markup 
  \translate #'(40 . -20) 
  %% \with-dimensions is needed to return a nice image in LSR
  \with-dimensions #'(-40 . 10) #'(-20 . 15)
  { \gradient-path #1 #0 #0 #0 #0 #1 #samplePath #100 }