Rietveld Code Review Tool
Help | Bug tracker | Discussion group | Source code | Sign in
(116)

Unified Diff: scm/stencil.scm

Issue 555490045: Run find -name \*.scm -exec scripts/auxiliar/fixscm.sh {} + (Closed)
Patch Set: Created 4 years ago
Use n/p to move between diff chunks; N/P to move between comments. Please Sign in to add in-line comments.
Jump to:
View side-by-side diff with in-line comments
Download patch
« no previous file with comments | « scm/song.scm ('k') | scm/tablature.scm » ('j') | no next file with comments »
Expand Comments ('e') | Collapse Comments ('c') | Show Comments Hide Comments ('s')
Index: scm/stencil.scm
diff --git a/scm/stencil.scm b/scm/stencil.scm
index 146eaee24bce6199a7e64cee8e057c2966019dbe..759fe87b43a6e9c668cb4e72cd0d08eb40815e69 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -16,32 +16,32 @@
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
(define (make-bezier-sandwich-stencil coords thick)
- (make-path-stencil
- `(moveto
- ,(car (list-ref coords 0))
- ,(cdr (list-ref coords 0))
- curveto
- ,(car (list-ref coords 1))
- ,(cdr (list-ref coords 1))
- ,(car (list-ref coords 2))
- ,(cdr (list-ref coords 2))
- ,(car (list-ref coords 3))
- ,(cdr (list-ref coords 3))
- 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 0))
- ,(cdr (list-ref coords 0))
- closepath)
- thick
- 1
- 1
- #t))
+ (make-path-stencil
+ `(moveto
+ ,(car (list-ref coords 0))
+ ,(cdr (list-ref coords 0))
+ curveto
+ ,(car (list-ref coords 1))
+ ,(cdr (list-ref coords 1))
+ ,(car (list-ref coords 2))
+ ,(cdr (list-ref coords 2))
+ ,(car (list-ref coords 3))
+ ,(cdr (list-ref coords 3))
+ 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 0))
+ ,(cdr (list-ref coords 0))
+ closepath)
+ thick
+ 1
+ 1
+ #t))
(define-public (make-bow-stencil
- start stop thickness angularity bow-height orientation)
+ start stop thickness angularity bow-height orientation)
"Create a bow stencil.
It starts at point @var{start}, ends at point @var{stop}.
@var{thickness} is the thickness of the bow.
@@ -75,57 +75,57 @@ Limitation: s-curves are currently not supported.
;;;; (1) calculate control-points for the horizontal unit-bow,
;; y-values for 2nd/3rd control-points
(outer-control
- (* 4/3 (sign orientation) (/ bow-height length-to-print)))
+ (* 4/3 (sign orientation) (/ bow-height length-to-print)))
(inner-control
- (* (sign orientation)
- (- (abs outer-control) (/ thickness length-to-print))))
+ (* (sign orientation)
+ (- (abs outer-control) (/ thickness length-to-print))))
;; x-values for 2nd/3rd control-points depending on `angularity'
(offset-index
- (- (* 0.6 angularity) 0.8))
+ (- (* 0.6 angularity) 0.8))
(left-control
- (+ 0.1 (* 0.3 angularity)))
+ (+ 0.1 (* 0.3 angularity)))
(right-control
- (- 1 left-control))
+ (- 1 left-control))
;; defining 2nd and 3rd outer control-points
(left-outer-control-point
- (cons left-control outer-control))
+ (cons left-control outer-control))
(right-outer-control-point
- (cons right-control outer-control))
+ (cons right-control outer-control))
;; defining 2nd and 3rd inner control-points
(left-inner-control-point
- (cons left-control inner-control))
+ (cons left-control inner-control))
(right-inner-control-point
- (cons right-control inner-control))
+ (cons right-control inner-control))
(coord-list
- (list
- '(0 . 0)
- left-outer-control-point
- right-outer-control-point
- '(1 . 0)
- right-inner-control-point
- left-inner-control-point))
+ (list
+ '(0 . 0)
+ left-outer-control-point
+ right-outer-control-point
+ '(1 . 0)
+ right-inner-control-point
+ left-inner-control-point))
;;;; (2) move control-points to match `start' and `stop'
(moved-coord-list
- (map
- (lambda (p)
- (cons
- (+ (car start) (- (* (car p) dx) (* (cdr p) dy)))
- (+ (cdr start) (+ (* (car p) dy) (* (cdr p) dx)))))
- coord-list)))
+ (map
+ (lambda (p)
+ (cons
+ (+ (car start) (- (* (car p) dx) (* (cdr p) dy)))
+ (+ (cdr start) (+ (* (car p) dy) (* (cdr p) dx)))))
+ coord-list)))
;; final stencil
(make-bezier-sandwich-stencil
- moved-coord-list
- (min (* 2 thickness) line-width))))))
+ moved-coord-list
+ (min (* 2 thickness) line-width))))))
(define* (make-tie-stencil
- start stop thickness orientation
- #:optional (height-limit 1.0)(ratio 0.33)(angularity 0.5))
+ start stop thickness orientation
+ #:optional (height-limit 1.0)(ratio 0.33)(angularity 0.5))
(let* (;; taken from bezier-bow.cc
(F0_1
- (lambda (x) (* (/ 2 PI) (atan (* PI x 0.5)))))
+ (lambda (x) (* (/ 2 PI) (atan (* PI x 0.5)))))
(slur-height
- (lambda (w h_inf r_0) (* (F0_1 (/ (* w r_0) h_inf)) h_inf)))
+ (lambda (w h_inf r_0) (* (F0_1 (/ (* w r_0) h_inf)) h_inf)))
(width (abs (- (car start) (car stop))))
(height (slur-height width height-limit ratio)))
(make-bow-stencil start stop thickness angularity height orientation)))
@@ -151,8 +151,8 @@ a list of @var{paddings}."
(interval-start (ly:stencil-extent next axis)))
padding)))
(ly:stencil-add
- front
- (ly:stencil-translate-axis next offset axis))))
+ front
+ (ly:stencil-translate-axis next offset axis))))
(car stils)
(cdr stils)
paddings)))
@@ -203,13 +203,13 @@ the more angular the shape of the parenthesis."
(stop (cons 0 (cdr y-extent)))
(line-width 0.1)
(bow-stil
- (make-bow-stencil
- start stop thickness angularity width orientation))
+ (make-bow-stencil
+ start stop thickness angularity width orientation))
(x-extent (ly:stencil-extent bow-stil X)))
(ly:make-stencil
- (ly:stencil-expr bow-stil)
- (interval-widen x-extent (/ line-width 2))
- (interval-widen y-extent (/ line-width 2)))))
+ (ly:stencil-expr bow-stil)
+ (interval-widen x-extent (/ line-width 2))
+ (interval-widen y-extent (/ line-width 2)))))
(define-public (parenthesize-stencil
stencil half-thickness width angularity padding)
@@ -496,41 +496,41 @@ reset by moveto commands). @var{previous-point} is a pair of x and y
coordinates for the previous point in the path."
(if (pair? path)
(let*
- ((head-raw (car path))
- (rest (cdr path))
- (head (cond
- ((memq head-raw '(rmoveto M m)) 'moveto)
- ((memq head-raw '(rlineto L l)) 'lineto)
- ((memq head-raw '(rcurveto C c)) 'curveto)
- ((memq head-raw '(Z z)) 'closepath)
- (else head-raw)))
- (arity (cond
- ((memq head '(lineto moveto)) 2)
- ((eq? head 'curveto) 6)
- (else 0)))
- (coordinates-raw (take rest arity))
- (is-absolute (if (memq head-raw
- '(rmoveto m rlineto l rcurveto c)) #f #t))
- (coordinates (if is-absolute
- coordinates-raw
- ;; convert relative coordinates to absolute by
- ;; adding them to previous point values
- (map (lambda (c n)
- (if (even? n)
- (+ c (car previous-point))
- (+ c (cdr previous-point))))
- coordinates-raw
- (iota arity))))
- (new-point (if (eq? head 'closepath)
- origin
- (cons
- (list-ref coordinates (- arity 2))
- (list-ref coordinates (- arity 1)))))
- (new-origin (if (eq? head 'moveto)
- new-point
- origin)))
- (cons (cons head coordinates)
- (convert-path (drop rest arity) new-origin new-point)))
+ ((head-raw (car path))
+ (rest (cdr path))
+ (head (cond
+ ((memq head-raw '(rmoveto M m)) 'moveto)
+ ((memq head-raw '(rlineto L l)) 'lineto)
+ ((memq head-raw '(rcurveto C c)) 'curveto)
+ ((memq head-raw '(Z z)) 'closepath)
+ (else head-raw)))
+ (arity (cond
+ ((memq head '(lineto moveto)) 2)
+ ((eq? head 'curveto) 6)
+ (else 0)))
+ (coordinates-raw (take rest arity))
+ (is-absolute (if (memq head-raw
+ '(rmoveto m rlineto l rcurveto c)) #f #t))
+ (coordinates (if is-absolute
+ coordinates-raw
+ ;; convert relative coordinates to absolute by
+ ;; adding them to previous point values
+ (map (lambda (c n)
+ (if (even? n)
+ (+ c (car previous-point))
+ (+ c (cdr previous-point))))
+ coordinates-raw
+ (iota arity))))
+ (new-point (if (eq? head 'closepath)
+ origin
+ (cons
+ (list-ref coordinates (- arity 2))
+ (list-ref coordinates (- arity 1)))))
+ (new-origin (if (eq? head 'moveto)
+ new-point
+ origin)))
+ (cons (cons head coordinates)
+ (convert-path (drop rest arity) new-origin new-point)))
'()))
(let* ((path-absolute (convert-path path (cons 0 0) (cons 0 0)))
@@ -543,9 +543,9 @@ coordinates for the previous point in the path."
((= 0 n) c)
((odd? n) (* c x-scale))
(else (* c y-scale))))
- path-unit
- (iota (length path-unit))))
- path-absolute)))
+ path-unit
+ (iota (length path-unit))))
+ path-absolute)))
;; a path must begin with a 'moveto'
(path-final (if (eq? 'moveto (car (car path-scaled)))
path-scaled
@@ -557,10 +557,10 @@ coordinates for the previous point in the path."
(cdr path-headless))))
(ly:make-stencil
`(path ,thickness
- `(,@',(concatenate path-final))
- 'round
- 'round
- ,(if fill #t #f))
+ `(,@',(concatenate path-final))
+ 'round
+ 'round
+ ,(if fill #t #f))
(coord-translate
((if (< x-scale 0) reverse-interval identity)
(cons
@@ -588,7 +588,7 @@ path should be connected or filled, respectively."
(case (length path-unit)
((2) (append (list 'lineto) path-unit))
((6) (append (list 'curveto) path-unit))))
- pointlist)
+ pointlist)
;; if this path is connected, add closepath to the end
(if connect (list '(closepath)) '())))
thickness x-scale y-scale fill))
@@ -714,14 +714,14 @@ Value @code{Y} (or @code{1}) flips it vertically. @var{stil} is
flipped in place; its position, the coordinates of its bounding
box, remains the same."
(let* (
- ;; scale stencil using -1 to flip it and
- ;; then restore it to its original position
- (xy (if (= axis X) '(-1 . 1) '(1 . -1)))
- (flipped-stil (ly:stencil-scale stil (car xy) (cdr xy)))
- (flipped-ext (ly:stencil-extent flipped-stil axis))
- (original-ext (ly:stencil-extent stil axis))
- (offset (- (car original-ext) (car flipped-ext)))
- (replaced-stil (ly:stencil-translate-axis flipped-stil offset axis)))
+ ;; scale stencil using -1 to flip it and
+ ;; then restore it to its original position
+ (xy (if (= axis X) '(-1 . 1) '(1 . -1)))
+ (flipped-stil (ly:stencil-scale stil (car xy) (cdr xy)))
+ (flipped-ext (ly:stencil-extent flipped-stil axis))
+ (original-ext (ly:stencil-extent stil axis))
+ (offset (- (car original-ext) (car flipped-ext)))
+ (replaced-stil (ly:stencil-translate-axis flipped-stil offset axis)))
replaced-stil))
(define-public (stencil-with-color stencil color)
@@ -746,8 +746,8 @@ of the white stencil we make between 0 and 2*pi."
(if (or (not (positive? angle-increments))
(not (positive? radial-increments)))
(begin
- (ly:warning "Both angle-increments and radial-increments must be positive numbers.")
- stil)
+ (ly:warning "Both angle-increments and radial-increments must be positive numbers.")
+ stil)
(let* ((angle-inc (/ 360 angle-increments))
(radial-inc (/ thickness radial-increments)))
@@ -756,45 +756,45 @@ of the white stencil we make between 0 and 2*pi."
(if (<= ang 0)
new-stil
(circle-plot (- ang dec) dec radius original-stil
- (ly:stencil-add
- new-stil
- (ly:stencil-translate original-stil
- (ly:directed ang radius))))))
+ (ly:stencil-add
+ new-stil
+ (ly:stencil-translate original-stil
+ (ly:directed ang radius))))))
(define (radial-plot radius original-stil new-stil)
(if (<= radius 0)
new-stil
(ly:stencil-add new-stil
- (radial-plot
- (- radius radial-inc)
- original-stil
- (circle-plot 360 angle-inc
- radius original-stil empty-stencil)))))
+ (radial-plot
+ (- radius radial-inc)
+ original-stil
+ (circle-plot 360 angle-inc
+ radius original-stil empty-stencil)))))
(let ((whiteout-expr
- (ly:stencil-expr
- (stencil-with-color
- (radial-plot thickness stil empty-stencil)
- color))))
+ (ly:stencil-expr
+ (stencil-with-color
+ (radial-plot thickness stil empty-stencil)
+ color))))
(ly:stencil-add
- (ly:make-stencil
- `(delay-stencil-evaluation ,(delay whiteout-expr)))
- stil)))))
+ (ly:make-stencil
+ `(delay-stencil-evaluation ,(delay whiteout-expr)))
+ stil)))))
(define*-public (stencil-whiteout-box stil
- #:optional (thickness 0) (blot 0) (color white))
+ #:optional (thickness 0) (blot 0) (color white))
"@var{thickness} is how far, as a multiple of line-thickness,
the white outline extends past the extents of stencil @var{stil}."
(let*
- ((x-ext (interval-widen (ly:stencil-extent stil X) thickness))
- (y-ext (interval-widen (ly:stencil-extent stil Y) thickness)))
+ ((x-ext (interval-widen (ly:stencil-extent stil X) thickness))
+ (y-ext (interval-widen (ly:stencil-extent stil Y) thickness)))
- (ly:stencil-add
- (stencil-with-color (ly:round-filled-box x-ext y-ext blot) color)
- stil)))
+ (ly:stencil-add
+ (stencil-with-color (ly:round-filled-box x-ext y-ext blot) color)
+ stil)))
(define*-public (stencil-whiteout stil
- #:optional style thickness (line-thickness 0.1))
+ #:optional style thickness (line-thickness 0.1))
"@var{style}, @var{thickness} and @var{line-thickness} are optional
arguments. If set, @var{style} determines the shape of the white
background. Given @code{'outline} the white background is produced
@@ -807,12 +807,12 @@ the white background extends past the extents of stencil @var{stil}. If
@var{thickness} has not been specified, an appropriate default is chosen
based on @var{style}."
(let ((thick (* line-thickness
- (if (number? thickness)
- thickness
- (cond
- ((eq? style 'outline) 3)
- ((eq? style 'rounded-box) 3)
- (else 0))))))
+ (if (number? thickness)
+ thickness
+ (cond
+ ((eq? style 'outline) 3)
+ ((eq? style 'rounded-box) 3)
+ (else 0))))))
(cond
((eq? style 'special) stil)
((eq? style 'outline) (stencil-whiteout-outline stil thick))
@@ -949,8 +949,8 @@ with optional arrows of @code{max-size} on start and end controlled by
(min-dist-blocks (<= (- start-Y-offset min-dist) next-staff-Y))
(min-dist-color (if min-dist-blocks contrast-color base-color))
(name-string (if (string-null? name)
- ""
- (simple-format #f " (~a)" name)))
+ ""
+ (simple-format #f " (~a)" name)))
(basic-annotation
(annotate-y-interval layout
(simple-format #f "basic-dist~a" name-string)
« no previous file with comments | « scm/song.scm ('k') | scm/tablature.scm » ('j') | no next file with comments »

Powered by Google App Engine
RSS Feeds Recent Issues | This issue
This is Rietveld f62528b