;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2010--2011 Mike Solomon <mikesol@stanfordalumni.org>
+;;;; Copyright (C) 2010--2012 Mike Solomon <mikesol@stanfordalumni.org>
;;;; Clarinet drawings copied from diagrams created by
;;;; Gilles Thibault <gilles.thibault@free.fr>
;;;;
;; Utility functions
(define-public (symbol-concatenate . names)
- "Like string-concatenate, but for symbols"
+ "Like @code{string-concatenate}, but for symbols."
(string->symbol (apply string-append (map symbol->string names))))
(define-public (function-chain arg function-list)
- "Applies a list of functions in function list to arg.
- Each element of function list is structured (cons function '(arg2 arg3 ...))
- If function takes arguments besides arg, they are provided in function list.
- For example:
- @code{guile> (function-chain 1 `((,+ 1) (,- 2) (,+ 3) (,/)))}
- @code{1/3}"
+ "Applies a list of functions in @var{function-list} to @var{arg}.
+Each element of @var{function-list} is structured @code{(cons function
+'(arg2 arg3 ...))}. If function takes arguments besides @var{arg}, they
+are provided in @var{function-list}.
+
+Example: Executing @samp{(function-chain 1 `((,+ 1) (,- 2) (,+ 3) (,/)))}
+returns @samp{1/3}."
(if (null? function-list)
arg
(function-chain
"Returns true if x is the square of a value in input-list."
(pair? (memv (inexact->exact (sqrt x)) input-list)))
-(define (satisfies-function? function input-list)
- "Returns true if an element in @code{input-list} is true
- when @code{function} is applied to it.
- For example:
- @code{guile> (satisfies-function? null? '((1 2) ()))}
- @code{#t}
- @code{guile> (satisfies-function? null? '((1 2) (3)))}
- @code{#f}"
- (if (null? input-list)
- #f
- (or (function (car input-list))
- (satisfies-function? function (cdr input-list)))))
-
(define (true-entry? input-list)
"Is there a true entry in @code{input-list}?"
- (satisfies-function? identity input-list))
+ (any identity input-list))
(define (entry-greater-than-x? input-list x)
"Is there an entry greater than @code{x} in @code{input-list}?"
- (satisfies-function? (lambda (y) (> y x)) input-list))
+ (any (lambda (y) (> y x)) input-list))
(define (n-true-entries input-list)
"Returns number of true entries in @code{input-list}."
- (reduce + 0 (map (lambda (x) (if x 1 0)) input-list)))
+ (count identity input-list))
(define (bezier-head-for-stencil bezier cut-point)
"Prepares a split-bezier to be used in a connected path stencil."
;; Translators for keys
-; Translates a "normal" key (open, closed, trill)
+;; Translates a "normal" key (open, closed, trill)
(define (key-fill-translate fill)
(cond
((= fill 1) #f)
((= fill (expt (assoc-get 'F HOLE-FILL-LIST) 2)) 0.5)
((= fill (assoc-get 'F HOLE-FILL-LIST)) #t)))
-; Similar to above, but trans vs opaque doesn't matter
+;; Similar to above, but trans vs opaque doesn't matter
(define (text-fill-translate fill)
(cond
((< fill 3) 1.0)
((= fill (expt (assoc-get 'F HOLE-FILL-LIST) 2)) 0.5)
((= fill (assoc-get 'F HOLE-FILL-LIST)) 0.0)))
-; Emits a list for the central-column-hole maker
-; (not-full?, 1-quarter-full?, 1-half-full?, 3-quarters-full?, full?)
-; Multiple values, such as (#t #f #f #t #f), mean a trill between
-; not-full and 3-quarters-full
+;; Emits a list for the central-column-hole maker
+;; (not-full?, 1-quarter-full?, 1-half-full?, 3-quarters-full?, full?)
+;; Multiple values, such as (#t #f #f #t #f), mean a trill between
+;; not-full and 3-quarters-full
(define (process-fill-value fill)
(let* ((avals (list-tail (assoc-values HOLE-FILL-LIST) 1)))
(append `(,(or (< fill 3) (is-square? fill avals)))
(map (lambda (x) (= 0 (remainder fill x))) avals))))
-; Color a stencil gray
+;; Color a stencil gray
(define (gray-colorize stencil)
(apply ly:stencil-in-color (cons stencil (x11-color 'grey))))
-; A connected path stencil that is surrounded by proc
+;; A connected path stencil that is surrounded by proc
(define (rich-path-stencil ls x-stretch y-stretch proc)
(lambda (radius thick fill layout props)
(let*
layout
props))))))
-; A connected path stencil without a surrounding proc
+;; A connected path stencil without a surrounding proc
(define (standard-path-stencil ls x-stretch y-stretch)
(rich-path-stencil ls x-stretch y-stretch identity))
-; An ellipse stencil that is surrounded by a proc
+;; An ellipse stencil that is surrounded by a proc
(define (rich-pe-stencil x-stretch y-stretch start end proc)
(lambda (radius thick fill layout props)
(let*
layout
props))))))
-; An ellipse stencil without a surrounding proc
+;; An ellipse stencil without a surrounding proc
(define (standard-e-stencil x-stretch y-stretch)
(rich-e-stencil x-stretch y-stretch identity))
-; Translates all possible representations of symbol.
-; If simple? then the only representations are open, closed, and trill.
-; Otherwise, there can be various levels of "closure" on the holes
-; ring? allows for a ring around the holes as well
+;; Translates all possible representations of symbol.
+;; If simple? then the only representations are open, closed, and trill.
+;; Otherwise, there can be various levels of "closure" on the holes
+;; ring? allows for a ring around the holes as well
(define (make-symbol-alist symbol simple? ring?)
(filter (lambda (x)
(not
;;; Commands for text layout
-; Draws a circle around markup if (= trigger 0.5)
+;; Draws a circle around markup if (= trigger 0.5)
(define-markup-command
(conditional-circle-markup layout props trigger in-markup)
(number? markup?)
(markup #:circle (markup in-markup))
(markup in-markup))))
-; Makes a list of named-keys
+;; Makes a list of named-keys
(define (make-name-keylist input-list key-list font-size)
(map (lambda (x y)
(if (< x 1)
(markup #:null)))
input-list key-list))
-; Makes a list of number-keys
+;; Makes a list of number-keys
(define (make-number-keylist input-list key-list font-size)
(map (lambda (x y)
(if (< x 1)
input-list
key-list))
-; Creates a named-key list with a certain alignment
+;; Creates a named-key list with a certain alignment
(define (aligned-text-stencil-function dir hv)
(lambda (key-name-list radius fill-list layout props)
(interpret-markup
key-name-list
(* radius 8)))))))))
-; Utility function for the left-hand keys
+;; Utility function for the left-hand keys
(define lh-woodwind-text-stencil
(aligned-text-stencil-function LEFT #t))
-; Utility function for the right-hand keys
+;; Utility function for the right-hand keys
(define rh-woodwind-text-stencil
(aligned-text-stencil-function RIGHT #t))
;;; General drawing commands
-; Used all the time for a dividing line
+;; Used all the time for a dividing line
(define (midline-stencil radius thick fill layout props)
(make-line-stencil (* thick 2) (* -0.80 radius) 0 (* 0.80 radius) 0))
(define (long-midline-stencil radius thick fill layout props)
(make-line-stencil (* thick 2) (* -5.75 radius) 0 (* 0.75 radius) 0))
-; Used all the time for a small, between-hole key
+;; Used all the time for a small, between-hole key
(define little-elliptical-key-stencil (standard-e-stencil 0.75 0.2))
-; Used for several upper keys in the clarinet and sax
+;; Used for several upper keys in the clarinet and sax
(define (upper-key-stencil tailw tailh bodyw bodyh)
(let*
((xmove (lambda (x) (+ tailw (+ 0.2 (* bodyw (- x 0.2))))))
1.0
1.0)))
-; Utility function for the column-hole maker.
-; Returns the left and right degrees for the drawing of a given
-; fill level (1-quarter, 1-half, etc...)
+;; Utility function for the column-hole maker.
+;; Returns the left and right degrees for the drawing of a given
+;; fill level (1-quarter, 1-half, etc...)
(define (degree-first-true fill-list left? reverse?)
(define (dfl-crawler fill-list os-list left?)
(if (car fill-list)
'((0 . 0) (215 . 325) (180 . 0) (145 . 35) (90 . 90)))
left?))
-; Gets the position of the first (or last if reverse?) element of a list.
+;; Gets the position of the first (or last if reverse?) element of a list.
(define (position-true-endpoint in-list reverse?)
(define (pte-crawler in-list n)
(if (car in-list)
(if reverse? (length in-list) 0)
(pte-crawler ((if reverse? reverse identity) in-list) 0)))
-; Huge, kind-of-ugly maker of a circle in a column.
-; I think this is the clearest way to write it, though...
+;; Huge, kind-of-ugly maker of a circle in a column.
+;; I think this is the clearest way to write it, though...
(define (column-circle-stencil radius thick fill layout props)
(let* ((fill-list (process-fill-value fill)))
(lambda (radius thick fill layout props)
(column-circle-stencil (* radius scaler) thick fill layout props)))
-; A stencil for ring-column circles that combines two of the above
+;; A stencil for ring-column circles that combines two of the above
(define (ring-column-circle-stencil radius thick fill layout props)
(if (= 0 (remainder fill (assoc-get 'R HOLE-FILL-LIST)))
(ly:stencil-add
(define clarinet-rh-b-key-stencil little-elliptical-key-stencil)
-; cl low-rh values
+;; cl low-rh values
(define CL-RH-HAIR 0.09)
(define CL-RH-H-STRETCH 2.7)
(define CL-RH-V-STRETCH 0.9)
-; TODO
-; there is some unnecessary information duplication here.
-; need a way to control all of the below stencils so that if one
-; changes, all change...
+;; TODO
+;; there is some unnecessary information duplication here.
+;; need a way to control all of the below stencils so that if one
+;; changes, all change...
(define clarinet-rh-fis-key-stencil
(standard-path-stencil
CL-RH-H-STRETCH
CL-RH-V-STRETCH))
-(define clarinet-rh-e-key-stencil
+(define clarinet-rh-gis-key-stencil
(standard-path-stencil
'((0.0 1.0 1.0 1.0 1.0 0.0) (1.0 -1.0 0.0 -1.0 0.0 0.0))
CL-RH-H-STRETCH
CL-RH-V-STRETCH))
-(define clarinet-rh-ees-key-stencil
+(define clarinet-rh-e-key-stencil
(standard-path-stencil
`(,(bezier-head-for-stencil
'((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0))
CL-RH-H-STRETCH
CL-RH-V-STRETCH))
-(define clarinet-rh-gis-key-stencil clarinet-rh-e-key-stencil)
+(define clarinet-rh-f-key-stencil clarinet-rh-gis-key-stencil)
-(define bass-clarinet-rh-f-key-stencil
+(define bass-clarinet-rh-ees-key-stencil
(standard-path-stencil
`(,(bezier-head-for-stencil
'((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0))
CL-RH-H-STRETCH
(- CL-RH-V-STRETCH)))
-(define low-bass-clarinet-rh-f-key-stencil clarinet-rh-ees-key-stencil)
+(define low-bass-clarinet-rh-ees-key-stencil clarinet-rh-e-key-stencil)
-(define clarinet-rh-d-key-stencil clarinet-rh-e-key-stencil)
+(define clarinet-rh-d-key-stencil clarinet-rh-gis-key-stencil)
;;; Saxophone family stencils
projects / lilypond.git / blobdiff