]> git.donarmstrong.com Git - lilypond.git/commitdiff
* lily/ly-module.cc (LY_DEFINE): bugfix.
authorHan-Wen Nienhuys <hanwen@xs4all.nl>
Sun, 30 May 2004 15:29:18 +0000 (15:29 +0000)
committerHan-Wen Nienhuys <hanwen@xs4all.nl>
Sun, 30 May 2004 15:29:18 +0000 (15:29 +0000)
* lily/paper-book.cc (book_title): separate function for the book
title.

* scm/page-layout.scm (default-book-title): only account for
markup fields.

* scm/framework-ps.scm: new file. Move high level interface from
output-ps.scm

* scm/framework-tex.scm (dump-line): new file. High level
interface for output (pages, systems, header).

* lily/paper-book.cc (split_string): new function
(output): output multiple formats, i.e. --format=ps,tex

* scm/output-ps.scm (output-scopes): dump variables directly.
(define-fonts): rewrite for new interface

* ps/lilyponddefs.ps: remove lilypondpaper redefinitions.

12 files changed:
ChangeLog
lily/include/paper-book.hh
lily/ly-module.cc
lily/paper-book.cc
lily/score.cc
ps/lilyponddefs.ps
scm/framework-ps.scm [new file with mode: 0644]
scm/framework-tex.scm
scm/lily.scm
scm/output-ps.scm
scm/output-tex.scm
scm/page-layout.scm

index 5591eed3346859fcd952cf93cc3fbf614f8e5d78..96a8fe44a78e569702dfda31995fea577b064842 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,16 @@
 2004-05-30  Han-Wen Nienhuys   <hanwen@xs4all.nl>
 
+       * lily/ly-module.cc (LY_DEFINE): bugfix.
+
+       * lily/paper-book.cc (book_title): separate function for the book
+       title.
+
+       * scm/page-layout.scm (default-book-title): only account for
+       markup fields.
+
+       * scm/framework-ps.scm: new file. Move high level interface from
+       output-ps.scm
+
        * scm/music-functions.scm (def-grace-function): move macros from
        ly/music-functions-init.ly
 
index 16aa45f9834966c71479d22c6bfea0efda8e55a8..b1c8a5a5fc7617faff63e906d199806160be5010 100644 (file)
@@ -47,7 +47,8 @@ public:
 
   SCM lines ();
   SCM pages ();
-  Stencil title (int);
+  Stencil book_title ();
+  Stencil score_title (int);
   void classic_output (String);
   void init ();
   void output (String);
