X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fc%2B%2B.scm;h=74f58f4da3f4da2449535f0faf6ca1034c85dcd0;hb=ac3dd3ad38528113d97f6a8a7b81751c328f1c36;hp=b995d72b30d9331ce9fdcefe5cead2cc5507a5cb;hpb=fc3e875d6bf06f0680e897faffdcab36ad975a03;p=lilypond.git diff --git a/scm/c++.scm b/scm/c++.scm index b995d72b30..74f58f4da3 100644 --- a/scm/c++.scm +++ b/scm/c++.scm @@ -1,134 +1,86 @@ -;;;; 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--2011 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 (moment-pair? x) +(define-public (number-or-grob? x) + (or (ly:grob? x) (number? x))) + +(define-public (grob-list? x) + (list? x)) + +(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-boolean? x) - (or (number? x) (boolean? x))) +(define-public (string-or-symbol? x) + (or (string? x) (symbol? x))) -(define (number-or-string? x) +(define-public (number-or-string? x) (or (number? x) (string? x))) -(define (markup? x) - (or (string? x) (list? x))) - -;; ugh: code dup ; merge. -(define (object-type obj) - (cond - ((dir? obj) "direction") - ((number-pair? obj) "pair of numbers") - ((ly-input-location? obj) "input location") - ((ly-grob? obj) "grob (GRaphical OBject)") - ((pair? obj) "pair") - ((integer? obj) "integer") - ((list? obj) "list") - ((symbol? obj) "symbol") - ((string? obj) "string") - ((boolean? obj) "boolean") - ((moment? obj) "moment") - ((number? obj) "number") - ((char? obj) "char") - ((input-port? obj) "input port") - ((output-port? obj) "output port") - ((vector? obj) "vector") - ((procedure? obj) "procedure") - ((boolean-or-symbol? obj) "boolean or symbol") - ((number-or-string? obj) "number or string") - ((number-or-boolean? obj) "number or boolean") - ((markup? obj) "markup (list or string)") - (else "unknown type"))) - - -(define (type-name predicate) - (cond - ((eq? predicate dir?) "direction") - ((eq? predicate number-pair?) "pair of numbers") - ((eq? predicate ly-input-location?) "input location") - ((eq? predicate ly-grob?) "Grob") - ((eq? predicate pair?) "pair") - ((eq? predicate integer?) "integer") - ((eq? predicate list?) "list") - ((eq? predicate symbol?) "symbol") - ((eq? predicate string?) "string") - ((eq? predicate boolean?) "boolean") - ((eq? predicate moment?) "moment") - ((eq? predicate number?) "number") - ((eq? predicate char?) "char") - ((eq? predicate input-port?) "input port") - ((eq? predicate output-port?) "output port") - ((eq? predicate vector?) "vector") - ((eq? predicate procedure?) "procedure") - ((eq? predicate boolean-or-symbol?) "boolean or symbol") - ((eq? predicate number-or-string?) "number or string") - ((eq? predicate markup?) "markup (list or string)") - (else "unknown type"))) - - -(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))))) - - - -;;(define (cons-map f x) -;; (cons (f (car x)) (f (cdr x)))) - - -;;(define (reduce operator list) -;; (if (null? (cdr list)) (car list) -;; (operator (car list) (reduce operator (cdr list))))) - - - -; 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-elt-property elt symbol)) - (not (eq? #f (memq symbol (ly-get-elt-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) - (length . ,Repeated_music::volta_music_length))) - ("unfold" . ((iterator-ctor . ,Unfolded_repeat_iterator::constructor) - (length . ,Repeated_music::unfolded_music_length))) - ("fold" . ((iterator-ctor . ,Folded_repeat_iterator::constructor) - (length . ,Repeated_music::folded_music_length))) - ("percent" . ((iterator-ctor . ,Percent_repeat_iterator::constructor) - (length . ,Repeated_music::unfolded_music_length))) - ("tremolo" . ((iterator-ctor . ,Chord_tremolo_iterator::constructor) - (length . ,Repeated_music::unfolded_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))))) +(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))) + +;; 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))))) + +(define-public (object-type obj) + (match-predicate obj type-p-name-alist)) + +(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) + (string-trim-right + (symbol->string (procedure-name predicate)) + #\?))))