X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fstencil.scm;h=0ecc9abe8ed4f4206f351b822d5973497b612013;hb=32a34dcef0c0041c6d62677487a380b5c8b85712;hp=64f48cc89df75604f2b1a47b0bf085d2a8624686;hpb=f41973ff763d5972a85995b6d40c864281ec6714;p=lilypond.git diff --git a/scm/stencil.scm b/scm/stencil.scm index 64f48cc89d..0ecc9abe8e 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2003--2011 Han-Wen Nienhuys +;;;; Copyright (C) 2003--2012 Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -15,6 +15,30 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . +(define (make-bezier-sandwich-stencil coords thick xext yext) + (let* ((command-list `(moveto + ,(car (list-ref coords 3)) + ,(cdr (list-ref coords 3)) + curveto + ,(car (list-ref coords 0)) + ,(cdr (list-ref coords 0)) + ,(car (list-ref coords 1)) + ,(cdr (list-ref coords 1)) + ,(car (list-ref coords 2)) + ,(cdr (list-ref coords 2)) + curveto + ,(car (list-ref coords 4)) + ,(cdr (list-ref coords 4)) + ,(car (list-ref coords 5)) + ,(cdr (list-ref coords 5)) + ,(car (list-ref coords 6)) + ,(cdr (list-ref coords 6)) + closepath))) + (ly:make-stencil + `(path ,thick `(,@' ,command-list) 'round 'round #t) + xext + yext))) + (define-public (stack-stencils axis dir padding stils) "Stack stencils @var{stils} in direction @var{axis}, @var{dir}, using @var{padding}." @@ -128,26 +152,25 @@ the more angular the shape of the parenthesis." (lower-inner-control-point (cons inner-control-x lower-control-y))) - (ly:make-stencil - (list 'bezier-sandwich - `(quote ,(list - ;; Step 4: curve through inner control points - ;; to lower end point. - upper-inner-control-point - lower-inner-control-point - lower-end-point - ;; Step 3: move to upper end point. - upper-end-point - ;; Step 2: curve through outer control points - ;; to upper end point. - lower-outer-control-point - upper-outer-control-point - upper-end-point - ;; Step 1: move to lower end point. - lower-end-point)) - line-width) - (interval-widen x-extent (/ line-width 2)) - (interval-widen y-extent (/ line-width 2))))) + (make-bezier-sandwich-stencil + (list + ;; Step 4: curve through inner control points + ;; to lower end point. + upper-inner-control-point + lower-inner-control-point + lower-end-point + ;; Step 3: move to upper end point. + upper-end-point + ;; Step 2: curve through outer control points + ;; to upper end point. + lower-outer-control-point + upper-outer-control-point + upper-end-point + ;; Step 1: move to lower end point. + lower-end-point) + line-width + (interval-widen x-extent (/ line-width 2)) + (interval-widen y-extent (/ line-width 2))))) (define-public (parenthesize-stencil stencil half-thickness width angularity padding) @@ -197,12 +220,20 @@ y@tie{}radius @code{y-radius}, and thickness @var{thickness} with fill defined by @code{fill}." (let* ((x-out-radius (+ x-radius (/ thickness 2.0))) - (y-out-radius (+ y-radius (/ thickness 2.0))) ) - + (y-out-radius (+ y-radius (/ thickness 2.0))) + (x-max x-radius) + (x-min (- x-radius)) + (y-max y-radius) + (y-min (- y-radius)) + (commands `(,(list 'moveto x-max 0) + ,(list 'curveto x-max y-max x-min y-max x-min 0) + ,(list 'curveto x-min y-min x-max y-min x-max 0) + ,(list 'closepath))) + (command-list (fold-right append '() commands))) (ly:make-stencil - (list 'oval x-radius y-radius thickness fill) - (cons (- x-out-radius) x-out-radius) - (cons (- y-out-radius) y-out-radius)))) + `(path ,thickness `(,@',command-list) 'round 'round ,fill) + (cons (- x-out-radius) x-out-radius) + (cons (- y-out-radius) y-out-radius)))) (define-public (make-partial-ellipse-stencil @@ -394,7 +425,6 @@ respectively." (append prepend-origin (list 'closepath)) prepend-origin)) (command-list (fold-right append '() final-path))) - (ly:make-stencil `(path ,thickness `(,@',command-list) @@ -640,7 +670,7 @@ with optional arrows of @code{max-size} on start and end controlled by (markup #:whiteout #:simple (cond ((interval-empty? extent) - (format "empty")) + "empty") (is-length (ly:format "~$" (interval-length extent))) (else @@ -658,43 +688,43 @@ with optional arrows of @code{max-size} on start and end controlled by (center-stencil-on-extent dim-stencil) 0.5)) (set! annotation - (ly:make-stencil (list 'color color (ly:stencil-expr annotation)) - (ly:stencil-extent annotation X) - (cons 10000 -10000))))) + (stencil-with-color annotation color)))) annotation)) -(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset prev-system-end +;; TODO: figure out how to annotate padding nicely +;; TODO: emphasize either padding or min-dist depending on which constraint was active +(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset next-staff-Y #:key (base-color blue)) - (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0))) - (space (get-spacing-var 'space)) + (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0))) + (space (get-spacing-var 'basic-distance)) (padding (get-spacing-var 'padding)) (min-dist (get-spacing-var 'minimum-distance)) - (contrast-color (append (cdr base-color) (list (car base-color))))) + (contrast-color (append (cdr base-color) (list (car base-color)))) + (min-dist-blocks (<= (- start-Y-offset min-dist) next-staff-Y)) + (min-dist-color (if min-dist-blocks contrast-color base-color)) + (basic-annotation (annotate-y-interval layout + "basic-dist" + (cons (- start-Y-offset space) start-Y-offset) + #t + #:color (map (lambda (x) (* x 0.25)) base-color))) + (min-annotation (annotate-y-interval layout + "min-dist" + (cons (- start-Y-offset min-dist) start-Y-offset) + #t + #:color min-dist-color)) + (extra-annotation (annotate-y-interval layout + "extra dist" + (cons next-staff-Y (- start-Y-offset min-dist)) + #t + #:color (map (lambda (x) (* x 0.5)) min-dist-color)))) + (stack-stencils X RIGHT 0.0 (list - (annotate-y-interval layout - "space" - (cons (- start-Y-offset space) start-Y-offset) - #t - #:color (map (lambda (x) (* x 0.25)) base-color)) - (annotate-y-interval layout - "min-dist" - (cons (- start-Y-offset min-dist) start-Y-offset) - #t - #:color (map (lambda (x) (* x 0.5)) base-color)) - (ly:stencil-add - (annotate-y-interval layout - "bottom-of-extent" - (cons prev-system-end start-Y-offset) - #t - #:color base-color) - (annotate-y-interval layout - "padding" - (cons (- prev-system-end padding) prev-system-end) - #t - #:color contrast-color)))))) - + basic-annotation + (if min-dist-blocks + min-annotation + (ly:stencil-add min-annotation extra-annotation)))))) (define-public (eps-file->stencil axis size file-name) (let*