From: Jan Nieuwenhuizen Date: Sun, 26 Dec 2004 21:11:26 +0000 (+0000) Subject: * scm/output-gnome.scm (FIXME-glyph-string): New function. Cannot X-Git-Tag: release/2.5.14~353 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=55a36d7beef61098884e49d6b853ce3d7a79811a;p=lilypond.git * 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. --- diff --git a/ChangeLog b/ChangeLog index 5d40f51264..2c52e55590 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2004-12-26 Jan Nieuwenhuizen + * 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 diff --git a/scm/c++.scm b/scm/c++.scm index 1978c52447..bcd343470a 100644 --- a/scm/c++.scm +++ b/scm/c++.scm @@ -3,7 +3,7 @@ ;;;; source file of the GNU LilyPond music typesetter ;;;; ;;;; (c) 1998--2004 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; Han-Wen Nienhuys ;;; Note: this file can't be used without LilyPond executable @@ -13,9 +13,9 @@ (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)) @@ -33,11 +33,6 @@ (define-public (scheme? x) #t) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - - ;; moved list to end of lily.scm: then all type-predicates are ;; defined. (define type-p-name-alist '()) @@ -47,9 +42,7 @@ "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)) @@ -57,5 +50,4 @@ (define-public (type-name predicate) (let ((entry (assoc predicate type-p-name-alist))) (if (pair? entry) (cdr entry) - "unknown" - ))) + "unknown"))) diff --git a/scm/chord-entry.scm b/scm/chord-entry.scm index 93a1c80a1c..ea7f87e00d 100644 --- a/scm/chord-entry.scm +++ b/scm/chord-entry.scm @@ -1,7 +1,8 @@ -;;; -;;; 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 (define-public (construct-chord root duration modifications) " Build a chord on root using modifiers in MODIFICATIONS. NoteEvent @@ -22,8 +23,8 @@ Entry point for the parser. (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)))) @@ -116,7 +117,7 @@ the bass specified. (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)) @@ -185,24 +186,24 @@ DURATION, and INVERSION." ;;;;;;;;;;;;;;;; ; 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 diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm index a3c3aa1c8f..19e30fac63 100644 --- a/scm/chord-ignatzek-names.scm +++ b/scm/chord-ignatzek-names.scm @@ -1,9 +1,8 @@ -;;; -;;; chord-ignatzek-names.scm -- chord name utility functions -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2000--2004 Han-Wen Nienhuys +;;;; chord-ignatzek-names.scm -- chord name utility functions +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Han-Wen Nienhuys @@ -72,7 +71,7 @@ (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) @@ -82,7 +81,6 @@ (define (is-natural-alteration? p) (= (natural-chord-alteration p) (ly:pitch-alteration p))) - (define (ignatzek-format-chord-name root prefix-modifiers @@ -157,27 +155,24 @@ work than classifying the pitches." (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 @@ -219,10 +214,10 @@ work than classifying the pitches." (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) @@ -231,8 +226,8 @@ work than classifying the 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) diff --git a/scm/chord-name.scm b/scm/chord-name.scm index 7986ba5c1c..af8b06b6e6 100644 --- a/scm/chord-name.scm +++ b/scm/chord-name.scm @@ -1,11 +1,9 @@ -;;; -;;; chord-name.scm -- chord name utility functions -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2000--2004 Jan Nieuwenhuizen -;;; -;;; Han-Wen Nienhuys +;;;; chord-name.scm -- chord name utility functions +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys (define (natural-chord-alteration p) "Return the natural alteration for step P." @@ -13,7 +11,6 @@ FLAT 0)) - ;; ;; TODO: make into markup. ;; @@ -32,9 +29,7 @@ (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." @@ -44,7 +39,6 @@ (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. @@ -62,7 +56,6 @@ (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)) @@ -75,11 +68,7 @@ (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 diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm index 3d13d2fe1f..f5404a7d8b 100644 --- a/scm/define-context-properties.scm +++ b/scm/define-context-properties.scm @@ -3,7 +3,7 @@ ;;;; source file of the GNU LilyPond music typesetter ;;;; ;;;; (c) 1998--2004 Han-Wen Nienhuys -;;;; Jan Nieuwenhuizen +;;;; Jan Nieuwenhuizen (define-public all-translation-properties '()) @@ -12,14 +12,12 @@ (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 @@ -497,8 +495,7 @@ to.") (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 diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm index fca647c368..7ec6cd8847 100644 --- a/scm/define-grob-properties.scm +++ b/scm/define-grob-properties.scm @@ -11,13 +11,11 @@ (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 diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index 9999ced858..edad8f922a 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -1335,7 +1335,7 @@ (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)))) )) @@ -1372,18 +1372,15 @@ (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 +;;;; midi.scm -- scm midi variables and functions +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Jan Nieuwenhuizen @@ -246,38 +246,29 @@ ("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 diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index 2846daa9ba..c4791998de 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -303,6 +303,27 @@ lilypond -fgnome input/simple-song.ly #: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 + #: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) @@ -310,6 +331,9 @@ lilypond -fgnome input/simple-song.ly (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 @@ -321,9 +345,6 @@ lilypond -fgnome input/simple-song.ly 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 )) (props (make @@ -396,3 +417,4 @@ lilypond -fgnome input/simple-song.ly #:text (if (integer? s) (integer->utf8-string s) (string->utf8-string s)))) + diff --git a/scm/output-ps.scm b/scm/output-ps.scm index 40c24c19b1..ea29cff999 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -104,7 +104,7 @@ (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)) @@ -113,12 +113,7 @@ (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 @@ -131,9 +126,9 @@ " ] 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) " [ " @@ -143,23 +138,12 @@ (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 " @@ -169,17 +153,37 @@ (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)) @@ -192,6 +196,13 @@ (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 @@ -230,7 +241,8 @@ (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) "" @@ -244,14 +256,13 @@ (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 @@ -264,17 +275,26 @@ (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") " " @@ -285,22 +305,3 @@ (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)))) diff --git a/scm/output-sketch.scm b/scm/output-sketch.scm index afe39c4076..d15487a678 100644 --- a/scm/output-sketch.scm +++ b/scm/output-sketch.scm @@ -1,10 +1,9 @@ - -;;; sketch.scm -- implement Scheme output routines for Sketch -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 1998--2004 Jan Nieuwenhuizen -;;; Han-Wen Nienhuys +;;;; sketch.scm -- implement Scheme output routines for Sketch +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 1998--2004 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys ;; def dispats (out,x,y,expr): diff --git a/scm/output-texstr.scm b/scm/output-texstr.scm index 54fd4f067e..854ae3a48b 100644 --- a/scm/output-texstr.scm +++ b/scm/output-texstr.scm @@ -1,3 +1,8 @@ +;;;; texstr.scm -- implement Scheme output routines for TeX strings +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2004 Han-Wen Nienhuys (define-module (scm output-texstr)) (define this-module (current-module)) @@ -8,7 +13,6 @@ (srfi srfi-13) (lily)) - (define (dummy . foo) #f) (map (lambda (x) (module-define! this-module x dummy)) diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm index 94872ae657..2679c195e7 100644 --- a/scm/part-combiner.scm +++ b/scm/part-combiner.scm @@ -18,7 +18,7 @@ ;; 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 ) file) (display (when x) file) @@ -110,7 +110,6 @@ Voice-state objects ss-list))) (list->vector (reverse! (helper 0 '() 0 0) '()))) - (define (analyse-spanner-states voice-state-vec) (define (helper index active) @@ -183,8 +182,6 @@ Voice-state objects (helper 0 '())) - - (define noticed '()) (define part-combine-listener '()) @@ -244,16 +241,16 @@ Only set if not set previously. (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 -;;;; ; ; this is put into the slur-details property of Slur and PhrasingSlur (define default-slur-details diff --git a/scm/standalone.scm b/scm/standalone.scm index 939c43cbc2..d4268a1802 100644 --- a/scm/standalone.scm +++ b/scm/standalone.scm @@ -3,7 +3,7 @@ ;;;; source file of the GNU LilyPond music typesetter ;;;; ;;;; (c) 1998--2004 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; Han-Wen Nienhuys (define standalone (not (defined? 'ly:gulp-file))) ;;(write standalone (current-error-port)) diff --git a/scm/stencil.scm b/scm/stencil.scm index 97e6470727..27c99be363 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -44,7 +44,6 @@ (- (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. @@ -77,12 +76,14 @@ 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))))