]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/output-lib.scm
Issue 3983: Avoid define-public and define*-public with curried definitions
[lilypond.git] / scm / output-lib.scm
index a191d65ae7f9886d27f1d45734da67bada15f2e3..c607fe4122805ab0e3baa92539fc26c8f1ea3ac0 100644 (file)
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2014 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -562,34 +562,37 @@ and duration-log @var{log}."
 ;; a formatter function, which is simply a wrapper around an existing
 ;; tuplet formatter function. It takes the value returned by the given
 ;; function and appends a note of given length.
-(define-public ((tuplet-number::append-note-wrapper function note) grob)
+(define ((tuplet-number::append-note-wrapper function note) grob)
   (let ((txt (if function (function grob) #f)))
 
     (if txt
         (markup txt #:fontsize -5 #:note note UP)
         (markup #:fontsize -5 #:note note UP))))
+(export tuplet-number::append-note-wrapper)
 
 ;; Print a tuplet denominator with a different number than the one derived from
 ;; the actual tuplet fraction
-(define-public ((tuplet-number::non-default-tuplet-denominator-text denominator)
+(define ((tuplet-number::non-default-tuplet-denominator-text denominator)
                 grob)
   (number->string (if denominator
                       denominator
                       (ly:event-property (event-cause grob) 'denominator))))
+(export tuplet-number::non-default-tuplet-denominator-text)
 
 ;; Print a tuplet fraction with different numbers than the ones derived from
 ;; the actual tuplet fraction
-(define-public ((tuplet-number::non-default-tuplet-fraction-text
+(define ((tuplet-number::non-default-tuplet-fraction-text
                  denominator numerator) grob)
   (let* ((ev (event-cause grob))
          (den (if denominator denominator (ly:event-property ev 'denominator)))
          (num (if numerator numerator (ly:event-property ev 'numerator))))
 
     (format #f "~a:~a" den num)))
+(export tuplet-number::non-default-tuplet-fraction-text)
 
 ;; Print a tuplet fraction with note durations appended to the numerator and the
 ;; denominator
-(define-public ((tuplet-number::fraction-with-notes
+(define ((tuplet-number::fraction-with-notes
                  denominatornote numeratornote) grob)
   (let* ((ev (event-cause grob))
          (denominator (ly:event-property ev 'denominator))
@@ -597,10 +600,11 @@ and duration-log @var{log}."
 
     ((tuplet-number::non-default-fraction-with-notes
       denominator denominatornote numerator numeratornote) grob)))
+(export tuplet-number::fraction-with-notes)
 
 ;; Print a tuplet fraction with note durations appended to the numerator and the
 ;; denominator
-(define-public ((tuplet-number::non-default-fraction-with-notes
+(define ((tuplet-number::non-default-fraction-with-notes
                  denominator denominatornote numerator numeratornote) grob)
   (let* ((ev (event-cause grob))
          (den (if denominator denominator (ly:event-property ev 'denominator)))
@@ -612,6 +616,7 @@ and duration-log @var{log}."
                          (make-simple-markup " : ")
                          (make-simple-markup (format #f "~a" num))
                          (markup #:fontsize -5 #:note numeratornote UP)))))
+(export tuplet-number::non-default-fraction-with-notes)
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -620,12 +625,12 @@ and duration-log @var{log}."
 (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))))
+       (every number? x)
+       (every (lambda (y) (<= 0 y 1)) x)))
 
 (define-public (rgb-color r g b) (list r g b))
 
-                                        ; predefined colors
+;; predefined colors
 (define-public black       '(0.0 0.0 0.0))
 (define-public white       '(1.0 1.0 1.0))
 (define-public red         '(1.0 0.0 0.0))
@@ -673,6 +678,20 @@ and duration-log @var{log}."
                                     (prepend (+ x 7) (cons x l))))
           (prepend first-position '())))))
 
+(define-public (key-signature-interface::alteration-position
+                step alter c0-position)
+;; Deprecated.  Not a documented interface, and no longer used in LilyPond,
+;; but needed for a popular file, LilyJAZZ.ily for version 2.16
+  (if (pair? step)
+    (+ (cdr step) (* (car step) 7) c0-position)
+    (let* ((c-pos (modulo c0-position 7))
+           (hi (list-ref
+                 (if (< alter 0)
+                   '(2 3 4 2 1 2 1) ; position of highest flat
+                   '(4 5 4 2 3 2 3)); position of highest sharp
+                 c-pos)))
+      (- hi (modulo (- hi (+ c-pos step)) 7)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; annotations
 
@@ -854,6 +873,11 @@ and duration-log @var{log}."
    the previous calculated offset value."
   prev-offset)
 
+(define-public (scale-by-font-size x)
+  (ly:make-unpure-pure-container
+    (lambda (grob)
+      (* x (magstep (ly:grob-property grob 'font-size 0))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 
@@ -893,8 +917,8 @@ and duration-log @var{log}."
 
          (left-x (+ padding
                     (max
-                     (interval-end (ly:grob-robust-relative-extent
-                                    left-span common X))
+                     (interval-end (ly:generic-bound-extent
+                                    left-span common))
                      (if
                       (and dots
                            (close
@@ -904,7 +928,7 @@ and duration-log @var{log}."
                        (ly:grob-robust-relative-extent dots common X))
                       (- INFINITY-INT)))))
          (right-x (max (- (interval-start
-                           (ly:grob-robust-relative-extent right-span common X))
+                           (ly:generic-bound-extent right-span common))
                           padding)
                        (+ left-x minimum-length)))
          (self-x (ly:grob-relative-coordinate spanner common X))
@@ -1002,7 +1026,7 @@ between the two text elements."
                                              '(bound-details left padding)
                                              (+ my-padding script-padding)))))))
 
-(define-public ((elbowed-hairpin coords mirrored?) grob)
+(define ((elbowed-hairpin coords mirrored?) grob)
   "Create hairpin based on a list of @var{coords} in @code{(cons x y)}
 form.  @code{x} is the portion of the width consumed for a given line
 and @code{y} is the portion of the height.  For example,
@@ -1039,7 +1063,7 @@ and draws the stencil based on its coordinates.
      1.0
      #f
      #f))
-                                        ; outer let to trigger suicide
+  ;; outer let to trigger suicide
   (let ((sten (ly:hairpin::print grob)))
     (if (grob::is-live? grob)
         (let* ((decresc? (eq? (ly:grob-property grob 'grow-direction) LEFT))
@@ -1061,6 +1085,7 @@ and draws the stencil based on its coordinates.
             (if mirrored? (my-c-p-s downlist thick decresc?) empty-stencil))
            (cons xtrans ytrans)))
         '())))
+(export elbowed-hairpin)
 
 (define-public flared-hairpin
   (elbowed-hairpin '((0.95 . 0.4) (1.0 . 1.0)) #t))
@@ -1080,13 +1105,14 @@ and draws the stencil based on its coordinates.
                                     (make-tied-lyric-markup text)
                                     text))))
 
-(define-public ((grob::calc-property-by-copy prop) grob)
+(define ((grob::calc-property-by-copy prop) grob)
   (ly:event-property (event-cause grob) prop))
+(export grob::calc-property-by-copy)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; general inheritance
 
-(define-public ((grob::inherit-parent-property axis property . default) grob)
+(define ((grob::inherit-parent-property axis property . default) grob)
   "@var{grob} callback generator for inheriting a @var{property} from
 an @var{axis} parent, defaulting to @var{default} if there is no
 parent or the parent has no setting."
@@ -1096,6 +1122,7 @@ parent or the parent has no setting."
       (apply ly:grob-property parent property default))
      ((pair? default) (car default))
      (else '()))))
+(export grob::inherit-parent-property)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; fret boards
@@ -1241,6 +1268,31 @@ parent or the parent has no setting."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ambitus
 
+;; Calculate the gaps between ambitus heads and ends of ambitus line.
+;; Start by determining desired length of the ambitus line (based on
+;; length-fraction property), calc gap from that and make sure that
+;; it doesn't exceed maximum allowed value.
+
+(define-public (ambitus-line::calc-gap grob)
+  (let ((heads (ly:grob-object grob 'note-heads)))
+
+  (if (and (ly:grob-array? heads)
+             (= (ly:grob-array-length heads) 2))
+      (let* ((common (ly:grob-common-refpoint-of-array grob heads Y))
+              (head-down (ly:grob-array-ref heads 0))
+              (head-up (ly:grob-array-ref heads 1))
+              (fraction (ly:grob-property grob 'length-fraction 0.7))
+              (max-gap (ly:grob-property grob 'maximum-gap 0.45))
+              ;; distance between noteheads:
+              (distance (- (interval-start (ly:grob-extent head-up common Y))
+                          (interval-end (ly:grob-extent head-down common Y))))
+              (gap (* 0.5 distance (- 1 fraction))))
+
+         (min gap max-gap))
+      0)))
+
+;; Print a line connecting ambitus heads:
+
 (define-public (ambitus::print grob)
   (let ((heads (ly:grob-object grob 'note-heads)))
 
@@ -1249,13 +1301,15 @@ parent or the parent has no setting."
         (let* ((common (ly:grob-common-refpoint-of-array grob heads Y))
                (head-down (ly:grob-array-ref heads 0))
                (head-up (ly:grob-array-ref heads 1))
-               (gap (ly:grob-property grob 'gap 0.35))
+               ;; The value used when 'gap' property cannot be read is small
+               ;; to make sure that ambitus of a fifth will have a visible line.
+               (gap (ly:grob-property grob 'gap 0.25))
                (point-min (+ (interval-end (ly:grob-extent head-down common Y))
                              gap))
                (point-max (- (interval-start (ly:grob-extent head-up common Y))
                              gap)))
 
-          (if (< point-min point-max)
+          (if (< (+ point-min 0.1) point-max) ; don't print lines shorter than 0.1ss
               (let* ((layout (ly:grob-layout grob))
                      (line-thick (ly:output-def-lookup layout 'line-thickness))
                      (blot (ly:output-def-lookup layout 'blot-diameter))