index 9c30b6ed96eff6b32362654e62ac7f5e1acdd8a5..6b2317eaad6aa4b1db9fb2bf3db4a5ccc5c74049 100644 (file)
@@ -135,7 +135,7 @@ LY_DEFINE(ly_modules_lookup, "ly:modules-lookup",
          "Lookup @var{sym} in the list @var{modules}, returning the "
          "first occurence. If not found, return @var{default}, or @code{#f}.")
 {
-  for (SCM s = modules; SCM_MODULEP (s); s = ly_cdr (s))
+  for (SCM s = modules; ly_c_pair_p (s); s = ly_cdr (s))
     {
       SCM mod = ly_car (s);      
       SCM v = scm_sym2var (sym, scm_module_lookup_closure (mod), SCM_UNDEFINED);
index 4ff0703274acd08e36156d55098278fd851d4fb6..dfbb55d6e5799df91d4208aa7ac4bb8a8b83de9c 100644 (file)
@@ -229,14 +229,43 @@ LY_DEFINE(ly_paper_book_book_paper, "ly:paper-book-book-paper",
   return unsmob_paper_book(pb)->bookpaper_->self_scm ();
 }
 
+/*
+
+TODO: resurrect more complex user-tweaks for titling .
+
+*/
+Stencil
+Paper_book::book_title ()
+{
+  SCM title_func = bookpaper_->lookup_variable (ly_symbol2scm ("book-title"));
+  Stencil title;
+
+  SCM scopes = SCM_EOL;
+  if (ly_c_module_p (header_))
+    scopes = scm_cons (header_, scopes);
+
+  SCM tit = SCM_EOL;
+  if (ly_c_procedure_p (title_func))
+    tit = scm_call_2 (title_func,
+                    bookpaper_->self_scm (),
+                    scopes);
+
+  if (unsmob_stencil (tit))
+    title = *unsmob_stencil (tit);
+
+  if (!title.is_empty ())
+    title.align_to (Y_AXIS, UP);
+  
+  return title;
+}
+
+  
+
 Stencil
-Paper_book::title (int i)
+Paper_book::score_title (int i)
 {
-  SCM user_title = bookpaper_->lookup_variable (ly_symbol2scm ("user-title"));
-  SCM book_title = bookpaper_->lookup_variable (ly_symbol2scm ("book-title"));
-  SCM score_title = bookpaper_->lookup_variable (ly_symbol2scm ("score-title"));
-  SCM field = (i == 0 ? ly_symbol2scm ("bookTitle")
-              : ly_symbol2scm ("scoreTitle"));
+  SCM title_func = bookpaper_->lookup_variable (ly_symbol2scm ("score-title"));
 
   Stencil title;
 
@@ -247,23 +276,27 @@ Paper_book::title (int i)
 
   if (ly_c_module_p (score_lines_[i].header_))
     scopes = scm_cons (score_lines_[i].header_, scopes);
-   //end ugh
-  
-  SCM s = ly_modules_lookup (scopes, field, SCM_BOOL_F);
-  if (s != SCM_BOOL_F)
-    title = *unsmob_stencil (scm_call_2 (user_title,
-                                        bookpaper_->self_scm (),
-                                        s));
-  else
-    title = *unsmob_stencil (scm_call_2 (i == 0 ? book_title : score_title,
-                                        bookpaper_->self_scm (),
-                                        scopes));
+  //end ugh
+
+  SCM tit = SCM_EOL;
+  if (ly_c_procedure_p (title_func))
+    tit =scm_call_2 (title_func,
+                    bookpaper_->self_scm (),
+                    scopes);
+
+  if (unsmob_stencil (tit))
+    title = *unsmob_stencil (tit);
+
+
   if (!title.is_empty ())
     title.align_to (Y_AXIS, UP);
   
   return title;
 }
 
+  
+
+
 /* calculate book height, #lines, stencils.  */
 void
 Paper_book::init ()
@@ -273,9 +306,13 @@ Paper_book::init ()
   /* Calculate the full book height.  Hmm, can't we cache system
      heights while making stencils?  */
   height_ = 0;
+  Stencil btitle = book_title ();
+  if (!btitle.is_empty ())
+    height_ += btitle.extent (Y_AXIS).length ();
+  
   for (int i = 0; i < score_count; i++)
     {
-      Stencil title = this->title (i);
+      Stencil title = score_title (i);
       if (!title.is_empty ())
        height_ += title.extent (Y_AXIS).length ();
 
@@ -313,15 +350,20 @@ Paper_book::lines ()
 {
   if (ly_c_pair_p (lines_))
     return lines_;
-      
+
+  Stencil title = book_title ();      
+  if (!title.is_empty ())
+    lines_ = scm_cons (stencil2line (title, true), lines_);
+  
   int score_count = score_lines_.size ();
   for (int i = 0; i < score_count; i++)
     {
-      Stencil title = this->title (i);      
+      Stencil title = score_title (i);      
       if (!title.is_empty ())
        lines_ = scm_cons (stencil2line (title, true), lines_);
 
-      lines_ = scm_append (scm_list_2 (scm_vector_to_list (score_lines_[i].lines_), lines_));
+      SCM line_list = scm_vector_to_list (score_lines_[i].lines_); // guh.
+      lines_ = scm_append (scm_list_2 (scm_reverse (line_list), lines_));
     }
   
   lines_ = scm_reverse (lines_);
index d3bc525fc167edcc53a45cf16bdfe04f5f7c8a74..7757b6a37d5bec7ae773893733116e4e6e27b7e0 100644 (file)
@@ -244,17 +244,18 @@ Score::book_rendering (String outname,
          scaled = def->self_scm ();
          scm_gc_unprotect_object (scaled);
        }
+
+      /*
+       TODO: fix or junk --no-paper.
+       */
       
-      if (!(no_paper_global_b && dynamic_cast<Output_def*> (def)))
+      SCM context = ly_run_translator (music_, def->self_scm ());
+      if (dynamic_cast<Global_context*> (unsmob_context (context)))
        {
-         SCM context = ly_run_translator (music_, def->self_scm ());
-         if (dynamic_cast<Global_context*> (unsmob_context (context)))
+         SCM s = ly_format_output (context, out);
+         if (s != SCM_UNDEFINED)
            {
-             SCM s = ly_format_output (context, out);
-             if (s != SCM_UNDEFINED)
-               {
-                 systems = s;
-               }
+             systems = s;
            }
        }
 
index 60252c745c11abb21b714fc8d7b558b9e1f2e5cb..edd8448155b9180914a47431e81cb10e090f4b95 100644 (file)
     end
 } bind def
 
-/start-page
-{
-} bind def
-
-/stop-page
-{
-    showpage
-} bind def
-
-/stop-last-page
-{
-} bind def
-
 /start-system % x y
 {
     gsave
diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
new file mode 100644 (file)
index 0000000..69311a4
--- /dev/null
@@ -0,0 +1,206 @@
+
+(define-module (scm framework-ps))
+
+(use-modules (ice-9 regex)
+            (ice-9 string-fun)
+            (ice-9 format)
+            (guile)
+            (srfi srfi-13)
+            (scm output-ps)
+            (lily))
+
+(define (tex-font? fontname)
+  (equal? (substring fontname 0 2) "cm"))
+
+
+(define (define-fonts bookpaper)
+
+  (define font-list (ly:bookpaper-fonts bookpaper))
+  (define (define-font command fontname scaling)
+    (string-append
+     "/" command " { /" fontname " findfont "
+     (ly:number->string scaling) " output-scale div scalefont } bind def\n"))
+
+  (define (reencode-font plain encoding command)
+    (let ((coding-vector (get-coding-command encoding)))
+      (string-append
+       plain " " coding-vector " /" command " reencode-font\n"
+       "/" command "{ /" command " findfont 1 scalefont } bind def\n")))
+  
+  (define (guess-ps-fontname basename)
+    "We do not have the FontName, try to guess is from basename."
+    (cond
+     ((tex-font? basename)
+      ;; FIXME: we need proper Fontmap for the bluesky CM*, EC* fonts.
+      ;; Only the fonts that we trace in mf/ are in our own FontMap.
+      (string-append basename ".pfb"))
+     (else (string-append basename ".pfa"))
+     ))
+
+  (define (font-load-command font)
+    (let* ((specced-font-name (ly:font-name font))
+          (fontname (if specced-font-name
+                        specced-font-name
+                        (guess-ps-fontname (ly:font-filename font))))
+          
+          (coding-alist (ly:font-encoding-alist font))
+          (input-encoding (assoc-get 'input-name coding-alist))
+          (font-encoding (assoc-get 'output-name coding-alist))
+          (command (ps-font-command font))
+          ;; FIXME -- see (ps-font-command )
+          (plain (ps-font-command font #f))
+          (designsize (ly:font-design-size font))
+          (magnification (* (ly:font-magnification font)))
+          (ops (ly:output-def-lookup bookpaper 'outputscale))
+          (scaling (* ops magnification designsize)))
+
+      (string-append
+       (define-font plain fontname scaling)
+       (if (or (equal? input-encoding font-encoding)
+              ;; guh
+              (equal? font-encoding "fetaBraces")
+              (equal? font-encoding "fetaNumber")
+              (equal? font-encoding "fetaMusic")
+              (equal? font-encoding "parmesanMusic"))
+              ""
+          (reencode-font plain input-encoding command)))))
+  
+  (define (font-load-encoding encoding)
+    (let ((filename (get-coding-filename encoding)))
+      (ly:kpathsea-gulp-file filename)))
+
+  (let* ((encoding-list (map (lambda (x)
+                              (assoc-get 'input-name
+                                         (ly:font-encoding-alist x)))
+                            font-list))
+        (encodings (uniq-list (sort-list (filter string? encoding-list)
+                                         string<?))))
+
+    (string-append
+     (apply string-append (map font-load-encoding encodings))
+     (apply string-append
+           (map (lambda (x) (font-load-command x)) font-list)))))
+
+;; FIXME: duplicated in other output backends
+;; FIXME: silly interface name
+(define (output-variables paper)
+  ;; FIXME: duplicates output-paper's scope-entry->string, mostly
+  (define (value->string  val)
+    (cond
+     ((string? val) (string-append "(" val ")"))
+     ((symbol? val) (symbol->string val))
+     ((number? val) (number->string val))
+     (else "")))
+  
+  (define (output-entry ps-key ly-key)
+    (string-append
+     "/" ps-key " " (value->string (ly:output-def-lookup paper ly-key)) " def \n"))
+  
+  (string-append
+   "/lily-output-units 2.83464  def  %% milimeter \n"
+   "% /lily-output-units 0.996264  def  %% true points.\n"
+   (output-entry "staff-line-thickness" 'linethickness)
+   (output-entry "line-width" 'linewidth)
+   (output-entry "paper-size" 'papersize)
+   (output-entry "staff-height" 'staffheight)  ;junkme.
+   "/output-scale "
+   (number->string (ly:output-def-lookup paper 'outputscale))
+   " lily-output-units mul def \n"
+    ))
+  
+(define (header paper page-count classic?)
+  (string-append
+   "%!PS-Adobe-3.0\n"
+   "%%Creator: creator time-stamp \n"
+   "%%Pages: " (number->string page-count) "\n"
+   "%%PageOrder: Ascend\n"
+   "%%DocumentPaperSizes: " (ly:output-def-lookup paper 'papersize) "\n"
+   ;;(string-append "GNU LilyPond (" (lilypond-version) "), ")
+   ;;     (strftime "%c" (localtime (current-time))))
+   ;; FIXME: duplicated in every backend
+   (ps-string-def
+    "lilypond" 'tagline
+    (string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
+   ))
+
+(define (dump-page outputter page page-number page-count)
+  (ly:outputter-dump-string outputter
+   (string-append
+    "%%Page: " (number->string page-number) " " (number->string page-count) "\n"
+    "0 0 start-system { "
+    "set-ps-scale-to-lily-scale "
+    "\n"))
+  (ly:outputter-dump-stencil outputter (ly:page-stencil page))
+  (ly:outputter-dump-string outputter
+                           "} stop-system \nshowpage\n") )
+  
+  
+(define-public (output-framework-ps outputter book scopes fields basename)
+  (let*
+      ((bookpaper  (ly:paper-book-book-paper book))
+       (pages (ly:paper-book-pages book))
+       (pageno 0)
+       (page-count (length pages))
+       )
+  (for-each
+   (lambda (x)
+     (ly:outputter-dump-string outputter x))
+   (list
+    (header bookpaper
+           (length pages)
+           #f)
+
+    (output-variables bookpaper)
+    (ly:gulp-file "music-drawing-routines.ps")
+    (ly:gulp-file "lilyponddefs.ps")
+    (define-fonts bookpaper)
+    ))
+
+  (for-each
+   (lambda (page)
+     (set! pageno (1+ pageno))
+     (dump-page outputter page pageno page-count))
+   pages)
+  (ly:outputter-dump-string outputter "%%Trailer\n%%EOF\n")
+  ))
+
+
+(define (dump-line outputter system)
+  (ly:outputter-dump-string
+   outputter
+    " start-system {\n set-ps-scale-to-lily-scale\n")
+  (ly:outputter-dump-stencil outputter (ly:page-line-stencil system))
+  (ly:outputter-dump-string
+   outputter
+  "} stop-system\n"))
+
+  
+(define-public (output-classic-framework-ps outputter book scopes fields basename)
+  (let*
+      ((bookpaper  (ly:paper-book-book-paper book))
+       (lines (ly:paper-book-lines book))
+       (pageno 0)
+       (page-count (length lines))
+       )
+  (for-each
+   (lambda (x)
+     (ly:outputter-dump-string outputter x))
+   (list
+    (header bookpaper
+           (length pages)
+           #f)
+
+    (output-variables bookpaper)
+    (ly:gulp-file "music-drawing-routines.ps")
+    (ly:gulp-file "lilyponddefs.ps")
+    (define-fonts bookpaper)
+    ))
+
+  (for-each
+   (lambda (line)
+     (set! pageno (1+ pageno))
+     (dump-line outputter line)) ;   pageno page-count))
+   lines)
+  (ly:outputter-dump-string outputter "\n")
+  ))
+
index 5db44ada3867872841d91938f7283cb015d4f784..1c1b897de6ad558483e4e894fe2c38a4bde02386 100644 (file)
               (ly:bookpaper-fonts bookpaper)
               ))))
 
+(define-public (header-to-file fn key val)
+  (set! key (symbol->string key))
+  (if (not (equal? "-" fn))
+      (set! fn (string-append fn "." key))
+      )
+  (display
+   (format "Writing header field `~a' to `~a'..."
+          key
+          (if (equal? "-" fn) "<stdout>" fn)
+          )
+   (current-error-port))
+  (if (equal? fn "-")
+      (display val)
+      (display val (open-file fn "w"))
+  )
+  (display "\n" (current-error-port))
+  "" )
+
+
 (define (output-scopes  scopes fields basename)
   (define (output-scope scope)
     (apply
      string-append
      (module-map
-     (lambda (sym var)
-       (let (;;(val (variable-ref var))
-            (val (if (variable-bound? var) (variable-ref var) '""))
-            (tex-key (symbol->string sym)))
+      (lambda (sym var)
+       (let ((val (if (variable-bound? var) (variable-ref var) ""))
+            )
         
         (if (and (memq sym fields) (string? val))
             (header-to-file basename sym val))
-
-        (cond
-         ((string? val)
-          (tex-string-def "lilypond" sym val))
-         
-         ((number? val)                ;why? 
-          (tex-number-def "lilypond" sym
-                          (if (integer? val)
-                              (number->string val)
-                              (number->string (exact->inexact val)))))
-         
-         (else ""))))
+        ""))
      scope)))
   
   (apply string-append
         (map output-scope scopes)))
+
+
 (define (tex-string-def prefix key str)
-  (if (equal? "" (sans-surrounding-whitespace (output-tex-string str)))
+  (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
       (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
       (string-append "\\def\\" prefix (symbol->tex-key key)
-                    "{" (output-tex-string str) "}%\n")))
+                    "{" (sanitize-tex-string str) "}%\n")))
 
 (define (header creator time-stamp bookpaper page-count classic?)
   (string-append
        "}%\n"))
    )
 
-;; todo: only pass BOOK, FIELDS arguments
 (define-public (output-framework-tex outputter book scopes fields basename)
   (let*
       ((bookpaper  (ly:paper-book-book-paper book))
             #f
             )
    
-   (output-scopes scopes fields basename)
    (define-fonts bookpaper)
    (header-end)))
 
index 1dba8fdc591ec2ce971e10430d307f0e9073bc44..264f4be59ada840a0117b25344636938126f3032 100644 (file)
@@ -381,6 +381,7 @@ L1 is copied, L2 not.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  output
 (use-modules (scm framework-tex)
+            (scm framework-ps)
             )
 
 
index e9ad248e45e174d0ef8fbb86e81304ba22432ff3..575c96d8fb1771549bdab9bfda953c2cf77b60d8 100644 (file)
@@ -19,8 +19,6 @@
   #:re-export (quote)
   #:export (define-fonts
             unknown
-            output-paper-def
-            output-scopes
             select-font
             blank
             dot
             (srfi srfi-13)
             (lily))
 
-;;; Global vars
-(define page-count 0)
-(define page-number 0)
-
 ;;; helper functions, not part of output interface
 (define (escape-parentheses s)
   (regexp-substitute/global #f "(^|[^\\])([\\(\\)])" s 'pre 1 "\\" 2 'post))
@@ -78,7 +72,7 @@
   (escape-parentheses text))
 
 ;; FIXME: lily-def
-(define (ps-string-def prefix key val)
+(define-public (ps-string-def prefix key val)
   (string-append "/" prefix (symbol->string key) " ("
                 (escape-parentheses val)
                 ") def\n"))
@@ -89,9 +83,6 @@
               (ly:number->string (exact->inexact val)))))
     (string-append "/" prefix (symbol->string key) " " s " def\n")))
 
-(define (tex-font? fontname)
-  (equal? (substring fontname 0 2) "cm"))
-
 
 ;;;
 ;;; Lily output interface, PostScript implementation --- cleanup and docme
 
 (define (char font i)
   (string-append 
-    (font-command font) " setfont " 
+    (ps-font-command font) " setfont " 
    "(\\" (ly:inexact->string i 8) ") show" ))
 
 (define (comment s)
    (ly:number->string (* 10 thick))
    " ] 0 draw_dashed_slur"))
 
-(define (font-command font . override-coding)
+; todo: merge with tex-font-command?
+
+(define-public (ps-font-command font . override-coding)
   (let* ((name (ly:font-filename font))
         (magnify (ly:font-magnification font))
         (coding-alist (ly:font-encoding-alist font))
      "m" (string-encode-integer (inexact->exact (round (* 1000 magnify))))
      (if (not coding-command) "" (string-append "e" coding-command)))))
 
-(define (define-fonts bookpaper)
-
-  (define font-list (ly:bookpaper-fonts bookpaper))
-  (define (define-font command fontname scaling)
-    (string-append
-     "/" command " { /" fontname " findfont "
-     (ly:number->string scaling) " output-scale div scalefont } bind def\n"))
-
-  (define (reencode-font plain encoding command)
-    (let ((coding-vector (get-coding-command encoding)))
-      (string-append
-       plain " " coding-vector " /" command " reencode-font\n"
-       "/" command "{ /" command " findfont 1 scalefont } bind def\n")))
-  
-  (define (guess-ps-fontname basename)
-    "We do not have the FontName, try to guess is from basename."
-    (cond
-     ((tex-font? basename)
-      ;; FIXME: we need proper Fontmap for the bluesky CM*, EC* fonts.
-      ;; Only the fonts that we trace in mf/ are in our own FontMap.
-      (string-append basename ".pfb"))
-     (else (string-append basename ".pfa"))
-     ))
-
-  (define (font-load-command font)
-    (let* ((specced-font-name (ly:font-name font))
-          (fontname (if specced-font-name
-                        specced-font-name
-                        (guess-ps-fontname (ly:font-filename font))))
-          
-          (coding-alist (ly:font-encoding-alist font))
-          (input-encoding (assoc-get 'input-name coding-alist))
-          (font-encoding (assoc-get 'output-name coding-alist))
-          (command (font-command font))
-          ;; FIXME -- see (font-command )
-          (plain (font-command font #f))
-          (designsize (ly:font-design-size font))
-          (magnification (* (ly:font-magnification font)))
-          (ops (ly:output-def-lookup bookpaper 'outputscale))
-          (scaling (* ops magnification designsize)))
-
-      (string-append
-       (define-font plain fontname scaling)
-       (if (or (equal? input-encoding font-encoding)
-              ;; guh
-              (equal? font-encoding "fetaBraces")
-              (equal? font-encoding "fetaNumber")
-              (equal? font-encoding "fetaMusic")
-              (equal? font-encoding "parmesanMusic"))
-              ""
-          (reencode-font plain input-encoding command)))))
-  
-  (define (font-load-encoding encoding)
-    (let ((filename (get-coding-filename encoding)))
-      (ly:kpathsea-gulp-file filename)))
-
-  (let* ((encoding-list (map (lambda (x)
-                              (assoc-get 'input-name
-                                         (ly:font-encoding-alist x)))
-                            font-list))
-        (encodings (uniq-list (sort-list (filter string? encoding-list)
-                                         string<?))))
-
-    (string-append
-     (apply string-append (map font-load-encoding encodings))
-     (apply string-append
-           (map (lambda (x) (font-load-command x)) font-list)))))
-
 (define (define-origin file line col) "")
 
 (define (dot x y radius)
   (string-append (ly:numbers->string (list breapth width depth height))
                 " draw_box"))
 
-(define (header creator time-stamp paper page-count- classic?)
-  (set! page-count page-count-)
-  (set! page-number 0)
-  (string-append
-   "%!PS-Adobe-3.0\n"
-   "%%Creator: " creator " " time-stamp "\n"
-   "%%Pages: " (number->string page-count) "\n"
-   "%%PageOrder: Ascend\n"
-   "%%DocumentPaperSizes: " (ly:output-def-lookup paper 'papersize) "\n"
-   ;;(string-append "GNU LilyPond (" (lilypond-version) "), ")
-   ;;     (strftime "%c" (localtime (current-time))))
-   ;; FIXME: duplicated in every backend
-   (ps-string-def
-    "lilypond" 'tagline
-    (string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
-   ))
-
-(define (header-end)
-  "")
-
 ;; WTF is this in every backend?
 (define (horizontal-line x1 x2 th)
   (draw-line th x1 0 x2 0))
 
 (define (no-origin) "")
 
-;; FIXME: duplictates output-scopes, duplicated in other backends
-;; FIXME: silly interface name
-(define (output-paper-def pd)
-  (let ((prefix "lilypondpaper"))
-    
-    (define (scope-entry->string key var)
-      (if (variable-bound? var)
-         (let ((val (variable-ref var)))
-           (cond
-            ((string? val) (ps-string-def prefix key val))
-            ((number? val) (ps-number-def prefix key val))
-            (else "")))
-         ""))
-      
-    (apply
-     string-append
-     (module-map scope-entry->string (ly:output-def-scope pd)))))
-
-;; FIXME: duplicated in other output backends
-;; FIXME: silly interface name
-(define (output-scopes paper scopes fields basename)
-  (let ((prefix "lilypond"))
-
-    ;; FIXME: duplicates output-paper's scope-entry->string, mostly
-    (define (value->string  val)
-      (cond
-       ((string? val) (string-append "(" val ")"))
-       ((symbol? val) (symbol->string val))
-       ((number? val) (number->string val))
-       (else "")))
-      
-    (define (output-entry ps-key ly-key)
-      (string-append
-       "/" ps-key " " (value->string (ly:output-def-lookup paper ly-key)) " def \n"))
 
-    
-    (string-append
-     "/lily-output-units 2.83464  def  %% milimeter \n"
-     "% /lily-output-units 0.996264  def  %% true points.\n"
-     (output-entry "staff-line-thickness" 'linethickness)
-     (output-entry "line-width" 'linewidth)
-     (output-entry "paper-size" 'papersize)
-     (output-entry "staff-height" 'staffheight)        ;junkme.
-     "/output-scale "
-     (number->string (ly:output-def-lookup paper 'outputscale))
-     " lily-output-units mul def \n"
-     
-     (ly:gulp-file "music-drawing-routines.ps")
-     (ly:gulp-file "lilyponddefs.ps")
-
-    )))
-  
 
 (define (placebox x y s) 
   (string-append 
     (ly:numbers->string
      (list x y width height blotdiam)) " draw_round_box"))
 
-(define (start-system origin dim)
-  (string-append
-   "\n" (ly:number-pair->string origin) " start-system\n"
-   "{\n"
-   "set-ps-scale-to-lily-scale\n"))
 
 (define (stem breapth width depth height) ; FIXME: use draw_round_box.
   (string-append
    (ly:numbers->string (list breapth width depth height))
    " draw_box" ))
 
-(define (stop-system last?)
-  "} stop-system\n")
-
 (define (symmetric-x-triangle thick w h)
   (string-append
    (ly:numbers->string (list h w thick))
      (string-append  s " "))
 
     (string-append
-     (font-command font) " setfont "
+     (ps-font-command font) " setfont "
      (string-join (reverse commands)))
     ))
   
     (ly:number->string dx) " "
     (ly:number->string dy)
     " draw_zigzag_line"))
-
-(define (start-page)
-  (set! page-number (+ page-number 1))
-  (string-append
-   "%%Page: " (number->string page-number) " " (number->string page-count) "\n"
-  "start-page\n"))
-
-(define (stop-page last?)
-  (if last?
-      "\nstop-last-page\n"
-      "\nstop-page\n"))
index 17a0578e69b93f6025397e4ce2115bc3f6ebce20..7ca908aac1a118cfd5881c5a2ca622a61031796b 100644 (file)
@@ -7,13 +7,14 @@
 
 
 ;; (debug-enable 'backtrace)
+
+;; the public interface is tight.
+;; It has to be, because user-code is evalled with this module.
+
 (define-module (scm output-tex)
   #:re-export (quote)
-  #:export (define-fonts
-            font-command
+  #:export (font-command
             unknown
-            output-paper-def
-            output-scopes
             blank
             dot
             beam
             symmetric-x-triangle
             ez-ball
             comment
-            end-output
-            experimental-on
             repeat-slash
-            header-end
-            header
             placebox
             bezier-sandwich
             horizontal-line
    (string-encode-integer
     (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
 
+
 (define (unknown) 
   "%\n\\unknown\n")
 
 (define-public (symbol->tex-key sym)
   (regexp-substitute/global
-   #f "_" (output-tex-string (symbol->string sym)) 'pre "X" 'post) )
+   #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
 
 (define (string->param string)
   (string-append "{" string "}"))
 (define (ez-ball c l b)
   (embedded-ps (list 'ez-ball  c  l b)))
 
-(define (header-to-file fn key val)
-  (set! key (symbol->string key))
-  (if (not (equal? "-" fn))
-      (set! fn (string-append fn "." key))
-      )
-  (display
-   (format "Writing header field `~a' to `~a'..."
-          key
-          (if (equal? "-" fn) "<stdout>" fn)
-          )
-   (current-error-port))
-  (if (equal? fn "-")
-      (display val)
-      (display val (open-file fn "w"))
-  )
-  (display "\n" (current-error-port))
-  ""
-  )
+
 
 (define (embedded-ps expr)
   (let ((ps-string
   (embedded-ps (list 'repeat-slash  w a t)))
 
 
-(define-public (output-tex-string s) ;; todo: rename
+(define-public (sanitize-tex-string s) ;; todo: rename
    (if (ly:get-option 'safe)
       (regexp-substitute/global #f "\\\\"
                                (regexp-substitute/global #f "([{}])" "bla{}" 'pre  "\\" 1 'post )
 (define (lily-def key val)
   (let ((tex-key
         (regexp-substitute/global
-             #f "_" (output-tex-string key) 'pre "X" 'post))
+             #f "_" (sanitize-tex-string key) 'pre "X" 'post))
         
-       (tex-val (output-tex-string val)))
+       (tex-val (sanitize-tex-string val)))
     (if (equal? (sans-surrounding-whitespace tex-val) "")
        (string-append "\\let\\" tex-key "\\undefined\n")
        (string-append "\\def\\" tex-key "{" tex-val "}%\n"))))
        ;; LaTeX gets in the way, and we need to remap
        ;; nonprintable chars.
        
-
        (input-enc-name #f) ;; (assoc-get 'input-name (ly:font-encoding-alist font) ))
        )
 
                   (if (string? input-enc-name)
                       (string-append "\\inputencoding{" input-enc-name "}")
                       "{}")
-                  (output-tex-string
+                  (sanitize-tex-string
                    (if (vector? mapping)
                        (reencode-string mapping s)
                        s))
index 999c0947486d7ef199dc0724aab7f981b3e53650..15c14fcc0f3582e4e599a8d8e30d87aaa85a1c94 100644 (file)
 ; titling.
 (define-public (default-book-title paper scopes)
   "Generate book title from header strings."
+
   
   (define (get sym)
     (let ((x (ly:modules-lookup scopes sym)))
-      (if (and x (not (unspecified? x))) x "")))
-  
+      (if (markup? x) x "")))
+
   (let ((props (page-properties paper)))
     
     (interpret-markup