;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
((= log -1) 1)
(else 0))))
-;; silly, use alist?
+;; Kept separate from note-head::calc-glyph-name to allow use by
+;; markup commands \note and \note-by-number
+(define-public (select-head-glyph style log)
+ "Select a note head glyph string based on note head style @var{style}
+and duration-log @var{log}."
+ (case style
+ ;; "default" style is directly handled in note-head.cc as a
+ ;; special case (HW says, mainly for performance reasons).
+ ;; Therefore, style "default" does not appear in this case
+ ;; statement. -- jr
+ ((xcircle) "2xcircle")
+ ((harmonic) "0harmonic")
+ ((harmonic-black) "2harmonic")
+ ((harmonic-mixed) (if (<= log 1) "0harmonic"
+ "2harmonic"))
+ ((baroque)
+ ;; Oops, I actually would not call this "baroque", but, for
+ ;; backwards compatibility to 1.4, this is supposed to take
+ ;; brevis, longa and maxima from the neo-mensural font and all
+ ;; other note heads from the default font. -- jr
+ (if (< log 0)
+ (string-append (number->string log) "neomensural")
+ (number->string log)))
+ ((altdefault)
+ ;; Like default, but brevis is drawn with double vertical lines
+ (if (= log -1)
+ (string-append (number->string log) "double")
+ (number->string log)))
+ ((mensural)
+ (string-append (number->string log) (symbol->string style)))
+ ((petrucci)
+ (if (< log 0)
+ (string-append (number->string log) "mensural")
+ (string-append (number->string log) (symbol->string style))))
+ ((neomensural)
+ (string-append (number->string log) (symbol->string style)))
+ (else
+ (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
+ (symbol->string style)
+ (string-append (number->string (max 0 log))
+ (symbol->string style))))))
+
(define-public (note-head::calc-glyph-name grob)
(let ((style (ly:grob-property grob 'style))
(log (min 2 (ly:grob-property grob 'duration-log))))
- (case style
- ;; "default" style is directly handled in note-head.cc as a
- ;; special case (HW says, mainly for performance reasons).
- ;; Therefore, style "default" does not appear in this case
- ;; statement. -- jr
- ((xcircle) "2xcircle")
- ((harmonic) "0harmonic")
- ((harmonic-black) "2harmonic")
- ((harmonic-mixed) (if (<= log 1) "0harmonic"
- "2harmonic"))
- ((baroque)
- ;; Oops, I actually would not call this "baroque", but, for
- ;; backwards compatibility to 1.4, this is supposed to take
- ;; brevis, longa and maxima from the neo-mensural font and all
- ;; other note heads from the default font. -- jr
- (if (< log 0)
- (string-append (number->string log) "neomensural")
- (number->string log)))
- ((altdefault)
- ;; Like default, but brevis is drawn with double vertical lines
- (if (= log -1)
- (string-append (number->string log) "double")
- (number->string log)))
- ((mensural)
- (string-append (number->string log) (symbol->string style)))
- ((petrucci)
- (if (< log 0)
- (string-append (number->string log) "mensural")
- (string-append (number->string log) (symbol->string style))))
- ((neomensural)
- (string-append (number->string log) (symbol->string style)))
- (else
- (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
- (symbol->string style)
- (string-append (number->string (max 0 log))
- (symbol->string style)))))))
+ (select-head-glyph style log)))
(define-public (note-head::brew-ez-stencil grob)
(let* ((log (ly:grob-property grob 'duration-log))
(pitch (ly:event-property (event-cause grob) 'pitch))
(pitch-index (ly:pitch-notename pitch))
(note-names (ly:grob-property grob 'note-names))
- (pitch-string (if (vector? note-names)
+ (pitch-string (if (and (vector? note-names)
+ (> (vector-length note-names) pitch-index))
(vector-ref note-names pitch-index)
(string
(integer->char
letter)))
radius X)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; clipping
+
+(define-public (make-rhythmic-location bar-num num den)
+ (cons
+ bar-num (ly:make-moment num den)))
+
+(define-public (rhythmic-location? a)
+ (and (pair? a)
+ (integer? (car a))
+ (ly:moment? (cdr a))))
+
+(define-public (make-graceless-rhythmic-location loc)
+ (make-rhythmic-location
+ (car loc)
+ (ly:moment-main-numerator (rhythmic-location-measure-position loc))
+ (ly:moment-main-denominator (rhythmic-location-measure-position loc))))
+
+(define-public rhythmic-location-measure-position cdr)
+(define-public rhythmic-location-bar-number car)
+
+(define-public (rhythmic-location<? a b)
+ (cond
+ ((< (car a) (car b)) #t)
+ ((> (car a) (car b)) #f)
+ (else
+ (ly:moment<? (cdr a) (cdr b)))))
+
+(define-public (rhythmic-location<=? a b)
+ (not (rhythmic-location<? b a)))
+(define-public (rhythmic-location>=? a b)
+ (rhythmic-location<? a b))
+(define-public (rhythmic-location>? a b)
+ (rhythmic-location<? b a))
+
+(define-public (rhythmic-location=? a b)
+ (and (rhythmic-location<=? a b)
+ (rhythmic-location<=? b a)))
+
+(define-public (rhythmic-location->file-string a)
+ (ly:format "~a.~a.~a"
+ (car a)
+ (ly:moment-main-numerator (cdr a))
+ (ly:moment-main-denominator (cdr a))))
+
+(define-public (rhythmic-location->string a)
+ (ly:format "bar ~a ~a"
+ (car a)
+ (ly:moment->string (cdr a))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; break visibility
(define-public center-visible #(#f #t #f))
(define-public end-of-line-visible #(#t #f #f))
(define-public all-invisible #(#f #f #f))
+(define-public (inherit-x-parent-visibility grob)
+ (let ((parent (ly:grob-parent grob X)))
+ (ly:grob-property parent 'break-visibility all-invisible)))
+
(define-public spanbar-begin-of-line-invisible #(#t #f #f))
("'" . ("'" . ()))
("empty" . (() . ()))
("brace" . (() . "brace"))
- ("bracket" . (() . "bracket"))))
+ ("bracket" . (() . "bracket"))
+
+ ;; segno bar lines
+ ("S" . ("||" . "S"))
+ ("|S" . ("|" . "S"))
+ ("S|" . ("S" . ()))
+ (":|S" . (":|" . "S"))
+ (":|S." . (":|S" . ()))
+ ("S|:" . ("S" . "|:"))
+ (".S|:" . ("|" . "S|:"))
+ (":|S|:" . (":|" . "S|:"))
+ (":|S.|:" . (":|S" . "|:"))))
(define-public (bar-line::calc-glyph-name grob)
(let* ((glyph (ly:grob-property grob 'glyph))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Color
-(define-public color? list?)
+(define-public (color? x)
+ (and (list? x)
+ (= 3 (length x))
+ (apply eq? #t (map number? x))
+ (apply eq? #t (map (lambda (y) (<= 0 y 1)) x))))
+
(define-public (rgb-color r g b) (list r g b))
; predefined colors
(list lp rp)))
(define-public (parentheses-item::calc-angled-bracket-stencils grob)
- (let* ((font (ly:grob-default-font grob))
- (lp (ly:stencil-aligned-to (ly:stencil-aligned-to
- (grob-interpret-markup
- grob
- (ly:wide-char->utf-8 #x2329))
- Y CENTER)
- X RIGHT))
- (rp (ly:stencil-aligned-to (ly:stencil-aligned-to
- (grob-interpret-markup
- grob
- (ly:wide-char->utf-8 #x232A))
- Y CENTER)
- X LEFT)))
-
+ (let* ((parent (ly:grob-parent grob Y))
+ (y-extent (ly:grob-extent parent parent Y))
+ (half-thickness 0.05) ; should it be a property?
+ (width 0.5) ; should it be a property?
+ (angularity 1.5) ; makes angle brackets
+ (white-padding 0.1) ; should it be a property?
+ (lp (ly:stencil-aligned-to
+ (ly:stencil-aligned-to
+ (make-parenthesis-stencil y-extent
+ half-thickness
+ (- width)
+ angularity)
+ Y CENTER)
+ X RIGHT))
+ (lp-x-extent
+ (interval-widen (ly:stencil-extent lp X) white-padding))
+ (rp (ly:stencil-aligned-to
+ (ly:stencil-aligned-to
+ (make-parenthesis-stencil y-extent
+ half-thickness
+ width
+ angularity)
+ Y CENTER)
+ X LEFT))
+ (rp-x-extent
+ (interval-widen (ly:stencil-extent rp X) white-padding)))
+ (set! lp (ly:make-stencil (ly:stencil-expr lp)
+ lp-x-extent
+ (ly:stencil-extent lp Y)))
+ (set! rp (ly:make-stencil (ly:stencil-expr rp)
+ rp-x-extent
+ (ly:stencil-extent rp Y)))
(list (stencil-whiteout lp)
- (stencil-whiteout rp))))
+ (stencil-whiteout rp))))
(define (parenthesize-elements grob . rest)
(let* ((refp (if (null? rest)
START
STOP))
+(define-public (dynamic-text-spanner::before-line-breaking grob)
+ "Monitor left bound of @code{DynamicTextSpanner} for absolute dynamics.
+If found, ensure @code{DynamicText} does not collide with spanner text by
+changing @code{'attach-dir} and @code{'padding}. Reads the
+@code{'right-padding} property of @code{DynamicText} to fine tune space
+between the two text elements."
+ (let ((left-bound (ly:spanner-bound grob LEFT)))
+ (if (grob::has-interface left-bound 'dynamic-text-interface)
+ (let* ((details (ly:grob-property grob 'bound-details))
+ (left-details (ly:assoc-get 'left details))
+ (my-padding (ly:assoc-get 'padding left-details))
+ (script-padding (ly:grob-property left-bound 'right-padding 0)))
+
+ (and (number? my-padding)
+ (ly:grob-set-nested-property! grob
+ '(bound-details left attach-dir)
+ RIGHT)
+ (ly:grob-set-nested-property! grob
+ '(bound-details left padding)
+ (+ my-padding script-padding)))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lyrics
(define-public (system-start-text::calc-y-offset grob)
(define (live-elements-list me)
- (let* ((elements (ly:grob-object me 'elements))
- (elts-length (ly:grob-array-length elements))
- (live-elements '()))
-
- (let get-live ((len elts-length))
- (if (> len 0)
- (let ((elt (ly:grob-array-ref elements (1- len))))
+ (let ((elements (ly:grob-object me 'elements)))
- (if (grob::is-live? elt)
- (set! live-elements (cons elt live-elements)))
- (get-live (1- len)))))
- live-elements))
+ (filter! grob::is-live?
+ (ly:grob-array->list elements))))
(let* ((left-bound (ly:spanner-bound grob LEFT))
(live-elts (live-elements-list grob))
(begin
(ly:grob-suicide! grob)
(list)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; laissez-vibrer tie
+;;
+;; needed so we can make laissez-vibrer a pure print
+;;
+(define-public (laissez-vibrer::print grob)
+ (ly:tie::print grob))
+
projects / lilypond.git / blobdiff