bug-lilypond
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: make-connected-path-stencil should not hard-code the path origin at


From: Paul Morris
Subject: Re: make-connected-path-stencil should not hard-code the path origin at (0 0)
Date: Wed, 23 Oct 2013 20:59:51 -0700 (PDT)

Paul Morris wrote
> A proposed revision making this change is in the attached file.

Looks like the attachment did not make it through, so pasting it inline
below.  (Also, I only sent one email, but it looks like it posted twice for
some reason...)

-Paul

\version "2.17.29"

% Most of this code is just copied verbatim from stencil.scm 
% as dependencies of the main function
% the changes proposed are in the "revised-make-connected-path-stencil" 
% function below starting at line 72

#(define (line-part-min-max x1 x2)
  (list (min x1 x2) (max x1 x2)))

#(define (bezier-part-min-max x1 x2 x3 x4)
  ((lambda (x) (list (reduce min 10000 x) (reduce max -10000 x)))
   (map
    (lambda (x)
      (+ (* x1 (expt (- 1 x) 3))
         (+ (* 3 (* x2 (* (expt (- 1 x) 2) x)))
            (+ (* 3 (* x3 (* (- 1 x) (expt x 2))))
               (* x4 (expt x 3))))))
    (if (< (+ (expt x2 2) (+ (expt x3 2) (* x1 x4)))
           (+ (* x1 x3) (+ (* x2 x4) (* x2 x3))))
        (list 0.0 1.0)
        (filter
         (lambda (x) (and (>= x 0) (<= x 1)))
         (append
          (list 0.0 1.0)
          (map (lambda (op)
                 (if (not (eqv? 0.0
                                (exact->inexact (- (+ x1 (* 3 x3)) (+ x4 (*
3 x2))))))
                     ;; Zeros of the bezier curve
                     (/ (+ (- x1 (* 2 x2))
                           (op x3
                               (sqrt (- (+ (expt x2 2)
                                           (+ (expt x3 2) (* x1 x4)))
                                        (+ (* x1 x3)
                                           (+ (* x2 x4) (* x2 x3)))))))
                        (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))
                     ;; Apply L'hopital's rule to get the zeros if 0/0
                     (* (op 0 1)
                        (/ (/ (- x4 x3) 2)
                           (sqrt (- (+ (* x2 x2)
                                       (+ (* x3 x3) (* x1 x4)))
                                    (+ (* x1 x3)
                                       (+ (* x2 x4) (* x2 x3)))))))))
               (list + -))))))))

#(define (bezier-min-max x1 y1 x2 y2 x3 y3 x4 y4)
  (map (lambda (x)
         (apply bezier-part-min-max x))
       `((,x1 ,x2 ,x3 ,x4) (,y1 ,y2 ,y3 ,y4))))

#(define (line-min-max x1 y1 x2 y2)
  (map (lambda (x)
         (apply line-part-min-max x))
       `((,x1 ,x2) (,y1 ,y2))))

#(define (path-min-max origin pointlist)
  ((lambda (x)
     (list
      (reduce min +inf.0 (map caar x))
      (reduce max -inf.0 (map cadar x))
      (reduce min +inf.0 (map caadr x))
      (reduce max -inf.0 (map cadadr x))))
   (map (lambda (x)
          (if (= (length x) 8)
              (apply bezier-min-max x)
              (apply line-min-max x)))
        (map (lambda (x y)
               (append (list (cadr (reverse x)) (car (reverse x))) y))
             (append (list origin)
                     (reverse (cdr (reverse pointlist)))) pointlist))))


% to make it possible to specify the origin of the path, 
% rather than having it hard-coded at (0 0), some suggested changes 
% have been made to the function below:

#(define (revised-make-connected-path-stencil pointlist thickness
                                            x-scale y-scale connect fill)
  "Make a connected path described by the list @var{pointlist}, with
thickness @var{thickness}, and scaled by @var{x-scale} in the X direction
and @var{y-scale} in the Y direction. @var{connect} and @var{fill} are 
boolean arguments that specify if the path should be connected or filled, 
respectively. The first point in @var{pointlist} sets the origin of the
path."

  (let* ((origin (car pointlist)) ;; changed
         (boundlist (path-min-max origin (cdr pointlist))) ;; changed
         ;; modify pointlist to scale the coordinates
         (path (map (lambda (x)
                      (apply
                       (if (= 6 (length x))
                           (lambda (x1 x2 x3 x4 x5 x6)
                             (list 'curveto
                                   (* x1 x-scale)
                                   (* x2 y-scale)
                                   (* x3 x-scale)
                                   (* x4 y-scale)
                                   (* x5 x-scale)
                                   (* x6 y-scale)))
                           (lambda (x1 x2)
                             (list 'lineto
                                   (* x1 x-scale)
                                   (* x2 y-scale)
                                   )))
                       x))
                    (cdr pointlist))) ;; changed
         (origin-scaled (list                                   ;; added
                         (* (list-ref origin 0) x-scale)    ;; added
                         (* (list-ref origin 1) y-scale))) ;; added
         ;; a path must begin with a `moveto'
         (prepend-origin (cons (cons 'moveto origin-scaled) path)) ;;
changed
         ;; if this path is connected, add closepath to the end
         (final-path (if connect
                         (append prepend-origin (list '(closepath)))
                         prepend-origin))
         (command-list (concatenate final-path)))    
    (ly:make-stencil
     `(path ,thickness
            `(,@',command-list)
            'round
            'round
            ,(if fill #t #f))
     (coord-translate
      ((if (< x-scale 0) reverse-interval identity)
       (cons (* x-scale (list-ref boundlist 0))
             (* x-scale (list-ref boundlist 1))))
      `(,(/ thickness -2) . ,(/ thickness 2)))
     (coord-translate
      ((if (< y-scale 0) reverse-interval identity)
       (cons (* y-scale (list-ref boundlist 2))
             (* y-scale (list-ref boundlist 3))))
      `(,(/ thickness -2) . ,(/ thickness 2))))))


% EXAMPLE 
{
  c'^\markup \stencil 
  #(revised-make-connected-path-stencil 
    '((1 1) (1 2) (2 3) (2 0))
  0.15
  1.1
  1.1
  #f
  #f)
}



--
View this message in context: 
http://lilypond.1069038.n5.nabble.com/make-connected-path-stencil-should-not-hard-code-the-path-origin-at-0-0-tp152879p152880.html
Sent from the Bugs mailing list archive at Nabble.com.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]