X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fc%2B%2B.scm;h=ded5e9b1209bc0c0be4627db018962d7196eb0f1;hb=32a34dcef0c0041c6d62677487a380b5c8b85712;hp=41bd34139e4243869fe608a20859336feafc449a;hpb=8ce8fe393c36981322f961d975681aff26ae935d;p=lilypond.git diff --git a/scm/c++.scm b/scm/c++.scm index 41bd34139e..ded5e9b120 100644 --- a/scm/c++.scm +++ b/scm/c++.scm @@ -1,164 +1,99 @@ -;;;; c++.scm -- implement Scheme frontends to C++ functions +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 1998--2001 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . ;;; Note: this file can't be used without LilyPond executable -(define (number-pair? x) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; type predicates. +(define-public (number-pair? x) (and (pair? x) (number? (car x)) (number? (cdr x)))) -(define (number-or-grob? x) - (or (ly-grob? x) (number? x)) - ) -(define (grob-list? x) +(define-public (fraction? x) + (and (pair? x) + (index? (car x)) (index? (cdr x)))) + +(define-public (number-or-grob? x) + (or (ly:grob? x) (number? x))) + +(define-public (grob-list? x) (list? x)) -(define (moment-pair? x) +(define-public (number-list? x) + (and (list? x) (every number? x))) + +(define-public (index? x) + (and (integer? x) (>= x 0))) + +(define-public (moment-pair? x) (and (pair? x) - (moment? (car x)) (moment? (cdr x)))) + (ly:moment? (car x)) (ly:moment? (cdr x)))) -(define (boolean-or-symbol? x) +(define-public (boolean-or-symbol? x) (or (boolean? x) (symbol? x))) -(define (number-or-string? x) +(define-public (string-or-symbol? x) + (or (string? x) (symbol? x))) + +(define-public (number-or-string? x) (or (number? x) (string? x))) -(define (markup? x) - (or (string? x) (list? x))) - -(define (scheme? x) #t) - -(define type-p-name-alist - `( - (,dir? . "direction") - (,scheme? . "any type") - (,number-pair? . "pair of numbers") - (,ly-input-location? . "input location") - (,ly-grob? . "grob (GRaphical OBject)") - (,grob-list? . "list of grobs") - (,duration? . "duration") - (,pair? . "pair") - (,integer? . "integer") - (,list? . "list") - (,symbol? . "symbol") - (,string? . "string") - (,boolean? . "boolean") - (,moment? . "moment") - (,ly-input-location? . "input location") - (,music-list? . "list of music") - (,music? . "music") - (,number? . "number") - (,char? . "char") - (,input-port? . "input port") - (,output-port? . "output port") - (,vector? . "vector") - (,procedure? . "procedure") - (,boolean-or-symbol? . "boolean or symbol") - (,number-or-string? . "number or string") - (,markup? . "markup (list or string)") - (,number-or-grob? . "number or grob") - )) +(define-public (string-or-pair? x) + (or (string? x) (pair? x))) + +(define-public (number-or-pair? x) + (or (number? x) (pair? x))) + +(define-public (cheap-list? x) + (or (pair? x) (null? x))) + +(define-public (list-or-symbol? x) + (or (cheap-list? x) (symbol? x))) +(define-public (scheme? x) #t) + +(define-public (symbol-or-boolean? x) + (or (symbol? x) (boolean? x))) + +(define-public (void? x) + (unspecified? x)) + +;; moved list to end of lily.scm: then all type-predicates are +;; defined. +(define type-p-name-alist '()) (define (match-predicate obj alist) (if (null? alist) "Unknown type" (if (apply (caar alist) obj) (cdar alist) - (match-predicate obj (cdr alist)) - ) - )) + (match-predicate obj (cdr alist))))) -(define (object-type obj) +(define-public (object-type obj) (match-predicate obj type-p-name-alist)) -(define (type-name predicate) +(define-public (object-type-name obj) + (type-name (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" - ))) - -(define (uniqued-alist alist acc) - (if (null? alist) acc - (if (assoc (caar alist) acc) - (uniqued-alist (cdr alist) acc) - (uniqued-alist (cdr alist) (cons (car alist) acc))))) - - -;; used in denneboom.ly -(define (cons-map f x) - (cons (f (car x)) (f (cdr x)))) - -;; used where? -(define (reduce operator list) - "reduce OP [A, B, C, D, ... ] = - A op (B op (C ... )) -" - (if (null? (cdr list)) (car list) - (operator (car list) (reduce operator (cdr list))))) - - - -(define (take-from-list-until todo gathered crit?) - "return (G, T), where (reverse G) + T = GATHERED + TODO, and the last of G -is the first to satisfy CRIT " - (if (null? todo) - (cons gathered todo) - (if (crit? (car todo)) - (cons (cons (car todo) gathered) (cdr todo)) - (take-from-list-until (cdr todo) (cons (car todo) gathered) crit?) - ) - )) -; test: -; (take-from-list-until '(1 2 3 4 5) '() (lambda (x) (eq? x 3))) -; ((3 2 1) 4 5) - - - -; Make a function that checks score element for being of a specific type. -(define (make-type-checker symbol) - (lambda (elt) - ;;(display symbol) - ;;(eq? #t (ly-get-grob-property elt symbol)) - (not (eq? #f (memq symbol (ly-get-grob-property elt 'interfaces)))))) - - -(define (index-cell cell dir) - (if (equal? dir 1) - (cdr cell) - (car cell))) - -(define (repeat-name-to-ctor name) - (let* - ((supported-reps - `(("volta" . ((iterator-ctor . ,Volta_repeat_iterator::constructor) - (start-moment-function . ,Repeated_music::first_start) - (length . ,Repeated_music::volta_music_length))) - - ("unfold" . ((iterator-ctor . ,Unfolded_repeat_iterator::constructor) - (start-moment-function . ,Repeated_music::first_start) - (length . ,Repeated_music::unfolded_music_length))) - ("fold" . ((iterator-ctor . ,Folded_repeat_iterator::constructor) - (start-moment-function . ,Repeated_music::minimum_start) - (length . ,Repeated_music::folded_music_length))) - ("percent" . ((iterator-ctor . ,Percent_repeat_iterator::constructor) - (start-moment-function . ,Repeated_music::first_start) - (length . ,Repeated_music::unfolded_music_length))) - ("tremolo" . ((iterator-ctor . ,Chord_tremolo_iterator::constructor) - (start-moment-function . ,Repeated_music::first_start) - - ;; the length of the repeat is handled by shifting the note logs - (length . ,Repeated_music::folded_music_length))))) - - (handle (assoc name supported-reps))) - - (if (pair? handle) - (cdr handle) - (begin - (ly-warn - (string-append "Unknown repeat type `" name "'\nSee scm/c++.scm for supported repeats")) - '(type . 'repeated-music))))) + (string-trim-right + (symbol->string (procedure-name predicate)) + #\?))))