X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily-library.scm;h=068bbb2873688b478fd0cd31ca75a0200ab5bc1b;hb=5842c0a15dc9683fc74996c6703ea33d4dd43ad0;hp=283f9a17090643f900882f46a821e4b9ed32f0dc;hpb=2453c199370399024972fc6127abba0d91cad86b;p=lilypond.git diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 283f9a1709..068bbb2873 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -3,7 +3,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2006 Jan Nieuwenhuizen +;;;; (c) 1998--2007 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -19,16 +19,27 @@ (define-public DOWN -1) (define-public CENTER 0) -(define-safe-public DOUBLE-FLAT -4) -(define-safe-public THREE-Q-FLAT -3) -(define-safe-public FLAT -2) -(define-safe-public SEMI-FLAT -1) +(define-safe-public DOUBLE-FLAT-QTS -4) +(define-safe-public THREE-Q-FLAT-QTS -3) +(define-safe-public FLAT-QTS -2) +(define-safe-public SEMI-FLAT-QTS -1) +(define-safe-public NATURAL-QTS 0) +(define-safe-public SEMI-SHARP-QTS 1) +(define-safe-public SHARP-QTS 2) +(define-safe-public THREE-Q-SHARP-QTS 3) +(define-safe-public DOUBLE-SHARP-QTS 4) +(define-safe-public SEMI-TONE-QTS 2) + +(define-safe-public DOUBLE-FLAT -1) +(define-safe-public THREE-Q-FLAT -3/4) +(define-safe-public FLAT -1/2) +(define-safe-public SEMI-FLAT -1/4) (define-safe-public NATURAL 0) -(define-safe-public SEMI-SHARP 1) -(define-safe-public SHARP 2) -(define-safe-public THREE-Q-SHARP 3) -(define-safe-public DOUBLE-SHARP 4) -(define-safe-public SEMI-TONE 2) +(define-safe-public SEMI-SHARP 1/4) +(define-safe-public SHARP 1/2) +(define-safe-public THREE-Q-SHARP 3/4) +(define-safe-public DOUBLE-SHARP 1) +(define-safe-public SEMI-TONE 1/2) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; moments @@ -38,44 +49,63 @@ (define-public (moment-min a b) (if (ly:moment output hooks. -(define-public (print-score parser score) - (let* ((head (ly:parser-lookup parser '$defaultheader)) - (book (ly:make-book (ly:parser-lookup parser '$defaultpaper) - head score))) - (ly:parser-print-score parser book))) (define-public (collect-scores-for-book parser score) (ly:parser-define! parser 'toplevel-scores (cons score (ly:parser-lookup parser 'toplevel-scores)))) +(define (collect-music-aux score-handler parser music) + (define (music-property symbol) + (let ((value (ly:music-property music symbol))) + (if (not (null? value)) + value + #f))) + (cond ((music-property 'page-marker) + ;; a page marker: set page break/turn permissions or label + (begin + (let ((label (music-property 'page-label))) + (if (symbol? label) + (score-handler (ly:make-page-label-marker label)))) + (for-each (lambda (symbol) + (let ((permission (music-property symbol))) + (if (symbol? permission) + (score-handler + (ly:make-page-permission-marker symbol + (if (eqv? 'forbid permission) + '() + permission)))))) + (list 'line-break-permission 'page-break-permission + 'page-turn-permission)))) + ((not (music-property 'void)) + ;; a regular music expression: make a score with this music + ;; void music is discarded + (score-handler (scorify-music music parser))))) + +(define-public (collect-music-for-book parser music) + "Top-level music handler" + (collect-music-aux (lambda (score) + (collect-scores-for-book parser score)) + parser + music)) + +(define-public (collect-book-music-for-book parser book music) + "Book music handler" + (collect-music-aux (lambda (score) + (ly:book-add-score! book score)) + parser + music)) (define-public (scorify-music music parser) + "Preprocess MUSIC." (for-each (lambda (func) (set! music (func music parser))) @@ -83,38 +113,15 @@ (ly:make-score music)) -(define-public (collect-music-for-book parser music) - ;; discard music if its 'void property is true. - (let ((void-music (ly:music-property music 'void))) - (if (or (null? void-music) (not void-music)) - (collect-scores-for-book parser (scorify-music music parser))))) - - -(define-public (print-book-with-defaults parser book) +(define (print-book-with parser book process-procedure) (let* ((paper (ly:parser-lookup parser '$defaultpaper)) (layout (ly:parser-lookup parser '$defaultlayout)) - (count (ly:parser-lookup parser 'output-count)) - (base (ly:parser-output-name parser))) - - (if (not (integer? count)) - (set! count 0)) - - (if (> count 0) - (set! base (format #f "~a-~a" base count))) - (ly:parser-define! parser 'output-count (1+ count)) - (ly:book-process book paper layout base) - )) - -(define-public (print-score-with-defaults parser score) - (let* - ((paper (ly:parser-lookup parser '$defaultpaper)) - (layout (ly:parser-lookup parser '$defaultlayout)) - (header (ly:parser-lookup parser '$defaultheader)) (count (ly:parser-lookup parser 'output-count)) (base (ly:parser-output-name parser))) + ;; must be careful: output-count is under user control. (if (not (integer? count)) (set! count 0)) @@ -122,9 +129,14 @@ (set! base (format #f "~a-~a" base count))) (ly:parser-define! parser 'output-count (1+ count)) - (ly:score-process score header paper layout base) + (process-procedure book paper layout base) )) +(define-public (print-book-with-defaults parser book) + (print-book-with parser book ly:book-process)) + +(define-public (print-book-with-defaults-as-systems parser book) + (print-book-with parser book ly:book-process-to-systems)) ;;;;;;;;;;;;;;;; ;; alist @@ -141,14 +153,6 @@ (stringstring (car x)) (symbol->string (car y)))) -(define-public (chain-assoc x alist-list) - (if (null? alist-list) - #f - (let* ((handle (assoc x (car alist-list)))) - (if (pair? handle) - handle - (chain-assoc x (cdr alist-list)))))) - (define-public (chain-assoc-get x alist-list . default) "Return ALIST entry for X. Return DEFAULT (optional, else #f) if not found." @@ -211,24 +215,9 @@ found." ;;;;;;;;;;;;;;;; ;; hash -(if (not (defined? 'hash-table?)) ;; guile 1.6 compat - (begin - (define hash-table? vector?) - (define-public (hash-for-each proc tab) - (hash-fold (lambda (k v prior) - (proc k v) - #f) - #f - tab)) - (define-public (hash-table->alist t) - "Convert table t to list" - (apply append (vector->list t)))) - - ;; native hashtabs. - (begin - (define-public (hash-table->alist t) - (hash-fold (lambda (k v acc) (acons k v acc)) - '() t)))) +(define-public (hash-table->alist t) + (hash-fold (lambda (k v acc) (acons k v acc)) + '() t)) ;; todo: code dup with C++. (define-safe-public (alist->hash-table lst) @@ -316,7 +305,7 @@ found." "Return list of elements in A that are not in B." (lset-difference eq? a b)) -(define (uniq lst) +(define-public (uniq-list lst) "Uniq LST, assuming that it is sorted" (reverse! @@ -335,6 +324,7 @@ found." L1 is copied, L2 not. (split-at-predicate (lambda (x y) (= (- y x) 2)) '(1 3 5 9 11) (cons '() '()))" + ;; " Emacs is broken (define (inner-split predicate lst acc) @@ -417,6 +407,9 @@ found." (define-public interval-end cdr) +(define-public (interval-bound interval dir) + ((if (= dir RIGHT) cdr car) interval)) + (define-public (interval-index interval dir) "Interpolate INTERVAL between between left (DIR=-1) and right (DIR=+1)" @@ -460,9 +453,16 @@ found." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - - +;; string + +(define-public (string-endswith s suffix) + (equal? suffix (substring s + (max 0 (- (string-length s) (string-length suffix))) + (string-length s)))) + +(define-public (string-startswith s prefix) + (equal? prefix (substring s 0 (min (string-length s) (string-length prefix))))) + (define-public (string-encode-integer i) (cond ((= i 0) "o") @@ -471,9 +471,6 @@ found." (make-string 1 (integer->char (+ 65 (modulo i 26)))) (string-encode-integer (quotient i 26)))))) -(define-public (ly:numbers->string lst) - (string-join (map ly:number->string lst) " ")) - (define (number->octal-string x) (let* ((n (inexact->exact x)) (n64 (quotient n 64)) @@ -553,7 +550,9 @@ possibly turned off." 0 (if (< x 0) -1 1))) -(define-public (car< a b) (< (car a) (car b))) + +(define-public (car< a b) + (< (car a) (car b))) (define-public (symbolstring lst) (symbol->string r))) @@ -608,14 +607,16 @@ possibly turned off." (define-public (version-not-seen-message input-file-name) (ly:message - (string-append - input-file-name ": 0: " (_ "warning: ") - (format #f - (_ "no \\version statement found, please add~afor future compatibility") - (format #f "\n\n\\version ~s\n\n" (lilypond-version)))))) + "~a:0: ~a: ~a" + input-file-name + (_ "warning: ") + (format #f + (_ "no \\version statement found, please add~afor future compatibility") + (format #f "\n\n\\version ~s\n\n" (lilypond-version))))) (define-public (old-relative-not-used-message input-file-name) (ly:message - (string-append - input-file-name ": 0: " (_ "warning: ") - (_ "old relative compatibility not used")))) + "~a:0: ~a: ~a" + input-file-name + (_ "warning: ") + (_ "old relative compatibility not used")))