From 67158e4f7f55d9b6ecf965f2de2817dde3b10261 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 4 Jan 2003 12:03:46 +0000 Subject: [PATCH] * scm/chord-name.scm: Super/raise changes and fixes for Banter. * scm/new-markup.scm (normal-size-sub-markup) (normal-size-super-markup): New function. --- ChangeLog | 5 ++ ly/engraver-init.ly | 2 +- scm/chord-name.scm | 131 +++++++++++++++++++++++++++++--------------- scm/new-markup.scm | 14 ++++- 4 files changed, 106 insertions(+), 46 deletions(-) diff --git a/ChangeLog b/ChangeLog index 426b377021..11ac932a30 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2003-01-04 Jan Nieuwenhuizen + * scm/chord-name.scm: Super/raise changes and fixes for Banter. + + * scm/new-markup.scm (normal-size-sub-markup) + (normal-size-super-markup): New function. + * lily/source-file.cc (Source_file): Add warning for possibly intentional but suspicious initialization. diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index 0ed7f41b04..c8a1216fed 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -443,7 +443,7 @@ ScoreContext = \translator { ) barCheckSynchronize = ##t chordNameFunction = #chord->markup-banter - chordNameExceptions = #chord::names-alist-banter + chordNameExceptions = #chord::exception-alist-banter \grobdescriptions #all-grob-descriptions } diff --git a/scm/chord-name.scm b/scm/chord-name.scm index b178a7a8ee..bcd39fd14f 100644 --- a/scm/chord-name.scm +++ b/scm/chord-name.scm @@ -66,7 +66,7 @@ dump reinterpret the markup as a molecule. ;; markup = markup text -- see font.scm and input/test/markup.ly -(define-public chord::names-alist-banter +(define-public chord::exception-alist-banter `( ; C iso C.no3.no5 (((0 . 0)) . ,empty-markup) @@ -76,10 +76,10 @@ dump reinterpret the markup as a molecule. (((0 . 0) (2 . -1)) . ,(make-simple-markup "m")) ; C2 iso C2.no3 (((0 . 0) (1 . 0) (4 . 0)) - . ,(make-super-markup (make-simple-markup "2 "))) + . ,(make-normal-size-super-markup (make-simple-markup "2 "))) ; C4 iso C4.no3 (((0 . 0) (3 . 0) (4 . 0)) - . ,(make-super-markup (make-simple-markup "4 "))) + . ,(make-normal-size-super-markup (make-simple-markup "4 "))) ;; Cdim iso Cm5- (((0 . 0) (2 . -1) (4 . -1)) . ,(make-simple-markup "dim")) ; URG: Simply C:m5-/maj7 iso Cdim maj7 @@ -87,25 +87,25 @@ dump reinterpret the markup as a molecule. . ,(make-line-markup (list (make-simple-markup "m") - (make-super-markup (make-simple-markup "5-/maj7 "))))) + (make-normal-size-super-markup (make-simple-markup "5-/maj7 "))))) ; URG: Simply C:m5-/7 iso Cdim7 (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . ,(make-line-markup (list (make-simple-markup "m") - (make-super-markup (make-simple-markup "5-/7 "))))) + (make-normal-size-super-markup (make-simple-markup "5-/7 "))))) ; Co iso C:m5-/7- (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) - . ,(make-super-markup (make-simple-markup "o "))) + . ,(make-super-markup (make-simple-markup "o"))) ; Cdim9 (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ,(make-line-markup (list (make-simple-markup "dim") - (make-super-markup (make-simple-markup "9 "))))) + (make-normal-size-super-markup (make-simple-markup "9 "))))) (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ,(make-line-markup (list (make-simple-markup "dim") - (make-super-markup + (make-normal-size-super-markup (make-simple-markup "11 "))))) )) @@ -157,9 +157,7 @@ dump reinterpret the markup as a molecule. (list (make-simple-markup (vector-ref #("C" "D" "E" "F" "G" "A" "B") (cadr pitch))) - ;; undefined? - ;; (make-normal-size-superscript-markup - (make-super-markup + (make-normal-size-super-markup (accidental->markup (caddr pitch)))))) ;;; Hooks to override chord names and note names, @@ -195,6 +193,34 @@ dump reinterpret the markup as a molecule. ((2) "7+")) (step->markup pitch)))) +(define (step->markup-previously-alternate-jazz pitch) + (make-line-markup + (list + (accidental->markup (caddr pitch)) + (make-simple-markup + (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8))))))) + +(define (step->markup-previously-jazz pitch) + (if (= (cadr pitch) 6) + (case (caddr pitch) + ;; sharp 7 only included for completeness? + ((-2) (make-line-markup + (list + (accidental->markup -1) + (make-simple-markup "7")))) + ((-1) (make-simple-markup "7")) + ((0) (make-simple-markup "maj7")) + ;;((0) (make-line-markup + ;; (list (make-simple-markup "maj7")))) + ((1) (make-line-markup + (list + (accidental->markup 1) (make-simple-markup "7")))) + ((2) (make-line-markup + (list (accidental->markup 1) + (make-simple-markup "7"))))) + (step->markup-previously-alternate-jazz pitch))) + + (define pitch::semitone-vec #(0 2 4 5 7 9 11)) (define (pitch::semitone pitch) @@ -319,12 +345,13 @@ dump reinterpret the markup as a molecule. (chord::additions->markup-banter (cdr additions) subtractions))) empty-markup)) -(define (chord::subtractions->markup-banter subtractions) +(define (chord::subtractions->markup-banter subtractions) (if (pair? subtractions) (make-line-markup (list (make-simple-markup "no") - (let ((step (step->markup-jazz (car subtractions)))) + (let ((step (step->markup-previously-jazz + (car subtractions)))) (if (pair? (cdr subtractions)) (make-line-markup (list step (make-simple-markup "/"))) @@ -358,15 +385,21 @@ dump reinterpret the markup as a molecule. " (let* ((tonic-markup (pitch->chord-name-markup-banter tonic steps)) - (except-markup - - (if exception-part exception-part empty-markup)) ;;(make-simple-markup ""))) - (sep-markup (make-simple-markup - (if (and (string-match "super" - (format "~s" except-markup)) - (or (pair? additions) - (pair? subtractions))) - "/" ""))) + (except-markup (if exception-part exception-part empty-markup)) + (sep-markup (if (and exception-part + (let ((s (format "~s" except-markup))) + (and + (string-match "super" s) + ;; ugh ugh + ;; python: `except_markup`[-5:] != '"o"))' + (not (equal? + "\"o\"))" + (substring s + (- (string-length s) 5)))))) + (or (pair? additions) + (pair? subtractions))) + (make-super-markup (make-simple-markup "/")) + empty-markup)) (adds-markup (chord::additions->markup-banter additions subtractions)) (subs-markup (chord::subtractions->markup-banter subtractions)) (b+i-markup (chord::bass-and-inversion->markup-banter @@ -377,8 +410,7 @@ dump reinterpret the markup as a molecule. tonic-markup except-markup sep-markup - (make-raise-markup - 0.3 + (make-normal-size-super-markup (make-line-markup (list adds-markup subs-markup))) b+i-markup)))) @@ -406,10 +438,10 @@ dump reinterpret the markup as a molecule. ;; this is unintelligible. ;; (define (chord::exceptions-lookup-helper - exceptions-alist try-steps unmatched-steps exception-part) + exception-alist try-steps unmatched-steps exception-part) " - check exceptions-alist for biggest matching part of try-steps + check exception-alist for biggest matching part of try-steps return (MATCHED-EXCEPTION . UNMATCHED-STEPS) " @@ -423,13 +455,13 @@ dump reinterpret the markup as a molecule. (let ((entry (assoc (map (lambda (x) (pitch->note-name x)) (append '((0 0 0)) try-steps)) - exceptions-alist))) + exception-alist))) (if entry (chord::exceptions-lookup-helper #f '() unmatched-steps (cdr entry)) (let ((r (reverse try-steps))) (chord::exceptions-lookup-helper - exceptions-alist + exception-alist (reverse (cdr r)) (cons (car r) unmatched-steps) #f)))) (cons exception-part unmatched-steps))) @@ -480,13 +512,18 @@ dump reinterpret the markup as a molecule. ((2) (accidental->markup 2))) (make-simple-markup (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8))))) -(define-public chord::names-alist-american +(define-public chord::exception-alist-american `( - (((0 . 0)) . ,empty-markup) (((0 . 0)) . ,empty-markup) (((0 . 0) (2 . -1)) . ,(make-simple-markup "m")) - (((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 "))) - (((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 "))) + + ;; these should probably be normal-size? --jcn + ;;(((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 "))) + ;;(((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 "))) + + (((0 . 0) (4 . 0)) . ,(make-normal-size-super-markup (make-simple-markup "5 "))) + (((0 . 0) (1 . 0) (4 . 0)) . ,(make-normal-size-super-markup (make-simple-markup "2 "))) + ;;choose your symbol for the fully diminished chord (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-simple-markup "dim")) ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-line-markup (list empty-markup (make-super-markup (make-simple-markup "o"))))) @@ -600,8 +637,7 @@ dump reinterpret the markup as a molecule. (make-line-markup (list tonic-markup except-markup sep-markup - (make-raise-markup - 0.3 + (make-normal-size-super-markup (make-line-markup (list pref-markup suff-markup))) b+i-markup)))) @@ -638,15 +674,20 @@ dump reinterpret the markup as a molecule. ;; Jazz chords, by Atte Andr'e Jensen ;; Complete rewrite by Amelie Zapf (amy@loueymoss.com) -;; FIXME: identical to chord::names-alist-american, apart from commented +;; FIXME: identical to chord::exception-alist-american, apart from commented ;; dim chord. should merge. -(define-public chord::names-alist-jazz +(define-public chord::exception-alist-jazz `( - (((0 . 0)) . ,empty-markup) (((0 . 0)) . ,empty-markup) (((0 . 0) (2 . -1)) . ,(make-simple-markup "m")) - (((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 "))) - (((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 "))) + + ;; these should probably be normal-size? --jcn + ;;(((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 "))) + ;;(((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 "))) + + (((0 . 0) (4 . 0)) . ,(make-normal-size-super-markup (make-simple-markup "5 "))) + (((0 . 0) (1 . 0) (4 . 0)) . ,(make-normal-size-super-markup (make-simple-markup "2 "))) + ;;choose your symbol for the fully diminished chord ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-simple-markup "dim")) (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-line-markup (list (make-simple-markup "") (make-super-markup (make-simple-markup "o"))))) @@ -768,8 +809,7 @@ dump reinterpret the markup as a molecule. (make-line-markup (list tonic-markup except-markup sep-markup - (make-raise-markup - 0.3 + (make-normal-size-super-markup (make-line-markup (list pref-markup suff-markup))) b+i-markup)))) @@ -859,11 +899,14 @@ inline use in .ly file" (ly:export (case sym ((jazz) - (chord-name-style-setter chord->markup-jazz chord::names-alist-jazz)) + (chord-name-style-setter chord->markup-jazz + chord::exception-alist-jazz)) ((banter) - (chord-name-style-setter chord->markup-banter chord::names-alist-banter)) + (chord-name-style-setter chord->markup-banter + chord::exception-alist-banter)) ((american) - (chord-name-style-setter chord->markup-american chord::names-alist-american)) + (chord-name-style-setter chord->markup-american + chord::exception-alist-american)) ))) diff --git a/scm/new-markup.scm b/scm/new-markup.scm index 58f8ca0ffd..b940653586 100644 --- a/scm/new-markup.scm +++ b/scm/new-markup.scm @@ -163,7 +163,7 @@ for the reader. (car rest) Y) ) -(define-public (normal-size-superscript-markup grob props . rest) +(define-public (normal-size-super-markup grob props . rest) (ly:molecule-translate-axis (interpret-markup grob props (car rest)) @@ -197,6 +197,15 @@ for the reader. Y) ) +(define-public (normal-size-sub-markup grob props . rest) + (ly:molecule-translate-axis (interpret-markup + grob + props (car rest)) + (* -0.5 (cdr (chain-assoc 'baseline-skip props))) + Y) + ) + + ;; todo: fix negative space (define (hspace-markup grob props . rest) "Syntax: \\hspace NUMBER." @@ -366,7 +375,10 @@ for the reader. ;; (cons sub-markup (list markup?)) + (cons normal-size-sub-markup (list markup?)) + (cons super-markup (list markup?)) + (cons normal-size-super-markup (list markup?)) (cons bold-markup (list markup?)) (cons italic-markup (list markup?)) -- 2.39.5