;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-; for define-safe-public when byte-compiling using Guile V2
+;; for define-safe-public when byte-compiling using Guile V2
(use-modules (scm safe-utility-defs))
(define-public (construct-chord-elements root duration modifications)
(map (lambda (n)
(define (nca x)
(if (= x 7) FLAT 0))
-
+
(if (>= n 8)
(ly:make-pitch 1 (- n 8) (nca n))
(ly:make-pitch 0 (- n 1) (nca n))))
frets in tablature.")
- (glissandoMap ,list? "A map in the form of '((source1 . target1)
-(source2 . target2) (sourcen . targetn)) showing the glissandi to
-be drawn for note columns. The value '() will default to '((0 . 0)
-(1 . 1) (n . n)), where n is the minimal number of note-heads in
+ (glissandoMap ,list? "A map in the form of
+'((source1 . target1) (source2 . target2) (sourcen . targetn))
+showing the glissandi to be drawn for note columns.
+The value '() will default to
+'((0 . 0) (1 . 1) (n . n)),
+where n is the minimal number of note-heads in
the two note columns between which the glissandi occur.")
(gridInterval ,ly:moment? "Interval for which to generate
@code{GridPoint}s.")
interfaces that are worth keeping a staff with @code{remove-empty} set
around for.")
(keyAlterationOrder ,list? "An alist that defines in what order
-alterations should be printed. The format is @code{(@var{step}
-. @var{alter})}, where @var{step} is a number from 0 to@tie{}6 and
+alterations should be printed. The format is
+@code{(@var{step} . @var{alter})},
+where @var{step} is a number from 0 to@tie{}6 and
@var{alter} from -2 (sharp) to 2 (flat).")
(keySignature ,list? "The current key signature. This is an alist
-containing @code{(@var{step} . @var{alter})} or @code{((@var{octave} .
-@var{step}) . @var{alter})}, where @var{step} is a number in the range
-0 to@tie{}6 and @var{alter} a fraction, denoting alteration. For
-alterations, use symbols, e.g. @code{keySignature = #`((6 . ,FLAT))}.")
+containing @code{(@var{step} . @var{alter})} or
+@code{((@var{octave} . @var{step}) . @var{alter})}, where @var{step}
+is a number in the range 0 to@tie{}6 and @var{alter} a fraction,
+denoting alteration. For alterations, use symbols, e.g.
+@code{keySignature = #`((6 . ,FLAT))}.")
(lyricMelismaAlignment ,number? "Alignment to use for a melisma syllable.")
(define event-classes
'((() . (StreamEvent))
(StreamEvent .
- (RemoveContext ChangeParent Override Revert UnsetProperty
- SetProperty music-event OldMusicEvent CreateContext Prepare
- OneTimeStep Finish))
- (music-event . (annotate-output-event footnote-event
- arpeggio-event breathing-event extender-event span-event
- rhythmic-event dynamic-event break-event label-event percent-event
- key-change-event string-number-event stroke-finger-event tie-event
- part-combine-event part-combine-force-event
- beam-forbid-event script-event tempo-change-event
- tremolo-event bend-after-event fingering-event glissando-event
- harmonic-event hyphen-event laissez-vibrer-event mark-event
- multi-measure-text-event note-grouping-event
- pes-or-flexa-event repeat-tie-event spacing-section-event
- layout-instruction-event completize-extender-event break-span-event
- alternative-event))
+ (RemoveContext
+ ChangeParent Override Revert UnsetProperty SetProperty
+ music-event OldMusicEvent CreateContext Prepare
+ OneTimeStep Finish))
+ (music-event . (annotate-output-event
+ footnote-event arpeggio-event breathing-event
+ extender-event span-event rhythmic-event dynamic-event
+ break-event label-event percent-event key-change-event
+ string-number-event stroke-finger-event tie-event
+ part-combine-event part-combine-force-event
+ beam-forbid-event script-event tempo-change-event
+ tremolo-event bend-after-event fingering-event
+ glissando-event harmonic-event hyphen-event
+ laissez-vibrer-event mark-event multi-measure-text-event
+ note-grouping-event pes-or-flexa-event repeat-tie-event
+ spacing-section-event layout-instruction-event
+ completize-extender-event break-span-event alternative-event))
(layout-instruction-event . (apply-output-event))
(script-event . (articulation-event text-script-event))
(part-combine-event . (solo-one-event solo-two-event unisono-event))
(break-event . (line-break-event page-break-event page-turn-event))
(dynamic-event . (absolute-dynamic-event))
- (span-event . (span-dynamic-event beam-event episema-event ligature-event
- measure-counter-event pedal-event
- phrasing-slur-event slur-event
- staff-span-event text-span-event
- trill-span-event tremolo-span-event
- tuplet-span-event))
+ (span-event . (span-dynamic-event
+ beam-event episema-event ligature-event
+ measure-counter-event pedal-event
+ phrasing-slur-event slur-event
+ staff-span-event text-span-event
+ trill-span-event tremolo-span-event
+ tuplet-span-event))
(span-dynamic-event . (decrescendo-event crescendo-event))
(break-span-event . (break-dynamic-span-event))
(pedal-event . (sostenuto-event sustain-event una-corda-event))
- (rhythmic-event . (lyric-event melodic-event multi-measure-rest-event
- double-percent-event percent-event
- repeat-slash-event rest-event
- skip-event bass-figure-event))
+ (rhythmic-event . (lyric-event
+ melodic-event multi-measure-rest-event
+ double-percent-event percent-event
+ repeat-slash-event rest-event
+ skip-event bass-figure-event))
(melodic-event . (cluster-note-event note-event))
(() . (Announcement))
(Announcement . (AnnounceNewContext))
(ly:add-interface
'ambitus-interface
"The line between note heads for a pitch range."
- '(gap note-heads thickness))
+ '(gap
+ note-heads
+ thickness))
(ly:add-interface
'bar-line-interface
found in @file{scm/bar-line.scm}.
@code{gap} is used for the gaps in dashed bar lines."
- '(allow-span-bar bar-extent gap glyph glyph-name has-span-bar
- hair-thickness kern rounded thin-kern thick-thickness))
+ '(allow-span-bar
+ bar-extent
+ gap
+ glyph
+ glyph-name
+ hair-thickness
+ has-span-bar
+ kern
+ rounded
+ thin-kern
+ thick-thickness))
(ly:add-interface
'bass-figure-interface
(ly:add-interface
'bend-after-interface
"A doit or drop."
- '(thickness delta-position))
+ '(delta-position
+ thickness))
(ly:add-interface
'clef-modifier-interface
(ly:add-interface
'footnote-spanner-interface
"Make a footnote spanner."
- '(footnote-text spanner-placement))
+ '(footnote-text
+ spanner-placement))
(ly:add-interface
'fret-diagram-interface
"A fret diagram"
- '(align-dir fret-diagram-details size dot-placement-list
+ '(align-dir
+ dot-placement-list
+ fret-diagram-details
+ size
thickness))
(ly:add-interface
(ly:add-interface
'grace-spacing-interface
"Keep track of durations in a run of grace notes."
- '(columns common-shortest-duration))
+ '(columns
+ common-shortest-duration))
(ly:add-interface
'inline-accidental-interface
(ly:add-interface
'measure-counter-interface
"A counter for numbering measures."
- '(columns count-from))
+ '(columns
+ count-from))
(ly:add-interface
'metronome-mark-interface
(ly:add-interface
'parentheses-interface
"Parentheses for other objects."
- '(padding stencils))
+ '(padding
+ stencils))
(ly:add-interface
'percent-repeat-interface
"Beat, Double and single measure repeats."
- '(dot-negative-kern slash-negative-kern slope thickness))
+ '(dot-negative-kern
+ slash-negative-kern
+ slope
+ thickness))
(ly:add-interface
'piano-pedal-interface
(ly:add-interface
'spacing-options-interface
"Supports setting of spacing variables."
- '(spacing-increment shortest-duration-space))
+ '(spacing-increment
+ shortest-duration-space))
(ly:add-interface
'span-bar-interface
"A bar line that is spanned between other barlines.
This interface is used for bar lines that connect different
staves."
- '(glyph-name elements pure-Y-common pure-relevant-grobs
- pure-relevant-items pure-relevant-spanners))
+ '(glyph-name
+ elements
+ pure-Y-common
+ pure-relevant-grobs
+ pure-relevant-items
+ pure-relevant-spanners))
(ly:add-interface
'stanza-number-interface
(ly:add-interface
'system-start-text-interface
"Text in front of the system."
- '(long-text self-alignment-X self-alignment-Y text))
+ '(long-text
+ self-alignment-X
+ self-alignment-Y
+ text))
(ly:add-interface
'tab-note-head-interface
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-; for define-safe-public when byte-compiling using Guile V2
+;; for define-safe-public when byte-compiling using Guile V2
(use-modules (scm safe-utility-defs))
;; TODO: should link back into user manual.
;; 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
;; Assembly functions
-; Scans a bank for name.
-; for example, '(left-hand . bes) will return bes in the left-hand
-; of a given bank
+;; Scans a bank for name.
+;; for example, '(left-hand . bes) will return bes in the left-hand
+;; of a given bank
(define (get-key name bank)
(assoc-get (cdr name) (assoc-get (car name) bank)))
"@var{" (car x) "} (" (cadr x) ")" ))
(zip arg-names sig-type-names))
" " )))
-
+
(string-append
"\n\n@item @code{\\" c-name "} " signature-str
"\n@funindex \\" c-name "\n"
- "\n@cindex \\" c-name "\n"
+ "\n@cindex \\" c-name "\n"
(if (string? doc-str)
doc-str
"")
(define (markup-function<? a b)
(ly:string-ci<? (symbol->string (procedure-name a)) (symbol->string (procedure-name b))))
-
+
(define (markup-category-doc-node category)
(let* ((category-string (symbol->string category))
- (category-name (string-capitalize (regexp-substitute/global #f
- "-" category-string 'pre " " 'post)))
+ (category-name (string-capitalize
+ (regexp-substitute/global
+ #f "-" category-string 'pre " " 'post)))
(markup-functions (hash-fold (lambda (markup-function dummy functions)
(cons markup-function functions))
'()
(dir (ly:grob-property stem-grob 'direction))
(stem-up (eqv? dir UP))
(layout (ly:grob-layout grob))
- ; scale with the note size (e.g. for grace notes)
+ ;; scale with the note size (e.g. for grace notes)
(factor (magstep (ly:grob-property grob 'font-size 0)))
(grob-stem-thickness (ly:grob-property stem-grob 'thickness))
(line-thickness (ly:output-def-lookup layout 'line-thickness))
(thickness-offset (cons 0 (* -1 thickness dir)))
(spacing (* -1 flag-spacing factor dir ))
(start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
- ; The points of a round-filled-polygon need to be given in clockwise
- ; order, otherwise the polygon will be enlarged by blot-size*2!
+ ;; The points of a round-filled-polygon need to be given in clockwise
+ ;; order, otherwise the polygon will be enlarged by blot-size*2!
(points (if stem-up (list start flag-end
(offset-add flag-end thickness-offset)
(offset-add start thickness-offset))
(offset-add flag-end thickness-offset)
flag-end)))
(stencil (ly:round-filled-polygon points half-stem-thickness))
- ; Log for 1/8 is 3, so we need to subtract 3
+ ;; Log for 1/8 is 3, so we need to subtract 3
(flag-stencil (buildflag stencil (- log 3) stencil spacing))
(stroke-style (ly:grob-property grob 'stroke-style)))
(if (equal? stroke-style "grace")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; NOTE: By default, lilypond uses the C++ method Flag::stencil
-; (ly:flag::stencil is the corresponding Scheme interface) to generate the
-; flag stencil. The following functions are simply a reimplementation in
-; Scheme, so that one has that functionality available in Scheme, if one
-; wants to write a flag style, which modifies one of the standard flags
-; by some stencil operations.
+;; NOTE: By default, lilypond uses the C++ method Flag::stencil
+;; (ly:flag::stencil is the corresponding Scheme interface) to generate the
+;; flag stencil. The following functions are simply a reimplementation in
+;; Scheme, so that one has that functionality available in Scheme, if one
+;; wants to write a flag style, which modifies one of the standard flags
+;; by some stencil operations.
(define-public (add-stroke-glyph stencil grob dir stroke-style flag-style)
flag stencil."
(if (not (string? stroke-style))
stencil
- ; Otherwise: look up the stroke glyph and combine it with the flag
+ ;; Otherwise: look up the stroke glyph and combine it with the flag
(let* ((stem-grob (ly:grob-parent grob X))
(font-char (string-append "flags." flag-style dir stroke-style))
(alt-font-char (string-append "flags." dir stroke-style))
Y)
d)
(/ 2 ss)))))
- ; For some reason the stem-end is a real instead of an integer...
+ ;; For some reason the stem-end is a real instead of an integer...
(dir-modifier (if (ly:position-on-line? stem-grob stem-end) "1" "0"))
(modifier (if adjust dir-modifier "2")))
(create-glyph-flag "mensural" modifier grob)))
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-;
-; Utility functions
-;
-;
+;; Utility functions
(define (string-x-extent start-point end-point)
"Return the x-extent of a string that goes from start-point
(helper key alist-list
(if (pair? default) (car default) #f)))
-;
-; Conversions between fret/string coordinate system and x-y coordinate
-; system.
-;
-; Fret coordinates are measured down the fretboard from the nut,
-; starting at 0.
-;
-; String coordinates are measured from the lowest string, starting at 0.
-;
-; The x-y origin is at the intersection of the nut and the lowest string.
-;
-; X coordinates are positive to the right.
-; Y coordinates are positive up.
-;
+;; Conversions between fret/string coordinate system and x-y coordinate
+;; system.
+;;
+;; Fret coordinates are measured down the fretboard from the nut,
+;; starting at 0.
+;;
+;; String coordinates are measured from the lowest string, starting at 0.
+;;
+;; The x-y origin is at the intersection of the nut and the lowest string.
+;;
+;; X coordinates are positive to the right.
+;; Y coordinates are positive up.
(define (negate-extent extent)
"Return the extent in an axis opposite to the axis of @code{extent}."
(negate-extent (ly:stencil-extent stencil X)))
(else
(negate-extent (ly:stencil-extent stencil Y))))
- ; else -- eq? fretboard-axis 'string
+ ;; else -- eq? fretboard-axis 'string
(cond ((eq? orientation 'landscape)
(ly:stencil-extent stencil Y))
((eq? orientation 'opposing-landscape)
(define (string-thickness string thickness-factor)
(expt (1+ thickness-factor) (1- string)))
-;
-; Functions that create stencils used in the fret diagram
-;
+;; Functions that create stencils used in the fret diagram
(define (sans-serif-stencil layout props mag text)
"Create a stencil in sans-serif font based on @var{layout} and @var{props}
(prepend-alist-chain 'font-family 'sans props))))
(interpret-markup layout my-props text)))
-;;
-;;
;; markup commands and associated functions
-;;
-;;
-;;
(define (fret-parse-marking-list marking-list my-fret-count)
"Parse a fret-diagram-verbose marking list into component sublists"
(let ((upfret (- (+ minfret my-fret-count) 1)))
(if (> maxfret upfret) maxfret upfret)))))
(set! capo-fret (1+ (- capo-fret minfret)))
- ; subtract fret from dots
+ ;; subtract fret from dots
(set! dot-list (subtract-base-fret (- (car fret-range) 1) dot-list)))
(acons 'fret-range fret-range
(acons 'barre-list barre-list
(define (make-fret-diagram layout props marking-list)
"Make a fret diagram markup"
(let* (
- ; note: here we get items from props that are needed in this routine,
- ; or that are needed in more than one of the procedures
- ; called from this routine. If they're only used in one of the
- ; sub-procedure, they're obtained in that procedure
+ ;; note: here we get items from props that are needed in this routine,
+ ;; or that are needed in more than one of the procedures
+ ;; called from this routine. If they're only used in one of the
+ ;; sub-procedure, they're obtained in that procedure
(size (chain-assoc-get 'size props 1.0)) ; needed for everything
- ;TODO -- get string-count directly from length of stringTunings;
- ; from FretBoard engraver, but not from markup call
+ ;;TODO -- get string-count directly from length of stringTunings;
+ ;; from FretBoard engraver, but not from markup call
(details (merge-details 'fret-diagram-details props '()))
(string-count
- (assoc-get 'string-count details 6)) ; needed for everything
+ (assoc-get 'string-count details 6)) ;; needed for everything
(my-fret-count
- (assoc-get 'fret-count details 4)) ; needed for everything
+ (assoc-get 'fret-count details 4)) ;; needed for everything
(orientation
- (assoc-get 'orientation details 'normal)) ; needed for everything
+ (assoc-get 'orientation details 'normal)) ;; needed for everything
(finger-code
(assoc-get
- 'finger-code details 'none)) ; needed for draw-dots and draw-barre
+ 'finger-code details 'none)) ;; needed for draw-dots and draw-barre
(default-dot-radius
- (if (eq? finger-code 'in-dot) 0.425 0.25)) ; bigger dots if labeled
+ (if (eq? finger-code 'in-dot) 0.425 0.25)) ;; bigger dots if labeled
(default-dot-position
(if (eq? finger-code 'in-dot)
(- 0.95 default-dot-radius)
0.6)) ; move up to make room for bigger dot if labeled
(dot-radius
(assoc-get
- 'dot-radius details default-dot-radius)) ; needed for draw-dots
- ; and draw-barre
+ 'dot-radius details default-dot-radius))
+ ;; needed for draw-dots and draw-barre
(dot-position
(assoc-get
- 'dot-position details default-dot-position)) ; needed for
- ; draw-dots and draw-barre
+ 'dot-position details default-dot-position))
+ ;; needed for draw-dots and draw-barre
(th
(* (ly:output-def-lookup layout 'line-thickness)
- (chain-assoc-get 'thickness props 0.5))) ; needed for draw-frets
- ; and draw-strings
+ (chain-assoc-get 'thickness props 0.5)))
+ ;; needed for draw-frets and draw-strings
(sth (* size th))
(thickness-factor (assoc-get 'string-thickness-factor details 0))
(alignment
- (chain-assoc-get 'align-dir props -0.4)) ; needed only here
- (xo-padding (assoc-get 'xo-padding details 0.2)) ; needed only here
+ (chain-assoc-get 'align-dir props -0.4)) ;; needed only here
+ (xo-padding (assoc-get 'xo-padding details 0.2)) ;; needed only here
(parameters (fret-parse-marking-list marking-list my-fret-count))
(capo-fret (assoc-get 'capo-fret parameters 0))
(dot-list (assoc-get 'dot-list parameters))
(barre-type
(assoc-get 'barre-type details 'curved))
(fret-diagram-stencil '()))
- ;
+
;; Here are the fret diagram helper functions that depend on the
;; fret diagram parameters. The functions are here because the
;; diagram parameters are part of the lexical scope here.
(right-lower-control-point
(stencil-coordinates
bottom-control-point-height cp-right-width)))
- ; order of bezier control points is:
- ; left cp low, right cp low, right end low, left end low
- ; right cp high, left cp high, left end high, right end high.
- ;
+
+ ;; order of bezier control points is:
+ ;; left cp low, right cp low, right end low, left end low
+ ;; right cp high, left cp high, left end high, right end high.
+
(list left-lower-control-point
right-lower-control-point
right-end-point
(- label-outside-diagram)
(+ (* size (1- string-count)) label-outside-diagram))))))
-
- ; Here is the body of make-fret-diagram
- ;
+ ;; Here is the body of make-fret-diagram
(set! fret-diagram-stencil
(ly:stencil-add (draw-strings) (draw-frets)))
(list 'open (string->number (car this-list)))
output-list)))))))
(parse-item (cdr myitems)))))
- ; add the modified details
+ ;; add the modified details
(set! props
(prepend-alist-chain 'fret-diagram-details details props))
`(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better
@var{props}, modified to include the string-count determined by the
definition-string, and
a fret-indication list with the appropriate values"
-;TODO -- change syntax to fret\string-finger
+;; TODO -- change syntax to fret\string-finger
(let* ((details (merge-details 'fret-diagram-details props '()))
(barre-start-list '())
The function also checks if the string has the typical form of three
pedals, then the divider and then the remaining four pedals. If not it
prints out a warning. However, in any case, it will also print each symbol
-in the order as given. This means you can place the divider (even multiple
-dividers) anywhere you want, but you'll have to live with the warnings.
+in the order as given. This means you can place the divider
+(even multiple dividers) anywhere you want, but you'll have to live with the warnings.
The appearance of the diagram can be tweaked inter alia using the size property
of the TextScript grob (@code{\\override Voice.TextScript #'size = #0.3}) for
the overall, the thickness property
(@code{\\override Voice.TextScript #'thickness = #3}) for the line thickness of
-the horizontal line and the divider. The remaining configuration (box sizes,
-offsets and spaces) is done by the harp-pedal-details list of properties
+the horizontal line and the divider. The remaining configuration
+(box sizes, offsets and spaces) is done by the harp-pedal-details list of properties
(@code{\\override Voice.TextScript #'harp-pedal-details #'box-width = #1}).
-It contains the following settings: @code{box-offset} (vertical shift of the
-box center for up/down pedals), @code{box-width}, @code{box-height},
-@code{space-before-divider} (the spacing between two boxes before the
-divider) and @code{space-after-divider} (box spacing after the divider).
+It contains the following settings: @code{box-offset}
+(vertical shift of the box center for up/down pedals),
+@code{box-width}, @code{box-height}, @code{space-before-divider}
+(the spacing between two boxes before the divider) and
+@code{space-after-divider} (box spacing after the divider).
@lilypond[verbatim,quote]
\\markup \\harp-pedal #\"^-v|--ov^\"
(stencil (make-filled-box-stencil
(box-x-dimensions prev-x p space)
(box-y-dimensions prev-x p space)))
- (pedal-stencil
- (if circled
- (oval-stencil stencil circle-thickness
+ (pedal-stencil
+ (if circled
+ (oval-stencil stencil circle-thickness
circle-x-padding circle-y-padding)
stencil))
(new-prev-x (+ prev-x space box-width)))
- (process-pedal (cdr remaining) new-prev-x
+ (process-pedal (cdr remaining) new-prev-x
(cons pedal-stencil stencils) #f space)))
((#\|) ; Divider line
(let* ((xpos (+ prev-x space))
(stencil (divider-stencil xpos))
(new-prev-x (+ prev-x space)))
- (process-pedal (cdr remaining) new-prev-x
- (cons stencil stencils)
+ (process-pedal (cdr remaining) new-prev-x
+ (cons stencil stencils)
circled spaceafterdivider)))
((#\o) ; Next pedal should be circled
(process-pedal (cdr remaining) prev-x stencils #t space))
(else
- (ly:warning "Unhandled entry in harp-pedal: ~a"
+ (ly:warning "Unhandled entry in harp-pedal: ~a"
(car remaining))
- (process-pedal (cdr remaining)
+ (process-pedal (cdr remaining)
prev-x stencils circled space))))))
(final-x (car result))
(stencils (cdr result)))
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
- ;
-; this is put into the slur-details property of Slur and PhrasingSlur
+
+;; this is put into the slur-details property of Slur and PhrasingSlur
(define default-slur-details
'((region-size . 4)
(head-encompass-penalty . 1000.0)
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-; for take, drop, take-while, list-index, and find-tail:
+;; for take, drop, take-while, list-index, and find-tail:
(use-modules (srfi srfi-1))
-; for define-safe-public when byte-compiling using Guile V2
+;; for define-safe-public when byte-compiling using Guile V2
(use-modules (scm safe-utility-defs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (scorify-music music parser)
"Preprocess @var{music}."
(ly:make-score
- (fold (lambda (f m) (f m parser))
+ (fold (lambda (f m) (f m parser))
music
toplevel-music-functions)))
;; be longer than 48 characters per line.
(anti-alias-factor 1
-"Render at higher resolution (using given factor)
-and scale down result to prevent jaggies in
+"Render at higher resolution
+(using given factor) and scale down result to prevent jaggies in
PNG images.")
- (aux-files #t
+ (aux-files
+ #t
"Create .tex, .texi, .count files in the
EPS backend.")
- (backend ps
+ (backend
+ ps
"Select backend. Possible values: 'eps, 'null,
'ps, 'scm, 'socket, 'svg.")
- (check-internal-types #f
+ (check-internal-types
+ #f
"Check every property assignment for types.")
- (clip-systems #f
+ (clip-systems
+ #f
"Generate cut-out snippets of a score.")
- (datadir #f
+ (datadir
+ #f
"LilyPond prefix for data files (read-only).")
- (debug-gc #f
+ (debug-gc
+ #f
"Dump memory debugging statistics.")
- (debug-gc-assert-parsed-dead #f
+ (debug-gc-assert-parsed-dead
+ #f
"For memory debugging: Ensure that all
references to parsed objects are dead. This is
an internal option, and is switched on
automatically for `-ddebug-gc'.")
- (debug-lexer #f
+ (debug-lexer
+ #f
"Debug the flex lexer.")
- (debug-page-breaking-scoring #f
+ (debug-page-breaking-scoring
+ #f
"Dump scores for many different page breaking
configurations.")
- (debug-parser #f
+ (debug-parser
+ #f
"Debug the bison parser.")
- (debug-property-callbacks #f
+ (debug-property-callbacks
+ #f
"Debug cyclic callback chains.")
- (debug-skylines #f
+ (debug-skylines
+ #f
"Debug skylines.")
- (delete-intermediate-files #t
+ (delete-intermediate-files
+ #t
"Delete unusable, intermediate PostScript files.")
- (dump-profile #f
+ (dump-profile
+ #f
"Dump memory and time information for each file.")
- (dump-cpu-profile #f
+ (dump-cpu-profile
+ #f
"Dump timing information (system-dependent).")
- (dump-signatures #f
+ (dump-signatures
+ #f
"Dump output signatures of each system. Used for
regression testing.")
- (eps-box-padding #f
+ (eps-box-padding
+ #f
"Pad left edge of the output EPS bounding box by
given amount (in mm).")
- (gs-load-fonts #f
+ (gs-load-fonts
+ #f
"Load fonts via Ghostscript.")
- (gs-load-lily-fonts #f
+ (gs-load-lily-fonts
+ #f
"Load only LilyPond fonts via Ghostscript.")
- (gui #f
+ (gui
+ #f
"Run LilyPond from a GUI and redirect stderr to
a log file.")
- (help #f
+ (help
+ #f
"Show this help.")
- (include-book-title-preview #t
+ (include-book-title-preview
+ #t
"Include book titles in preview images.")
- (include-eps-fonts #t
+ (include-eps-fonts
+ #t
"Include fonts in separate-system EPS files.")
- (include-settings #f
+ (include-settings
+ #f
"Include file for global settings, included before the score is processed.")
- (job-count #f
+ (job-count
+ #f
"Process in parallel, using the given number of
jobs.")
- (log-file #f
+ (log-file
+ #f
"If string FOO is given as argument, redirect
output to log file `FOO.log'.")
- (max-markup-depth 1024
+ (max-markup-depth
+ 1024
"Maximum depth for the markup tree. If a markup has more levels,
assume it will not terminate on its own, print a warning and return a
null markup instead.")
"midi")
"Set the default file extension for MIDI output
file to given string.")
- (music-strings-to-paths #f
+ (music-strings-to-paths
+ #f
"Convert text strings to paths when glyphs belong
to a music font.")
- (point-and-click #t
+ (point-and-click
+ #t
"Add point & click links to PDF output.")
- (paper-size "a4"
+ (paper-size
+ "a4"
"Set default paper size.")
- (pixmap-format "png16m"
+ (pixmap-format
+ "png16m"
"Set GhostScript's output format for pixel images.")
- (preview #f
+ (preview
+ #f
"Create preview images also.")
- (print-pages #t
+ (print-pages
+ #t
"Print pages in the normal way.")
- (protected-scheme-parsing #t
+ (protected-scheme-parsing
+ #t
"Continue when errors in inline scheme are caught
in the parser. If #f, halt on errors and print
a stack trace.")
- (profile-property-accesses #f
+ (profile-property-accesses
+ #f
"Keep statistics of get_property() calls.")
- (resolution 101
+ (resolution
+ 101
"Set resolution for generating PNG pixmaps to
given value (in dpi).")
- (read-file-list #f
+ (read-file-list
+ #f
"Specify name of a file which contains a list of
input files to be processed.")
- (relative-includes #f
+ (relative-includes
+ #f
"When processing an \\include command, look for
the included file relative to the current file
(instead of the root file)")
- (safe #f
+ (safe
+ #f
"Run in safer mode.")
- (separate-log-files #f
+ (separate-log-files
+ #f
"For input files `FILE1.ly', `FILE2.ly', ...
output log data to files `FILE1.log',
`FILE2.log', ...")
- (show-available-fonts #f
+ (show-available-fonts
+ #f
"List available font names.")
- (strict-infinity-checking #f
+ (strict-infinity-checking
+ #f
"Force a crash on encountering Inf and NaN
floating point exceptions.")
- (strip-output-dir #t
+ (strip-output-dir
+ #t
"Don't use directories from input files while
constructing output file names.")
- (svg-woff #f
+ (svg-woff
+ #f
"Use woff font files in SVG backend.")
- (trace-memory-frequency #f
+ (trace-memory-frequency
+ #f
"Record Scheme cell usage this many times per
second. Dump results to `FILE.stacks' and
`FILE.graph'.")
- (trace-scheme-coverage #f
+ (trace-scheme-coverage
+ #f
"Record coverage of Scheme files in `FILE.cov'.")
(verbose ,(ly:verbose-output?)
"Verbose output, i.e. loglevel at least DEBUG (read-only).")
- (warning-as-error #f
+ (warning-as-error
+ #f
"Change all warning and programming_error
messages into errors.")
))
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-; for define-safe-public when byte-compiling using Guile V2
+;; for define-safe-public when byte-compiling using Guile V2
(use-modules (scm safe-utility-defs))
(use-modules (ice-9 optargs))
(lambda ,pitches ,music)
(lambda ,pitches ,last-pitch))
'element ,music))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; The following functions are all associated with the crossStaff
-; function
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The following functions are all associated with the crossStaff
+;; function
(define (close-enough? x y)
"Values are close enough to ignore the difference"
(define ((stem-connectable? ref root) stem)
"Check if the stem is connectable to the root"
- ; The root is always connectable to itself
+ ;; The root is always connectable to itself
(or (eq? root stem)
(and
- ; Horizontal positions of the stems must be almost the same
+ ;; Horizontal positions of the stems must be almost the same
(close-enough? (car (ly:grob-extent root ref X))
(car (ly:grob-extent stem ref X)))
- ; The stem must be in the direction away from the root's notehead
+ ;; The stem must be in the direction away from the root's notehead
(positive? (* (ly:grob-property root 'direction)
(- (car (ly:grob-extent stem ref Y))
(car (ly:grob-extent root ref Y))))))))
(yextent (extent-combine yextents))
(layout (ly:grob-layout root))
(blot (ly:output-def-lookup layout 'blot-diameter)))
- ; Hide spanned stems
+ ;; Hide spanned stems
(map (lambda (st)
(set! (ly:grob-property st 'stencil) #f))
stems)
- ; Draw a nice looking stem with rounded corners
+ ;; Draw a nice looking stem with rounded corners
(ly:round-filled-box (ly:grob-extent root root X) yextent blot))
- ; Nothing to connect, don't draw the span
+ ;; Nothing to connect, don't draw the span
#f)))
(define ((make-stem-span! stems trans) root)
(let ((span (ly:engraver-make-grob trans 'Stem '())))
(ly:grob-set-parent! span X root)
(set! (ly:grob-object span 'stems) stems)
- ; Suppress positioning, the stem code is confused by this weird stem
+ ;; Suppress positioning, the stem code is confused by this weird stem
(set! (ly:grob-property span 'X-offset) 0)
(set! (ly:grob-property span 'stencil) stem-span-stencil)))
(define (make-stem-spans! ctx stems trans)
"Create stem spans for cross-staff stems"
- ; Cannot do extensive checks here, just make sure there are at least
- ; two stems at this musical moment
+ ;; Cannot do extensive checks here, just make sure there are at least
+ ;; two stems at this musical moment
(if (<= 2 (length stems))
(let ((roots (filter stem-is-root? stems)))
(map (make-stem-span! stems trans) roots))))
"Connect cross-staff stems to the stems above in the system"
(let ((stems '()))
(make-engraver
- ; Record all stems for the given moment
+ ;; Record all stems for the given moment
(acknowledgers
((stem-interface trans grob source)
(set! stems (cons grob stems))))
- ; Process stems and reset the stem list to empty
+ ;; Process stems and reset the stem list to empty
((process-acknowledged trans)
(make-stem-spans! ctx stems trans)
(set! stems '())))))
(siblings (ly:spanner-broken-into orig)) ; have we been split?
(bounds (ly:grob-array->list (ly:grob-object grob 'columns)))
(refp (ly:grob-system grob))
- ; we use the first and/or last NonMusicalPaperColumn grob(s) of
- ; a system in the event that a MeasureCounter spanner is broken
+ ;; we use the first and/or last NonMusicalPaperColumn grob(s) of
+ ;; a system in the event that a MeasureCounter spanner is broken
(all-cols (ly:grob-array->list (ly:grob-object refp 'columns)))
(all-cols
(filter
(let ((col (ly:context-property context 'currentCommandColumn))
(now (ly:context-property context 'measurePosition))
(current-bar (ly:context-property context 'currentBarNumber)))
- ; If the counter has been started, make sure we're in a new bar
- ; before finishing a count-spanner and starting a new one.
- ; Since we consider all CommandColumns encountered, we need this
- ; check so that a count-spanner is not created for each pair.
+ ;; If the counter has been started, make sure we're in a new bar
+ ;; before finishing a count-spanner and starting a new one.
+ ;; Since we consider all CommandColumns encountered, we need this
+ ;; check so that a count-spanner is not created for each pair.
(if (and (ly:grob? count-spanner)
(> current-bar last-measure-seen))
(set! new-measure? #t))
(if new-measure?
(begin
- ; Check if we have the first column of the measure.
- ; The possibility of initial grace notes is considered.
+ ;; Check if we have the first column of the measure.
+ ;; The possibility of initial grace notes is considered.
(if (moment<=? now ZERO-MOMENT)
(begin
- ; If we have the first column, finish the previous
- ; counter-spanner (if there is one).
+ ;; If we have the first column, finish the previous
+ ;; counter-spanner (if there is one).
(if (ly:grob? count-spanner)
(begin
(ly:spanner-set-bound! count-spanner RIGHT col)
(ly:pointer-group-interface::add-grob count-spanner 'columns col)
(ly:engraver-announce-end-grob trans count-spanner col)
(set! count-spanner '())))
- ; if count is over, reset variables
+ ;; if count is over, reset variables
(if stop?
(begin
(set! elapsed 0)
(set! stop? #f)))
- ; if count is in progress, begin a counter object
+ ;; if count is in progress, begin a counter object
(if go?
(let* ((c (ly:engraver-make-grob trans 'MeasureCounter col))
(counter (ly:grob-property c 'count-from)))
(and (ly:skyline-empty? (ly:skyline-pair::skyline skyp UP))
(ly:skyline-empty? (ly:skyline-pair::skyline skyp DOWN))))
-; checks if the pair is not null, and then if not empty
+;; checks if the pair is not null, and then if not empty
(define-public (skyline-pair-and-non-empty? skyp)
(and (ly:skyline-pair? skyp)
(not (skyline-pair::empty? skyp))))
;; The resulting base octave is sum of *base-octave* and
;; *base-octave-shift*. This is done to work around a Festival bug
;; causing Festival to segfault or produce invalid pitch on higher pitches.
-;(define *base-octave-shift* -2)
+;; (define *base-octave-shift* -2)
(define *base-octave-shift* (make-parameter 0))
;; The coeficient by which the notes just before \breath are shortened.
(yext (cons (min starty endy) (max starty endy))))
(ly:make-stencil
(list 'draw-line width startx starty endx endy)
- ; Since the line has rounded edges, we have to / can safely add half the
- ; width to all coordinates!
+ ;; Since the line has rounded edges, we have to / can safely add half the
+ ;; width to all coordinates!
(interval-widen xext (/ width 2))
(interval-widen yext (/ width 2)))))
thick
connect
fill)
- ; we know the extrema points by crawling through the
- ; list of possible extrema and finding the min and max
- ; for x and y
+ ;; we know the extrema points by crawling through the
+ ;; list of possible extrema and finding the min and max
+ ;; for x and y
(cons (min-max-crawler min cadr possible-extrema)
(min-max-crawler max cadr possible-extrema))
(cons (min-max-crawler min cddr possible-extrema)
(y-ext (ly:stencil-extent stencil Y))
(x-length (+ (interval-length x-ext) x-padding thickness))
(y-length (+ (interval-length y-ext) y-padding thickness))
- ;(aspect-ratio (/ x-length y-length))
+ ;; (aspect-ratio (/ x-length y-length))
(x-radius (* 0.707 x-length) )
(y-radius (* 0.707 y-length) )
- ;(diameter (max (- (cdr x-ext) (car x-ext))
- ; (- (cdr y-ext) (car y-ext))))
- ;(radius (+ (/ diameter 2) padding thickness))
+ ;; (diameter (max (- (cdr x-ext) (car x-ext))
+ ;; (- (cdr y-ext) (car y-ext))))
+ ;; radius (+ (/ diameter 2) padding thickness))
(ellipse (make-ellipse-stencil x-radius y-radius thickness #f)))
(ly:stencil-add
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!)
+ ;; 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"
EndEPSF
grestore
"))
- ; Stencil starts at (0,0), since we have shifted the eps, and its
- ; size is exactly the size of the scaled bounding box
+ ;; 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))))
projects / lilypond.git / commitdiff