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--2001 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 ; (set-debug-cell-accesses! #t)
  15
  16 ;;; General settings
  17
  18
  19 ;; debugging evaluator is slower.
  20
  21 ;(debug-enable 'debug)
  22 ;(debug-enable 'backtrace)
  23 ;(read-enable 'positions)
  24
  25
  26 (define point-and-click #f)
  27 (define security-paranoia #f)
  28 (define midi-debug #f)
  29
  30 (define (line-column-location line col file)
  31   "Print an input location, including column number ."
  32   (string-append (number->string line) ":"
  33                  (number->string col) " " file)
  34   )
  35
  36 (define (line-location line col file)
  37   "Print an input location, without column number ."
  38   (string-append (number->string line) " " file)
  39   )
  40
  41 ;; cpp hack to get useful error message
  42 (define ifdef "First run this through cpp.")
  43 (define ifndef "First run this through cpp.")
  44
  45 (define default-script-alist '())
  46 (define font-name-alist  '())
  47
  48 (if (not (defined? 'standalone))
  49     (define standalone (not (defined? 'ly-gulp-file))))
  50
  51 ;; The regex module may not be available, or may be broken.
  52 (define use-regex
  53   (let ((os (string-downcase (vector-ref (uname) 0))))
  54     (not (equal? "cygwin" (substring os 0 (min 6 (string-length os)))))))
  55
  56 ;; If you have trouble with regex, define #f
  57 (define use-regex #t)
  58 ;;(define use-regex #f)
  59
  60
  61 ;;; Un-assorted stuff
  62
  63 ;; URG guile-1.4/1.4.x compatibility
  64 (if (not (defined? 'primitive-eval))
  65     (define (primitive-eval form)
  66       (eval2 form #f)))
  67
  68 (define (sign x)
  69   (if (= x 0)
  70       0
  71       (if (< x 0) -1 1)))
  72
  73 (define (write-me n x)
  74   (display n)
  75   (write x)
  76   (newline)
  77   x)
  78
  79 (define (empty? x)
  80   (equal? x '()))
  81
  82 (define (!= l r)
  83   (not (= l r)))
  84
  85 (define (filter-list pred? list)
  86   "return that part of LIST for which PRED is true."
  87   (if (null? list) '()
  88       (let* ((rest  (filter-list pred? (cdr list))))
  89         (if (pred?  (car list))
  90             (cons (car list)  rest)
  91             rest))))
  92
  93 (define (filter-out-list pred? list)
  94   "return that part of LIST for which PRED is true."
  95   (if (null? list) '()
  96       (let* ((rest  (filter-list pred? (cdr list))))
  97         (if (not (pred?  (car list)))
  98             (cons (car list)  rest)
  99             rest))))
 100
 101 (define (uniqued-alist  alist acc)
 102   (if (null? alist) acc
 103       (if (assoc (caar alist) acc)
 104           (uniqued-alist (cdr alist) acc)
 105           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
 106
 107 (define (uniq-list list)
 108   (if (null? list) '()
 109       (if (null? (cdr list))
 110           list
 111           (if (equal? (car list) (cadr list))
 112               (uniq-list (cdr list))
 113               (cons (car list) (uniq-list (cdr list)))))))
 114
 115 (define (alist<? x y)
 116   (string<? (symbol->string (car x))
 117             (symbol->string (car y))))
 118
 119 (define (ly-load x)
 120   (let* ((fn (%search-load-path x)))
 121     (if (ly-verbose)
 122         (format (current-error-port) "[~A]" fn))
 123     (primitive-load fn)))
 124
 125
 126 (use-modules (scm tex)
 127              (scm ps)
 128              (scm pysk)
 129              (scm ascii-script)
 130              (scm sketch)
 131              (scm pdftex)
 132              )
 133
 134 (define output-alist
 135   `(
 136     ("tex" . ("TeX output. The default output form." ,tex-output-expression))
 137     ("ps" . ("Direct postscript. Requires setting GS_LIB and GS_FONTPATH" ,ps-output-expression))
 138     ("scm" . ("Scheme dump: debug scheme molecule expressions" ,write))
 139     ("as" . ("Asci-script. Postprocess with as2txt to get ascii art"  ,as-output-expression))
 140     ("sketch" . ("Bare bones Sketch output. Requires sketch 0.7" ,sketch-output-expression))
 141     ("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))
 142     ))
 143
 144 (define (pad-string-to str wid)
 145   (string-append str (make-string (max (- wid (string-length str)) 0) #\ ))
 146   )
 147
 148 (define (document-format-dumpers)
 149   (map
 150    (lambda (x)
 151      (display (string-append  (pad-string-to 5 (car x)) (cadr x) "\n"))
 152      output-alist)
 153    ))
 154
 155 (define (find-dumper format )
 156   (let*
 157       ((d (assoc format output-alist)))
 158
 159     (if (pair? d)
 160         (caddr d)
 161         (scm-error "Could not find dumper for format ~s" format))
 162     ))
 163
 164 (define X 0)
 165 (define Y 1)
 166 (define LEFT -1)
 167 (define RIGHT 1)
 168 (define UP 1)
 169 (define DOWN -1)
 170 (define CENTER 0)
 171
 172 (if (not standalone)
 173     (map ly-load
 174                                         ; load-from-path
 175          '("output-lib.scm"
 176            "c++.scm"
 177            "molecule.scm"
 178            "bass-figure.scm"
 179            "grob-property-description.scm"
 180            "context-description.scm"
 181            "interface-description.scm"
 182            "beam.scm"
 183            "clef.scm"
 184            "slur.scm"
 185            "font.scm"
 186            "music-functions.scm"
 187            "music-property-description.scm"
 188            "auto-beam.scm"
 189            "basic-properties.scm"
 190            "chord-name.scm"
 191            "grob-description.scm"
 192            "translator-property-description.scm"
 193            "script.scm"
 194            "drums.scm"
 195            "midi.scm"
 196            )))
 197