X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=fde3b90e192385acdba6f9e1a616ed0e7694805a;hb=67158e4f7f55d9b6ecf965f2de2817dde3b10261;hp=b5ff19cd69db3f85205120477f59683e25526ceb;hpb=361489be435c6b4b15af790956cb5819b8dfc907;p=lilypond.git

diff --git a/scm/lily.scm b/scm/lily.scm
index b5ff19cd69..fde3b90e19 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -2,65 +2,131 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 1998--2001 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2002 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 ;;; Library functions
 
-(use-modules (ice-9 regex))
 
-;;(write standalone (current-error-port))
+(use-modules (ice-9 regex))
 
-; (set-debug-cell-accesses! #t)
 
 ;;; General settings
+;; debugging evaluator is slower.
 
+(debug-enable 'debug)
+;(debug-enable 'backtrace)
+(read-enable 'positions)
 
 
-(debug-enable 'backtrace)
-
-
-(define point-and-click #f)
-(define security-paranoia #f)
-(define midi-debug #f)
-
-(define (line-column-location line col file)
+(define-public (line-column-location line col file)
   "Print an input location, including column number ."
   (string-append (number->string line) ":"
 		 (number->string col) " " file)
   )
 
-(define (line-location line col file)
+(define-public (line-location line col file)
   "Print an input location, without column number ."
   (string-append (number->string line) " " file)
   )
 
+(define-public point-and-click #f)
+
 ;; cpp hack to get useful error message
 (define ifdef "First run this through cpp.")
 (define ifndef "First run this through cpp.")
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public X 0)
+(define-public Y 1)
+(define-public START -1)
+(define-public STOP 1)
+(define-public LEFT -1)
+(define-public RIGHT 1)
+(define-public UP 1)
+(define-public DOWN -1)
+(define-public CENTER 0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; lily specific variables.
+(define-public default-script-alist '())
+
+(define-public security-paranoia #f)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Unassorted utility functions.
+
+(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 (other-axis a)
+  (remainder (+ a 1) 2))
   
-(define default-script-alist '())
-(define font-name-alist  '())
 
-(if (not (defined? 'standalone))
-    (define standalone (not (defined? 'ly-gulp-file))))
+(define-public (widen-interval iv amount)
+   (cons (- (car iv) amount)
+         (+ (cdr iv) amount))
+)
+
 
-;; The regex module may not be available, or may be broken.
-(define use-regex
-  (let ((os (string-downcase (vector-ref (uname) 0))))
-    (not (equal? "cygwin" (substring os 0 (min 6 (string-length os)))))))
 
-;; If you have trouble with regex, define #f
-(define use-regex #t)
-;;(define use-regex #f)
+(define (index-cell cell dir)
+  (if (equal? dir 1)
+      (cdr cell)
+      (car cell)))
 
+(define (cons-map f x)
+  "map F to contents of X"
+  (cons (f (car x)) (f (cdr x))))
 
-;;; Un-assorted stuff
+;; used where?
+(define-public (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
+
+ (take-from-list-until '(1 2 3  4 5) '() (lambda (x) (eq? x 3)))
+=>
+ ((3 2 1) 4 5)
+
+"
+  (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?)
+      )
+  ))
+
+
+(define-public (reduce-list list between)
+  "Create new list, inserting BETWEEN between elements of LIST"
+  (if (null? list)
+      '()
+      (if (null? (cdr list))
+	  list
+	  (cons (car list)
+		(cons between (reduce-list (cdr list) between)))
+  
+  )))
+
+(define-public (string-join str-list sep)
+  "append the list of strings in STR-LIST, joining them with SEP"
+  (apply string-append (reduce-list str-list sep))
+  )
 
-;; URG guile-1.4/1.4.x compatibility
-(if (not (defined? 'primitive-eval))
-    (define (primitive-eval form)
-      (eval2 form #f)))
 
 (define (sign x)
   (if (= x 0)
@@ -73,13 +139,10 @@
   (newline)
   x)
 
-(define (empty? x)
-  (equal? x '()))
-
 (define (!= l r)
   (not (= l r)))
 
-(define (filter-list pred? list)
+(define-public (filter-list pred? list)
   "return that part of LIST for which PRED is true."
   (if (null? list) '()
       (let* ((rest  (filter-list pred? (cdr list))))
@@ -87,7 +150,7 @@
 	    (cons (car list)  rest)
 	    rest))))
 
-(define (filter-out-list pred? list)
+(define-public (filter-out-list pred? list)
   "return that part of LIST for which PRED is true."
   (if (null? list) '()
       (let* ((rest  (filter-list pred? (cdr list))))
@@ -95,13 +158,13 @@
 	    (cons (car list)  rest)
 	    rest))))
 
-(define (uniqued-alist  alist acc)
+(define-public (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 (uniq-list list)
+(define-public (uniq-list list)
   (if (null? list) '()
       (if (null? (cdr list))
 	  list
@@ -109,22 +172,32 @@
 	      (uniq-list (cdr list))
 	      (cons (car list) (uniq-list (cdr list)))))))
 
-(define (alist<? x y)
+(define-public (alist<? x y)
   (string<? (symbol->string (car x))
 	    (symbol->string (car y))))
 
-(define (ly-load x)
-  (let* ((fn (%search-load-path x)))
-    (if (ly-verbose)
+(define-public (pad-string-to str wid)
+  (string-append str (make-string (max (- wid (string-length str)) 0) #\ ))
+  )
+
+(define-public (ly:load x)
+  (let* (
+	 (fn (%search-load-path x))
+
+	 )
+    (if (ly:verbose)
 	(format (current-error-port) "[~A]" fn))
     (primitive-load fn)))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  output
 (use-modules (scm tex)
 	     (scm ps)
 	     (scm pysk)
 	     (scm ascii-script)
 	     (scm sketch)
+	     (scm sodipodi)
 	     (scm pdftex)
 	     )
 
@@ -134,13 +207,11 @@
     ("ps" . ("Direct postscript. Requires setting GS_LIB and GS_FONTPATH" ,ps-output-expression))
     ("scm" . ("Scheme dump: debug scheme molecule expressions" ,write))
     ("as" . ("Asci-script. Postprocess with as2txt to get ascii art"  ,as-output-expression))
-    ("sketch" . ("Bare bones Sketch output. Requires sketch 0.7" ,sketch-output-expression))
+    ("sketch" . ("Bare bones Sketch output." ,sketch-output-expression))
+    ("sodipodi" . ("Bare bones Sodipodi output." ,sodipodi-output-expression))
     ("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))
     ))
 
-(define (pad-string-to str wid)
-  (string-append str (make-string (max (- wid (string-length str)) 0) #\ ))
-  )
 
 (define (document-format-dumpers)
   (map
@@ -149,7 +220,7 @@
      output-alist)
    ))
 
-(define (find-dumper format )
+(define-public (find-dumper format )
   (let*
       ((d (assoc format output-alist)))
     
@@ -158,37 +229,69 @@
 	(scm-error "Could not find dumper for format ~s" format))
     ))
 
-(define X 0)
-(define Y 1)
-(define LEFT -1)
-(define RIGHT 1)
-(define UP 1)
-(define DOWN -1)
-(define CENTER 0)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; other files.
 
-(if (not standalone)
-    (map ly-load
+(map ly:load
 					; load-from-path
-	 '("output-lib.scm"
-      	   "c++.scm"
-	   "molecule.scm"
-	   "bass-figure.scm"
-	   "grob-property-description.scm"
-	   "context-description.scm"
-	   "interface-description.scm"
-	   "beam.scm"
-	   "clef.scm"
-	   "slur.scm"
-	   "font.scm"
-	   "music-functions.scm"
-	   "music-property-description.scm"
-	   "auto-beam.scm"
-	   "basic-properties.scm"
-	   "chord-name.scm"
-	   "grob-description.scm"
-	   "translator-property-description.scm"
-	   "script.scm"
-	   "drums.scm"
-	   "midi.scm"
-	   )))
-
+     '("music-types.scm"
+       "output-lib.scm"
+       "c++.scm"
+       
+       "molecule.scm"
+       "bass-figure.scm"
+       "grob-property-description.scm"
+       "context-description.scm"
+       "interface-description.scm"
+       "beam.scm"
+       "clef.scm"
+       "slur.scm"
+       "font.scm"
+       "music-functions.scm"
+       "music-property-description.scm"
+       "auto-beam.scm"
+       "new-markup.scm"
+       "basic-properties.scm"
+       "chord-name.scm"
+       "grob-description.scm"
+       "translator-property-description.scm"
+       "script.scm"
+       "drums.scm"
+       "midi.scm"
+       ))
+
+
+       
+
+
+(set! type-p-name-alist
+  `(
+   (,ly: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")
+   (,ly:duration? . "duration")
+   (,pair? . "pair")
+   (,integer? . "integer")
+   (,list? . "list")
+   (,symbol? . "symbol")
+   (,string? . "string")
+   (,boolean? . "boolean")
+   (,ly:moment? . "moment")
+   (,ly:input-location? . "input location")
+   (,music-list? . "list of music")
+   (,ly: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")
+   (,markup-list? . "list of markups")
+   (,number-or-grob? . "number or grob")
+   ))