]> git.donarmstrong.com Git - lilypond.git/blob - scm/lily.scm
470c30dea62bcfd74e6b839c5a82268cc87f6424
[lilypond.git] / scm / lily.scm
1 ;;;; lily.scm -- implement Scheme output routines for TeX and PostScript
2 ;;;;
3 ;;;;  source file of the GNU LilyPond music typesetter
4 ;;;; 
5 ;;;; (c) 1998--2002 Jan Nieuwenhuizen <janneke@gnu.org>
6 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
7
8 ;;; Library functions
9
10 (use-modules (ice-9 regex))
11
12 ;;(write standalone (current-error-port))
13
14
15 ;;; General settings
16 ;; debugging evaluator is slower.
17
18 (debug-enable 'debug)
19 ;(debug-enable 'backtrace)
20 (read-enable 'positions)
21
22
23 (define-public (line-column-location line col file)
24   "Print an input location, including column number ."
25   (string-append (number->string line) ":"
26                  (number->string col) " " file)
27   )
28
29 (define-public (line-location line col file)
30   "Print an input location, without column number ."
31   (string-append (number->string line) " " file)
32   )
33
34 (define-public point-and-click #f)
35
36 ;; cpp hack to get useful error message
37 (define ifdef "First run this through cpp.")
38 (define ifndef "First run this through cpp.")
39
40
41
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43
44 (define-public X 0)
45 (define-public Y 1)
46 (define-public START -1)
47 (define-public STOP 1)
48 (define-public LEFT -1)
49 (define-public RIGHT 1)
50 (define-public UP 1)
51 (define-public DOWN -1)
52 (define-public CENTER 0)
53
54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
55 ;; lily specific variables.
56 (define-public default-script-alist '())
57
58 (define-public security-paranoia #f)
59 (if (not (defined? 'standalone))
60     (define-public standalone (not (defined? 'ly-gulp-file))))
61
62
63 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
64 ;;; Unassorted utility functions.
65
66 (define (uniqued-alist  alist acc)
67   (if (null? alist) acc
68       (if (assoc (caar alist) acc)
69           (uniqued-alist (cdr alist) acc)
70           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
71
72 (define (other-axis a)
73   (remainder (+ a 1) 2))
74   
75
76 (define-public (widen-interval iv amount)
77    (cons (- (car iv) amount)
78          (+ (cdr iv) amount))
79 )
80
81
82
83 (define (index-cell cell dir)
84   (if (equal? dir 1)
85       (cdr cell)
86       (car cell)))
87
88 (define (cons-map f x)
89   "map F to contents of X"
90   (cons (f (car x)) (f (cdr x))))
91
92 ;; used where?
93 (define-public (reduce operator list)
94   "reduce OP [A, B, C, D, ... ] =
95    A op (B op (C ... ))
96 "
97       (if (null? (cdr list)) (car list)
98           (operator (car list) (reduce operator (cdr list)))))
99
100 (define (take-from-list-until todo gathered crit?)
101   "return (G, T), where (reverse G) + T = GATHERED + TODO, and the last of G
102 is the  first to satisfy CRIT
103
104  (take-from-list-until '(1 2 3  4 5) '() (lambda (x) (eq? x 3)))
105 =>
106  ((3 2 1) 4 5)
107
108 "
109   (if (null? todo)
110       (cons gathered todo)
111       (if (crit? (car todo))
112           (cons (cons (car todo) gathered) (cdr todo))
113           (take-from-list-until (cdr todo) (cons (car todo) gathered) crit?)
114       )
115   ))
116
117 (define (sign x)
118   (if (= x 0)
119       0
120       (if (< x 0) -1 1)))
121
122 (define (write-me n x)
123   (display n)
124   (write x)
125   (newline)
126   x)
127
128 (define (!= l r)
129   (not (= l r)))
130
131 (define-public (filter-list pred? list)
132   "return that part of LIST for which PRED is true."
133   (if (null? list) '()
134       (let* ((rest  (filter-list pred? (cdr list))))
135         (if (pred?  (car list))
136             (cons (car list)  rest)
137             rest))))
138
139 (define-public (filter-out-list pred? list)
140   "return that part of LIST for which PRED is true."
141   (if (null? list) '()
142       (let* ((rest  (filter-list pred? (cdr list))))
143         (if (not (pred?  (car list)))
144             (cons (car list)  rest)
145             rest))))
146
147 (define-public (uniqued-alist  alist acc)
148   (if (null? alist) acc
149       (if (assoc (caar alist) acc)
150           (uniqued-alist (cdr alist) acc)
151           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
152
153 (define-public (uniq-list list)
154   (if (null? list) '()
155       (if (null? (cdr list))
156           list
157           (if (equal? (car list) (cadr list))
158               (uniq-list (cdr list))
159               (cons (car list) (uniq-list (cdr list)))))))
160
161 (define-public (alist<? x y)
162   (string<? (symbol->string (car x))
163             (symbol->string (car y))))
164
165 (define-public (pad-string-to str wid)
166   (string-append str (make-string (max (- wid (string-length str)) 0) #\ ))
167   )
168
169 (define-public (ly-load x)
170   (let* ((fn (%search-load-path x)))
171     (if (ly-verbose)
172         (format (current-error-port) "[~A]" fn))
173     (primitive-load fn)))
174
175
176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
177 ;;  output
178 (use-modules (scm tex)
179              (scm ps)
180              (scm pysk)
181              (scm ascii-script)
182              (scm sketch)
183              (scm pdftex)
184              )
185
186 (define output-alist
187   `(
188     ("tex" . ("TeX output. The default output form." ,tex-output-expression))
189     ("ps" . ("Direct postscript. Requires setting GS_LIB and GS_FONTPATH" ,ps-output-expression))
190     ("scm" . ("Scheme dump: debug scheme molecule expressions" ,write))
191     ("as" . ("Asci-script. Postprocess with as2txt to get ascii art"  ,as-output-expression))
192     ("sketch" . ("Bare bones Sketch output. Requires sketch 0.7" ,sketch-output-expression))
193     ("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))
194     ))
195
196
197 (define (document-format-dumpers)
198   (map
199    (lambda (x)
200      (display (string-append  (pad-string-to 5 (car x)) (cadr x) "\n"))
201      output-alist)
202    ))
203
204 (define-public (find-dumper format )
205   (let*
206       ((d (assoc format output-alist)))
207     
208     (if (pair? d)
209         (caddr d)
210         (scm-error "Could not find dumper for format ~s" format))
211     ))
212
213 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
214 ;; other files.
215
216 (if (not standalone)
217     (map ly-load
218                                         ; load-from-path
219          '("music-types.scm"
220            "output-lib.scm"
221            "c++.scm"
222            "molecule.scm"
223            "bass-figure.scm"
224            "grob-property-description.scm"
225            "context-description.scm"
226            "interface-description.scm"
227            "beam.scm"
228            "clef.scm"
229            "slur.scm"
230            "font.scm"
231            "music-functions.scm"
232            "music-property-description.scm"
233            "auto-beam.scm"
234            "basic-properties.scm"
235            "chord-name.scm"
236            "grob-description.scm"
237            "translator-property-description.scm"
238            "script.scm"
239            "drums.scm"
240            "midi.scm"
241            )))
242