X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fstencil.scm;h=04ace53b3b75c322472c8e4ff32b5d2cc9964736;hb=3dd9b13331489a191d0e901245cc98476e5fcac1;hp=c0e56cd86e8d4613ab63d34856430aec6307962f;hpb=e9d68c099f03166dbd3c82f753b314a25ddc40cf;p=lilypond.git diff --git a/scm/stencil.scm b/scm/stencil.scm index c0e56cd86e..04ace53b3b 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -1,8 +1,19 @@ -;;;; stencil.scm -- +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 2003--2007 Han-Wen Nienhuys +;;;; Copyright (C) 2003--2009 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 +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . (define-public (stack-stencils axis dir padding stils) "Stack stencils STILS in direction AXIS, DIR, using PADDING." @@ -56,18 +67,18 @@ (set! result (car p))))) result) - -(define-public (bracketify-stencil stil axis thick protusion padding) + +(define-public (bracketify-stencil stil axis thick protrusion padding) "Add brackets around STIL, producing a new stencil." (let* ((ext (ly:stencil-extent stil axis)) - (lb (ly:bracket axis ext thick (- protusion))) - (rb (ly:bracket axis ext thick protusion))) + (lb (ly:bracket axis ext thick protrusion)) + (rb (ly:bracket axis ext thick (- protrusion)))) (set! stil - (ly:stencil-combine-at-edge stil (other-axis axis) 1 lb padding)) + (ly:stencil-combine-at-edge stil (other-axis axis) 1 rb padding)) (set! stil - (ly:stencil-combine-at-edge stil (other-axis axis) -1 rb padding)) + (ly:stencil-combine-at-edge lb (other-axis axis) 1 stil padding)) stil)) (define-public (make-line-stencil width startx starty endx endy) @@ -81,6 +92,7 @@ (interval-widen xext (/ width 2)) (interval-widen yext (/ width 2))))) + (define-public (make-filled-box-stencil xext yext) "Make a filled box." @@ -260,12 +272,15 @@ encloses the contents. stencil) )) -(define-public (dimension-arrows destination) +(define-public (dimension-arrows destination max-size) "Draw twosided arrow from here to @var{destination}" (let* ((e_x 1+0i) (e_y 0+1i) + (distance (sqrt (+ (* (car destination) (car destination)) + (* (cdr destination) (cdr destination))))) + (size (min max-size (/ distance 3))) (rotate (lambda (z ang) (* (make-polar 1 ang) z))) @@ -274,9 +289,10 @@ encloses the contents. (z-dest (+ (* e_x (car destination)) (* e_y (cdr destination)))) (e_z (/ z-dest (magnitude z-dest))) - (triangle-points '(-1+0.25i - 0 - -1-0.25i)) + (triangle-points (list + (* size -1+0.25i) + 0 + (* size -1-0.25i))) (p1s (map (lambda (z) (+ z-dest (rotate z (angle z-dest)))) triangle-points)) @@ -294,8 +310,8 @@ encloses the contents. `(polygon (quote ,(concatenate (map complex-to-offset p2s))) 0.0 #t) null null ) ) - (thickness 0.1) - (shorten-line 0.5) + (thickness (min (/ distance 12) 0.1)) + (shorten-line (min (/ distance 3) 0.5)) (start (complex-to-offset (/ (* e_z shorten-line) 2))) (end (complex-to-offset (- z-dest (/ (* e_z shorten-line) 2)))) @@ -351,7 +367,7 @@ encloses the contents. (ly:format "(~$,~$)" (car extent) (cdr extent))))))) (arrows (ly:stencil-translate-axis - (dimension-arrows (cons 0 (interval-length extent))) + (dimension-arrows (cons 0 (interval-length extent)) 1.0) (interval-start extent) Y))) (set! annotation (center-stencil-on-extent text-stencil)) @@ -368,6 +384,38 @@ encloses the contents. annotation)) +(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset prev-system-end + #:key (base-color blue)) + (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0))) + (space (get-spacing-var 'space)) + (padding (get-spacing-var 'padding)) + (min-dist (get-spacing-var 'minimum-distance)) + (contrast-color (append (cdr base-color) (list (car base-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)))))) + + (define-public (eps-file->stencil axis size file-name) (let* ((contents (ly:gulp-file file-name)) @@ -381,6 +429,9 @@ encloses the contents. 0)) (scaled-bbox (map (lambda (x) (* factor x)) bbox)) + ; We need to shift the whole eps to (0,0), otherwise it will appear + ; displaced in lilypond (displacement will depend on the scaling!) + (translate-string (ly:format "~a ~a translate" (- (list-ref bbox 0)) (- (list-ref bbox 1)))) (clip-rect-string (ly:format "~a ~a ~a ~a rectclip" (list-ref bbox 0) @@ -401,8 +452,9 @@ currentpoint translate BeginEPSF ~a dup scale ~a +~a %%BeginDocument: ~a -" factor clip-rect-string +" factor translate-string clip-rect-string file-name ) @@ -411,9 +463,10 @@ BeginEPSF EndEPSF grestore ")) - - (cons (list-ref scaled-bbox 0) (list-ref scaled-bbox 2)) - (cons (list-ref scaled-bbox 1) (list-ref scaled-bbox 3))) + ; Stencil starts at (0,0), since we have shifted the eps, and its + ; size is exactly the size of the scaled bounding box + (cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0))) + (cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1)))) (ly:make-stencil "" '(0 . 0) '(0 . 0))) ))