implement fully, need FONT to get to charcode.
* scm/lily.scm (ly:all-stencil-expressions): Add glyph-string.
2004-12-26 Jan Nieuwenhuizen <janneke@gnu.org>
+ * scm/output-gnome.scm (FIXME-glyph-string): New function. Cannot
+ implement fully, need FONT to get to charcode.
+
+ * scm/lily.scm (ly:all-stencil-expressions): Add glyph-string.
+
* scm: Cleanups.
* Documentation/user/changing-defaults.itely: Fix internalsrefs
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
;;; Note: this file can't be used without LilyPond executable
(define-public (number-pair? x)
(and (pair? x)
(number? (car x)) (number? (cdr x))))
+
(define-public (number-or-grob? x)
- (or (ly:grob? x) (number? x))
- )
+ (or (ly:grob? x) (number? x)))
(define-public (grob-list? x)
(list? x))
(define-public (scheme? x) #t)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-
-
;; moved list to end of lily.scm: then all type-predicates are
;; defined.
(define type-p-name-alist '())
"Unknown type"
(if (apply (caar alist) obj)
(cdar alist)
- (match-predicate obj (cdr alist))
- )
- ))
+ (match-predicate obj (cdr alist)))))
(define-public (object-type obj)
(match-predicate obj type-p-name-alist))
(define-public (type-name predicate)
(let ((entry (assoc predicate type-p-name-alist)))
(if (pair? entry) (cdr entry)
- "unknown"
- )))
+ "unknown")))
-;;;
-;;; Generate chord names for the parser.
-;;;
-;;;
+;;;; chord-entry.scm -- Generate chord names for the parser.
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
(define-public (construct-chord root duration modifications)
" Build a chord on root using modifiers in MODIFICATIONS. NoteEvent
(start-additions #t))
(define (interpret-inversion chord mods)
- "Read /FOO part. Side effect: INVERSION is set."
- (if (and (> (length mods) 1) (eq? (car mods) 'chord-slash))
+ "Read /FOO part. Side effect: INVERSION is set."
+ (if (and (> (length mods) 1) (eq? (car mods) 'chord-slash))
(begin
(set! inversion (cadr mods))
(set! mods (cddr mods))))
(ly:pitch? (car flat-mods))
(not (eq? lead-mod sus-modifier)))
(begin
- (if (= (pitch-step (car flat-mods)) 11)
+ (if (= (pitch-step (car flat-mods)) 11)
(set! explicit-11 #t))
(set! base-chord
(stack-thirds (car flat-mods) the-canonical-chord))
;;;;;;;;;;;;;;;;
; chord modifiers change the pitch list.
-(define (aug-modifier pitches)
- (set! pitches (replace-step (ly:make-pitch 0 4 SHARP) pitches))
+(define (aug-modifier pitches)
+ (set! pitches (replace-step (ly:make-pitch 0 4 SHARP) pitches))
(replace-step (ly:make-pitch 0 2 0) pitches))
-(define (minor-modifier pitches)
+(define (minor-modifier pitches)
(replace-step (ly:make-pitch 0 2 FLAT) pitches))
-(define (maj7-modifier pitches)
+(define (maj7-modifier pitches)
(set! pitches (remove-step 7 pitches))
(cons (ly:make-pitch 0 6 0) pitches))
-(define (dim-modifier pitches)
+(define (dim-modifier pitches)
(set! pitches (replace-step (ly:make-pitch 0 2 FLAT) pitches))
(set! pitches (replace-step (ly:make-pitch 0 4 FLAT) pitches))
(set! pitches (replace-step (ly:make-pitch 0 6 DOUBLE-FLAT) pitches))
pitches)
-(define (sus-modifier pitches)
+(define (sus-modifier pitches)
(remove-step (pitch-step (ly:make-pitch 0 2 0)) pitches))
(define-public default-chord-modifier-list
-;;;
-;;; chord-ignatzek-names.scm -- chord name utility functions
-;;;
-;;; source file of the GNU LilyPond music typesetter
-;;;
-;;; (c) 2000--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; chord-ignatzek-names.scm -- chord name utility functions
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2000--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
(define name-note
(let ((nn (ly:context-property context 'chordNoteNamer)))
(if (eq? nn '())
- ; replacing the next line with name-root gives guile-error...? -rz
+ ;; replacing the next line with name-root gives guile-error...? -rz
;; apparently sequence of defines is equivalent to let, not let* ? -hwn
(ly:context-property context 'chordRootNamer)
(define (is-natural-alteration? p)
(= (natural-chord-alteration p) (ly:pitch-alteration p)))
-
(define (ignatzek-format-chord-name
root
prefix-modifiers
(make-line-markup total)))
- (let*
- (
- (sep (ly:context-property context 'chordNameSeparator))
- (root-markup (name-root root))
- (add-markups (map (lambda (x)
- (glue-word-to-step "add" x))
- addition-pitches))
- (filtered-alterations (filter-alterations alteration-pitches))
- (alterations (map name-step filtered-alterations))
- (suffixes (map suffix-modifier->markup suffix-modifiers))
- (prefixes (map prefix-modifier->markup prefix-modifiers))
- (main-markups (filter-main-name main-name))
- (to-be-raised-stuff (markup-join
- (append
- main-markups
- alterations
- suffixes
- add-markups) sep))
- (base-stuff (if (ly:pitch? bass-pitch)
- (list sep (name-note bass-pitch))
- '())))
+ (let* ((sep (ly:context-property context 'chordNameSeparator))
+ (root-markup (name-root root))
+ (add-markups (map (lambda (x) (glue-word-to-step "add" x))
+ addition-pitches))
+ (filtered-alterations (filter-alterations alteration-pitches))
+ (alterations (map name-step filtered-alterations))
+ (suffixes (map suffix-modifier->markup suffix-modifiers))
+ (prefixes (map prefix-modifier->markup prefix-modifiers))
+ (main-markups (filter-main-name main-name))
+ (to-be-raised-stuff (markup-join
+ (append
+ main-markups
+ alterations
+ suffixes
+ add-markups) sep))
+ (base-stuff (if (ly:pitch? bass-pitch)
+ (list sep (name-note bass-pitch))
+ '())))
(set! base-stuff
(append
(if exception
(ignatzek-format-exception root exception bass-note)
- (begin ; no exception.
-
- ; handle sus4 and sus2 suffix: if there is a 3 together with
- ; sus2 or sus4, then we explicitly say add3.
+ (begin
+ ;; no exception.
+ ;; handle sus4 and sus2 suffix: if there is a 3 together with
+ ;; sus2 or sus4, then we explicitly say add3.
(map
(lambda (j)
(if (get-step j pitches)
(begin
(set! add-steps (cons (get-step 3 pitches) add-steps))
(set! pitches (remove-step 3 pitches))))
- (set! suffixes (cons (get-step j pitches) suffixes))))
- ) '(2 4) )
+ (set! suffixes (cons (get-step j pitches) suffixes)))))
+ '(2 4))
;; do minor-3rd modifier.
(if (and (get-step 3 pitches)
-;;;
-;;; chord-name.scm -- chord name utility functions
-;;;
-;;; source file of the GNU LilyPond music typesetter
-;;;
-;;; (c) 2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; chord-name.scm -- chord name utility functions
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
(define (natural-chord-alteration p)
"Return the natural alteration for step P."
FLAT
0))
-
;;
;; TODO: make into markup.
;;
(make-line-markup (list empty-markup))
(conditional-kern-before
(alteration->text-accidental-markup alteration)
- (= alteration FLAT) 0.2
- )))
-
+ (= alteration FLAT) 0.2)))
(define-public (note-name->markup pitch)
"Return pitch markup for PITCH."
(vector-ref #("C" "D" "E" "F" "G" "A" "B") (ly:pitch-notename pitch)))
(accidental->markup (ly:pitch-alteration pitch)))))
-
(define-public ((chord-name->german-markup B-instead-of-Bb) pitch)
"Return pitch markup for PITCH, using german note names.
If B-instead-of-Bb is set to #t real german names are returned.
(make-normal-size-super-markup
(accidental->markup (cdr n-a)))))))
-
(define-public (note-name->german-markup pitch)
(let* ((name (ly:pitch-notename pitch))
(alt (ly:pitch-alteration pitch))
(list-ref '("c" "d" "e" "f" "g" "a" "h" "b") (car n-a) )
(if (or (equal? (car n-a) 2) (equal? (car n-a) 5))
(list-ref '( "ses" "s" "" "is" "isis") (+ 2 (/ (cdr n-a) 2) ))
- (list-ref '("eses" "es" "" "is" "isis") (+ 2 (/ (cdr n-a) 2) ))
- ))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
+ (list-ref '("eses" "es" "" "is" "isis") (+ 2 (/ (cdr n-a) 2) ))))))))
;; fixme we should standardize on omit-root (or the other one.)
;; perhaps the default should also be reversed --hwn
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 1998--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-;;;; Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Jan Nieuwenhuizen <janneke@gnu.org>
(define-public all-translation-properties '())
(if (not (equal? #f (object-property symbol 'translation-doc)))
(begin
(ly:warn "Redefining ~S " symbol)
- (exit 2)
- ))
+ (exit 2)))
(set-object-property! symbol 'translation-type? type?)
(set-object-property! symbol 'translation-doc description)
(set! all-translation-properties (cons symbol all-translation-properties))
- symbol
- )
+ symbol)
(define-public all-user-translation-properties
(map
(tieMelismaBusy ,boolean? "Signal whether a tie is present.")
(tweakCount ,number? "Number of otherwise unique Contexts.")
(tweakRank ,number? "Identify otherwise unique Contexts.")
- )
- ))
+ )))
(define-public all-translation-properties
(append all-user-translation-properties
(if (not (equal? (object-property symbol 'backend-doc) #f))
(begin
(ly:warn-append "Redefining ~S" symbol)
- (exit 2)
- ))
+ (exit 2)))
(set-object-property! symbol 'backend-type? type?)
(set-object-property! symbol 'backend-doc description)
- symbol
- )
+ symbol)
;; put this in an alist?
(define-public
(Y-extent-callback . ,Axis_group_interface::group_extent_callback)
(X-extent-callback . ,Axis_group_interface::group_extent_callback)
(stacking-dir . -1)
-; (threshold . (6 . 1000))
+ ;; (threshold . (6 . 1000))
(meta . ((interfaces . (align-interface axis-group-interface spanner-interface))))
))
(set! all-grob-descriptions (map completize-grob-entry all-grob-descriptions))
-
- ; (display (map pair? all-grob-descriptions))
-
+;; (display (map pair? all-grob-descriptions))
;; make sure that \property Foo.Bar =\turnOff doesn't complain
(map (lambda (x)
- ; (display (car x)) (newline)
-
+ ;; (display (car x)) (newline)
+
(set-object-property! (car x) 'translation-type? list?)
(set-object-property! (car x) 'is-grob? #t))
all-grob-descriptions)
-
(set! all-grob-descriptions (sort all-grob-descriptions alist<?))
draw-line
ez-ball
filledbox
+ glyph-string
horizontal-line
named-glyph
polygon
(format out "\\~a" (create-binding! (read port))))
;; just a $ character
((and (char=? c #\$) (char=? (peek-char port) #\$))
- (display (read-char port) out)) ;; pop the second $
+ ;; pop the second $
+ (display (read-char port) out))
;; a #scheme expression
((char=? c #\#)
(let ((expr (read port)))
-;;; midi.scm -- scm midi variables and functions
-;;;
-;;; source file of the GNU LilyPond music typesetter
-;;;
-;;; (c) 2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; midi.scm -- scm midi variables and functions
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>
("mt-32 drums" . ,(+ 32768 127))
("cm-64 kit" . ,(+ 32768 127))
("cm-64 drums" . ,(+ 32768 127))
- )
- instrument-names-alist
- )
-)
-
+ )
+ instrument-names-alist))
(define-public (default-instrument-equalizer s)
(let ((entry (assoc s instrument-equalizer-alist)))
(if entry
(cdr entry))))
-
(define-public (percussion? instrument)
"
returns whether the instrument should use midi channel 9
"
(let* ((inst (symbol->string instrument))
- (entry (assoc inst instrument-names-alist))
- )
- (and entry (>= (cdr entry) 32768))
- ))
+ (entry (assoc inst instrument-names-alist)))
+ (and entry (>= (cdr entry) 32768))))
(define-public (midi-program instrument)
"
returns the program of the instrument
"
(let* ((inst (symbol->string instrument))
- (entry (assoc inst instrument-names-alist))
- )
- (if entry (modulo (cdr entry) 32768) #f )
- )
-)
+ (entry (assoc inst instrument-names-alist)))
+ (if entry (modulo (cdr entry) 32768) #f)))
;; 90 == 90/127 == 0.71 is supposed to be the default value
;; urg: we should set this at start of track
#:fill-color "black"
#:join-style 'miter))
+;; FIXME: the framework-gnome backend needs to see every item that
+;; gets created. All items created here must should be put in a group
+;; that gets returned.
+(define (FIXME-glyph-string postscript-font-name named-glyphs)
+ (for-each
+ (lambda (x)
+ (placebox (car x) (cadr x)
+ (make <gnome-canvas-text>
+ #:parent (canvas-root)
+ #:x 0.0 #:y 0.0
+ #:anchor 'west
+ ;; FIXME:
+ #:font postscript-font-name
+ #:size-points 12
+ #:size-set #t
+ #:text
+ ;; FIXME: need FONT to get to charcode
+ (integer->utf8-string
+ (ly:font-glyph-name-to-charcode font caddr x)))))
+ text-snippets))
+
(define (grob-cause grob)
grob)
(define (horizontal-line x1 x2 thickness)
(filledbox (- x1) (- x2 x1) (* .5 thickness) (* .5 thickness)))
+(define (named-glyph font name)
+ (text font (ly:font-glyph-name-to-charcode font name)))
+
(define (placebox x y expr)
(let ((item expr))
;;(if item
item)
#f)))
-(define (named-glyph font name)
- (text font (ly:font-glyph-name-to-charcode font name)))
-
(define (polygon coords blot-diameter)
(let* ((def (make <gnome-canvas-path-def>))
(props (make <gnome-canvas-bpath>
#:text (if (integer? s)
(integer->utf8-string s)
(string->utf8-string s))))
+
(ly:number->string thick)
" draw_bezier_sandwich"))
-(define (bracket arch_angle arch_width arch_height height arch_thick thick)
+(define (bracket arch_angle arch_width arch_height height arch_thick thick)
(string-append
(ly:numbers->string
(list arch_angle arch_width arch_height height arch_thick thick))
(define (char font i)
(string-append
(ps-font-command font) " setfont "
- "(\\" (ly:inexact->string i 8) ") show" ))
-
-(define (named-glyph font glyph)
- (string-append
- (ps-font-command font) " setfont "
- "/" glyph " glyphshow "))
+ "(\\" (ly:inexact->string i 8) ") show"))
(define (dashed-line thick on off dx dy)
(string-append
" ] 0 draw_dashed_line"))
;; what the heck is this interface ?
-(define (dashed-slur thick dash l)
+(define (dashed-slur thick dash lst)
(string-append
- (string-join (map ly:number-pair->string l) " ")
+ (string-join (map ly:number-pair->string lst) " ")
" "
(ly:number->string thick)
" [ "
(ly:number->string (* 10 thick))
" ] 0 draw_dashed_slur"))
- ; todo: merge with tex-font-command?
-
-(define (embedded-ps string)
- string)
-
(define (dot x y radius)
(string-append
" "
(ly:numbers->string
(list x y radius)) " draw_dot"))
-(define (white-dot x y radius)
- (string-append
- " "
- (ly:numbers->string
- (list x y radius)) " draw_white_dot"))
-
(define (draw-line thick x1 y1 x2 y2)
(string-append
"1 setlinecap 1 setlinejoin "
(ly:number->string x2) " "
(ly:number->string y2) " lineto stroke"))
+(define (embedded-ps string)
+ string)
+
(define (ez-ball ch letter-col ball-col)
(string-append
" (" ch ") "
(ly:numbers->string (list letter-col ball-col))
- " /Helvetica-Bold " ;; ugh
+ ;; FIXME: barf
+ " /Helvetica-Bold "
" draw_ez_ball"))
-(define (filledbox breapth width depth height) ; FIXME : use draw_round_box
+;; FIXME: use draw_round_box
+(define (filledbox breapth width depth height)
(string-append (ly:numbers->string (list breapth width depth height))
" draw_box"))
+(define (glyph-string postscript-font-name x-y-named-glyphs)
+ (apply
+ string-append
+ (cons
+ (format #f " /~a findfont setfont " postscript-font-name)
+ (map (lambda (item)
+ (format #f " ~a ~a rmoveto /~a glyphshow "
+ (car item)
+ (cadr item)
+ (caddr item)))
+ x-y-named-glyphs))))
+
+(define (grob-cause grob)
+ "")
+
;; WTF is this in every backend?
(define (horizontal-line x1 x2 th)
(draw-line th x1 0 x2 0))
(string-append "/" key " {" val "} bind def\n")
(string-append "/" key " (" val ") def\n"))))
+(define (named-glyph font glyph)
+ (string-append
+ (ps-font-command font) " setfont "
+ "/" glyph " glyphshow "))
+
+(define (no-origin)
+ "")
(define (placebox x y s)
(string-append
(string-append "(" (ps-encoding word) ") show\n")))
(if (equal? #\space chr)
- (add-command (string-append (number->string space-length) " 0.0 rmoveto ")) )
+ (add-command (string-append (number->string space-length)
+ " 0.0 rmoveto ")))
(if (equal? #\space chr)
""
(define (new-text font s)
(let* ((space-length (cdar (ly:text-dimension font " ")))
- (space-move (string-append (number->string space-length) " 0.0 rmoveto "))
-
+ (space-move (string-append (number->string space-length)
+ " 0.0 rmoveto "))
(input-enc (assoc-get 'input-name
(ly:font-encoding-alist font)
'latin1))
(out-vec (decode-byte-string input-enc s)))
-
(string-append
(ps-font-command font) " setfont "
(string-join
(string-append "/" (symbol->string sym) " glyphshow")))
out-vec))))))
- ;(define text old-text)
+;;(define text old-text)
(define text new-text)
+;; FIXME: BARF helvetica?
(define (white-text scale s)
- (let ((mystring (string-append "(" s ") " (number->string scale) " /Helvetica-Bold "
- " draw_white_text")))
+ (let ((mystring (string-append
+ "(" s ") " (number->string scale)
+ " /Helvetica-Bold "
+ " draw_white_text")))
mystring))
(define (unknown)
"\n unknown\n")
+(define (white-dot x y radius)
+ (string-append
+ " "
+ (ly:numbers->string
+ (list x y radius)) " draw_white_dot"))
+
(define (zigzag-line centre? zzw zzh thick dx dy)
(string-append
(if centre? "true" "false") " "
(ly:number->string dx) " "
(ly:number->string dy)
" draw_zigzag_line"))
-
-
-(define (grob-cause grob)
- "")
-
-(define (no-origin)
- "")
-
-(define-public (glyph-string psname items)
- (apply
- string-append
- (cons
- (format " /~a findfont setfont " psname)
- (map (lambda (item)
- (format " ~a ~a rmoveto /~a glyphshow "
- (car item)
- (cadr item)
- (caddr item)))
- items))))
-
-;;; sketch.scm -- implement Scheme output routines for Sketch
-;;;
-;;; source file of the GNU LilyPond music typesetter
-;;;
-;;; (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
-;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; sketch.scm -- implement Scheme output routines for Sketch
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
;; def dispats (out,x,y,expr):
+;;;; texstr.scm -- implement Scheme output routines for TeX strings
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
(define-module (scm output-texstr))
(define this-module (current-module))
(srfi srfi-13)
(lily))
-
(define (dummy . foo) #f)
(map (lambda (x) (module-define! this-module x dummy))
;; spanner-state is an alist
;; of (SYMBOL . RESULT-INDEX), which indicates where
;; said spanner was started.
- (spanner-state #:init-value '() #:accessor span-state) )
+ (spanner-state #:init-value '() #:accessor span-state))
(define-method (write (x <Voice-state> ) file)
(display (when x) file)
ss-list)))
(list->vector (reverse! (helper 0 '() 0 0) '())))
-
(define (analyse-spanner-states voice-state-vec)
(define (helper index active)
(helper 0 '()))
-
-
(define noticed '())
(define part-combine-listener '())
(let* ((vs1 (car (voice-states now-state)))
(vs2 (cdr (voice-states now-state)))
(notes1 (note-events vs1))
- (durs1 (sort (map (lambda (x) (ly:music-property x 'duration))
- notes1)
- ly:duration<?))
+ (durs1 (sort (map (lambda (x) (ly:music-property x 'duration))
+ notes1)
+ ly:duration<?))
(pitches1 (sort (map (lambda (x) (ly:music-property x 'pitch))
notes1)
ly:pitch<?))
- (notes2 (note-events vs2))
- (durs2 (sort (map (lambda (x) (ly:music-property x 'duration))
- notes2)
- ly:duration<?))
+ (notes2 (note-events vs2))
+ (durs2 (sort (map (lambda (x) (ly:music-property x 'duration))
+ notes2)
+ ly:duration<?))
(pitches2 (sort (map (lambda (x) (ly:music-property x 'pitch))
notes2)
ly:pitch<?)))
(try-solo type (1+ current-idx) (1+ current-idx)))
(else
(try-solo type start-idx (1+ current-idx)))))
- start-idx)) ; try-solo
+ ;; try-solo
+ start-idx))
(define (analyse-moment result-idx)
"Analyse 'apart starting at RESULT-IDX. Return next index. "
(n1 (length notes1))
(n2 (length notes2)))
;; (display (list "analyzing step " result-idx " moment " (when now-state) vs1 vs2 "\n"))
- (max ; we should always increase.
-
+ (max
+ ;; we should always increase.
(cond ((and (= n1 0) (= n2 0))
(put 'apart-silence)
(1+ result-idx))
(try-solo 'solo2 result-idx result-idx))
(else (1+ result-idx)))
- (1+ result-idx)))) ; analyse-moment
+ ;; analyse-moment
+ (1+ result-idx))))
(if (< result-idx (vector-length result))
(if (equal? (configuration (vector-ref result result-idx)) 'apart)
-;;;;
;;;; slur.scm -- Slur scheme stuff
;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;;
;
; this is put into the slur-details property of Slur and PhrasingSlur
(define default-slur-details
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
(define standalone (not (defined? 'ly:gulp-file)))
;;(write standalone (current-error-port))
(- (car yext)) (cdr yext))
xext yext))
-
(define-public (box-grob-stencil grob)
"Make a box of exactly the extents of the grob. The box precisely
encloses the contents.
(define-public (fontify-text font-metric text)
"Set TEXT with font FONT-METRIC, returning a stencil."
- (let* ((b (ly:text-dimension font-metric text)))
+ (let* ((b (ly:text-dimension font-metric text)))
(ly:make-stencil
`(text ,font-metric ,text) (car b) (cdr b))))
(define-public (fontify-text-white scale font-metric text)
"Set TEXT with scale factor s"
- (let* ((b (ly:text-dimension font-metric text))
- (c `(white-text ,(* 2 scale) ,text))) ;urg -- workaround for using ps font
- (ly:make-stencil c (car b) (cdr b)))) ;urg -- extent is not from ps font, but we hope it's close
+ (let* ((b (ly:text-dimension font-metric text))
+ ;;urg -- workaround for using ps font
+ (c `(white-text ,(* 2 scale) ,text)))
+ ;;urg -- extent is not from ps font, but we hope it's close
+ (ly:make-stencil c (car b) (cdr b))))
projects / lilypond.git / commitdiff