1 ;;;; output-lib.scm -- implement Scheme output helper functions
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
6 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
8 ;;; Tablature functions, by Jiba (jiba@tuxfamily.org)
10 ;; The TabNoteHead stem attachment function.
11 (define (tablature-stem-attachment-function style duration)
14 ;; The TabNoteHead tablatureFormat callback.
15 ;; Compute the text grob-property
16 (define-public (fret-number-tablature-format string tuning pitch)
18 (- (ly:pitch-semitones pitch)
20 ;; remove 1 because list index starts at 0 and guitar string at 1.
23 (define-public (hammer-print-function grob)
24 (let* ((note-collums (ly:grob-property grob 'note-columns))
25 (note-column1 (cadr note-collums))
26 (note-column2 (car note-collums))
27 (note1 (car (ly:grob-property note-column1 'note-heads)))
28 (note2 (car (ly:grob-property note-column2 'note-heads)))
29 (text1 (ly:grob-property note1 'text))
30 (text2 (ly:grob-property note2 'text))
31 (fret1 (if (string? text1) (string->number text1) 0))
32 (fret2 (if (string? text2) (string->number text2) 0))
41 ;; FIXME: a hammer is not a slur.
43 (ly:make-stencil '() '(0 . 0) '(0 . 0)))
44 (layout (ly:grob-layout grob))
45 (text (interpret-markup
47 (ly:grob-alist-chain grob (ly:output-def-lookup layout 'text-font-defaults))
50 (let ((x (/ (- (cdr (ly:stencil-extent slur 0))
51 (/ (cdr (ly:stencil-extent text 0)) 2.0))
54 (ly:stencil-set-extent! text 0 (cons x x))
55 (ly:stencil-align-to! text 0 1))) ) )
57 ; (ly:stencil-combine-at-edge slur 1 1 text -0.6)
61 (define-public guitar-tunings '(4 -1 -5 -10 -15 -20))
63 ; end of tablature functions
66 (define-public (make-stencil-boxer line-thick x-padding y-padding callback)
67 "Makes a routine that adds a box around the grob parsed as argument"
68 (define (stencil-boxer grob)
72 (x-ext (interval-widen (ly:stencil-extent mol 0) x-padding))
73 (y-ext (interval-widen (ly:stencil-extent mol 1) y-padding))
74 (x-rule (make-filled-box-stencil (interval-widen x-ext line-thick)
76 (y-rule (make-filled-box-stencil (cons 0 line-thick) y-ext)))
78 (set! mol (ly:stencil-combine-at-edge mol 0 1 y-rule x-padding))
79 (set! mol (ly:stencil-combine-at-edge mol 0 -1 y-rule x-padding))
80 (set! mol (ly:stencil-combine-at-edge mol 1 1 x-rule 0))
81 (set! mol (ly:stencil-combine-at-edge mol 1 -1 x-rule 0))
86 (define-public (arg->string arg)
87 (cond ((number? arg) (ly:inexact->string arg 10))
88 ((string? arg) (string-append "\"" arg "\""))
89 ((symbol? arg) (string-append "\"" (symbol->string arg) "\""))))
91 (define-public (func name . args)
97 (map (lambda (x) (string-append " " (arg->string x))) args)))
100 ;;(define (mm-to-pt x)
101 ;; (* (/ 72.27 25.40) x))
103 ;; do nothing in .scm output
105 (define-public (ly:numbers->string lst)
106 (string-join (map ly:number->string lst) " "))
108 (define (number->octal-string x)
109 (let* ((n (inexact->exact x))
110 (n64 (quotient n 64))
111 (n8 (quotient (- n (* n64 64)) 8)))
115 (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
117 (define-public (ly:inexact->string x radix)
118 (let ((n (inexact->exact x)))
119 (number->string n radix)))
121 (define-public (ly:number-pair->string c)
122 (string-append (ly:number->string (car c)) " "
123 (ly:number->string (cdr c))))
128 (make-string 1 (integer->char (+ (char->integer #\A) i)))))
130 (define (scm-scm action-name)
134 (define-public (find-notehead-symbol duration style)
136 ((xcircle) "2xcircle")
137 ((harmonic) "0harmonic")
139 ;; Oops, I actually would not call this "baroque", but, for
140 ;; backwards compatibility to 1.4, this is supposed to take
141 ;; brevis, longa and maxima from the neo-mensural font and all
142 ;; other note heads from the default font. -- jr
144 (string-append (number->string duration) "neomensural")
145 (number->string duration)))
147 (string-append (number->string duration) (symbol->string style)))
149 (string-append (number->string duration) (symbol->string style)))
151 ;; The default font in mf/feta-bolletjes.mf defines a brevis, but
152 ;; neither a longa nor a maxima. Hence let us, for the moment,
153 ;; take these from the neo-mensural font. TODO: mf/feta-bolletjes
154 ;; should define at least a longa for the default font. The longa
155 ;; should look exactly like the brevis of the default font, but
156 ;; with a stem exactly like that of the quarter note. -- jr
158 (string-append (number->string duration) "neomensural")
159 (number->string duration)))
161 (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
162 (symbol->string style)
163 (string-append (number->string (max 0 duration))
164 (symbol->string style))))))
166 ;; TODO junk completely?
167 (define (note-head-style->attachment-coordinates grob axis)
168 "Return pair (X . Y), containing multipliers for the note head
169 bounding box, where to attach the stem. e.g.: X==0 means horizontally
170 centered, X==1 is at the right, X == -1 is at the left."
174 (define-public (string-encode-integer i)
177 ((< i 0) (string-append "n" (string-encode-integer (- i))))
179 (make-string 1 (integer->char (+ 65 (modulo i 26))))
180 (string-encode-integer (quotient i 26))))))
182 (define-public ((every-nth-bar-number-visible n) barnum) (= 0 (modulo barnum n)))
184 (define-public ((modulo-bar-number-visible n m) barnum) (and (> barnum 1) (= m (modulo barnum n))))
186 (define-public ((set-bar-number-visibility n) tr)
187 (let* ((bn (ly:context-property tr 'currentBarNumber)))
188 (ly:context-set-property! tr 'barNumberVisibility (modulo-bar-number-visible n (modulo bn n)))))
190 (define-public (default-bar-number-visibility barnum) (> barnum 1))
192 ;; See documentation of Item::visibility_lambda_
193 (define-public (begin-of-line-visible d) (if (= d 1) '(#f . #f) '(#t . #t)))
194 (define-public (end-of-line-visible d) (if (= d -1) '(#f . #f) '(#t . #t)))
195 (define-public (spanbar-begin-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
197 (define-public (all-visible d) '(#f . #f))
198 (define-public (all-invisible d) '(#t . #t))
199 (define-public (begin-of-line-invisible d) (if (= d 1) '(#t . #t) '(#f . #f)))
200 (define-public (end-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
203 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
207 ;; How should a bar line behave at a break?
209 ;; Why prepend `default-' to every scm identifier?
210 (define-public (default-break-barline glyph dir)
211 (let ((result (assoc glyph
212 '((":|:" . (":|" . "|:"))
213 ("||:" . ("||" . "|:"))
215 ("||:" . ("||" . "|:"))
217 ("|:" . ("|" . "|:"))
220 ;; hmm... should we end with a bar line here?
221 (".|" . ("|" . ".|"))
224 (".|." . (".|." . ()))
227 ("empty" . (() . ()))
228 ("brace" . (() . "brace"))
229 ("bracket" . (() . "bracket")) ))))
231 (if (equal? result #f)
232 (ly:warn "Unknown bar glyph: `~S'" glyph)
233 (index-cell (cdr result) dir))) )
235 (define-public (shift-right-at-line-begin g)
236 "Shift an item to the right, but only at the start of the line."
237 (if (and (ly:item? g) (equal? (ly:item-break-dir g) RIGHT))
238 (ly:grob-translate-axis! g 3.5 X)))