From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 2 Mar 2004 17:31:22 +0000 (+0000)
Subject: *** empty log message ***
X-Git-Tag: release/2.1.29~24
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=77a46f6837481b568a0942e6e9ba26787900ed84;p=lilypond.git

*** empty log message ***
---

diff --git a/input/test/title-markup.ly b/input/test/title-markup.ly
index 4c868a6590..08122870c0 100644
--- a/input/test/title-markup.ly
+++ b/input/test/title-markup.ly
@@ -46,10 +46,10 @@ texidoc = "
 	\column <
 	    { "<-LEFT" \hspace #30 "centre" \hspace #30 "RIGHT->" }
             " "
-	    \center < { \huge \bold \title } >
+	    \center < { \huge \bigger \bold \title } >
             " "
             \center <
-                \center < { \large \bold \subtitle } >
+                \center < { \normalsize \bold \subtitle } >
             >
             " "
             " "
diff --git a/lily/stencil-scheme.cc b/lily/stencil-scheme.cc
index dd902cadd7..eb28d72152 100644
--- a/lily/stencil-scheme.cc
+++ b/lily/stencil-scheme.cc
@@ -181,8 +181,8 @@ LY_DEFINE (ly_fontify_atom,"ly:fontify-atom", 2, 0, 0,
   return fontify_atom (unsmob_metrics (met), f);
 }
 
-LY_DEFINE (ly_align_to_x,"ly:stencil-align-to!", 3, 0, 0,  (SCM stil, SCM axis, SCM dir),
-
+LY_DEFINE (ly_align_to_x,"ly:stencil-align-to!", 3, 0, 0,
+	   (SCM stil, SCM axis, SCM dir),
 	   "Align @var{stil} using its own extents. "
 	   "@var{dir} is a number -1, 1 are left and right respectively. "
 	   "Other values are interpolated (so 0 means the center. ")
diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 9a578246a6..c1cb9d14c8 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -5,11 +5,18 @@
 ;;;; (c)  1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
-;; TODO:
-;;   * testbed for titles with markup
-;;   * font size and designsize
-;;   * FIXME: breaks when outputting strings with parentheses.
-
+;;;; Note: currently misused as testbed for titles with markup, see
+;;;;       input/test/title-markup.ly
+;;;; 
+;;;; TODO:
+;;;;   * UGR: SPACE character in CM* fonts
+;;;;   * text setting, kerning?
+;;;;   * font size and designsize
+;;;;   * linewidth
+;;;;   * font properties
+;;;;   * construction/customisation of title markup
+;;;;   * page layout
+;;;;   * document output-interface
 
 (debug-enable 'backtrace)
 
@@ -22,25 +29,66 @@
  (lily))
 
 
+
+
 ;;; Lily output interface, PostScript implementation --- cleanup and docme
 
-;; Module entry
+;;; Module entry
 (define-public (ps-output-expression expr port)
   (display (expression->string expr) port))
 
-
-(define (expression->string expr)
-  (eval expr this-module))
-
-;; Global vars
-
+;;; Global vars
 ;; alist containing fontname -> fontcommand assoc (both strings)
 (define font-name-alist '())
 
 ;; WIP -- stencils from markup? values of output-scopes
 (define header-stencil #f)
 
-;; Interface functions
+(define lily-traced-cm-fonts
+  (map symbol->string
+       '(cmbx14
+	 cmbx17
+	 cmbxti12
+	 cmbxti14
+	 cmbxti6
+	 cmbxti7
+	 cmbxti8
+	 cmcsc12
+	 cmcsc7
+	 cmcsc8
+	 cmss5
+	 cmss6
+	 cmss7
+	 cmti5
+	 cmti6
+	 cmtt17
+	 cmtt5
+	 cmtt6
+	 cmtt7)))
+
+;;; helper functions, not part of output interface
+(define (escape-parentheses s)
+  (regexp-substitute/global #f "(^|[^\\])([\\(\\)])" s 'pre 1 "\\" 2 'post))
+
+(define (offset-add a b)
+  (cons (+ (car a) (car b))
+	(+ (cdr a) (cdr b))))
+
+;; FIXME: lily-def
+(define (ps-string-def prefix key val)
+  (string-append "/" prefix (symbol->string key) " ("
+		 (escape-parentheses val)
+		 ") def\n"))
+
+(define (ps-number-def prefix key val)
+  (let ((s (if (integer? val)
+	       (number->string val)
+	       (number->string (exact->inexact val)))))
+    (string-append "/" prefix (symbol->string key) " " s " def\n")))
+
+
+
+;;; Output-interface functions
 (define (beam width slope thick blot)
   (string-append
    (numbers->string (list slope width thick blot)) " draw_beam" ))
@@ -58,21 +106,13 @@
     (list arch_angle arch_width arch_height height arch_thick thick))
    " draw_bracket"))
 
-(define (symmetric-x-triangle thick w h)
-  (string-append
-   (numbers->string (list h w thick))
-   " draw_symmetric_x_triangle"))
-
-
 (define (char i)
   (string-append 
    "(\\" (inexact->string i 8) ") show " ))
 
-
 (define (comment s)
   (string-append "% " s "\n"))
 
-
 (define (dashed-line thick on off dx dy)
   (string-append 
    (ly:number->string dx)
@@ -98,29 +138,6 @@
    (ly:number->string (* 10 thick))
    " ] 0 draw_dashed_slur"))
 
-(define lily-traced-cm-fonts
-  (map symbol->string
-       '(cmbx14
-	 cmbx17
-	 cmbxti12
-	 cmbxti14
-	 cmbxti6
-	 cmbxti7
-	 cmbxti8
-	 cmcsc12
-	 cmcsc7
-	 cmcsc8
-	 cmss5
-	 cmss6
-	 cmss7
-	 cmti5
-	 cmti6
-	 cmtt17
-	 cmtt5
-	 cmtt6
-	 cmtt7)))
-
-
 (define (define-fonts internal-external-name-mag-pairs)
 
   (define (font-load-command name-mag command)
@@ -176,21 +193,6 @@
    (numbers->string
     (list x y radius)) " draw_dot"))
 
-(define (zigzag-line centre? zzw zzh thick dx dy)
-  (string-append
-    (if centre? "true" "false")
-    " "
-    (ly:number->string zzw)
-    " "
-    (ly:number->string zzh)
-    " "
-    (ly:number->string thick)
-    " 0 0 "
-    (ly:number->string dx)
-    " "
-    (ly:number->string dy)
-    " draw_zigzag_line "))
-
 (define (draw-line thick x1 y1 x2 y2)
   (string-append 
   "	1 setlinecap
@@ -206,17 +208,12 @@
    (ly:number->string y2)
    " lineto stroke"))
 
-(define (polygon points blotdiameter)
-  (string-append
-   " "
-   (numbers->string points)
-   (ly:number->string (/ (length points) 2))
-   (ly:number->string blotdiameter)
-   " draw_polygon"))
-
 (define (end-output)
   "\nend-lilypond-output\n")
 
+(define (expression->string expr)
+  (eval expr this-module))
+
 (define (ez-ball ch letter-col ball-col)
   (string-append
    " (" ch ") "
@@ -228,9 +225,6 @@
   (string-append (numbers->string (list breapth width depth height))
 		 " draw_box"))
 
-(define (horizontal-line x1 x2 th)
-  (draw-line th x1  0 x2 0))
-
 (define (fontify name-mag-pair exp)
 
   (define (select-font name-mag-pair)
@@ -274,6 +268,9 @@
   ;   "\n /testing true def"
    ))
 
+(define (horizontal-line x1 x2 th)
+  (draw-line th x1  0 x2 0))
+
 (define (lily-def key val)
   (let ((prefix "lilypondpaper"))
     (if (string=?
@@ -282,84 +279,37 @@
 	(string-append "/" key " {" val "} bind def\n")
 	(string-append "/" key " (" val ") def\n"))))
 
-(define (no-origin) "")
-  
-(define (placebox x y s) 
-  (string-append 
-   (ly:number->string x) " " (ly:number->string y) " {" s "} place-box\n"))
-
-(define (repeat-slash wid slope thick)
-  (string-append
-   (numbers->string (list wid slope thick))
-   " draw_repeat_slash"))
-
-(define (round-filled-box x y width height blotdiam)
-   (string-append
-    " "
-    (numbers->string
-     (list x y width height blotdiam)) " draw_round_box"))
-
-(define (start-system width height)
-  (string-append
-   "\n" (ly:number->string height)
-   " start-system\n"
-   "{\n"
-   "set-ps-scale-to-lily-scale\n"))
-
-(define (stem breapth width depth height) 
-  (string-append
-   (numbers->string (list breapth width depth height))
-   " draw_box" ))
-
-(define (stop-last-system)
-  (stop-system))
-
-(define (stop-system)
-  "}\nstop-system\n")
-
-(define (text s)
-  (string-append "(" s ") show "))
 
-(define (unknown) 
-  "\n unknown\n")
+(define (make-title port)
+  (if header-stencil
+      (let ((x-ext (ly:stencil-get-extent header-stencil Y))
+	    (y-ext (ly:stencil-get-extent header-stencil X)))
+	(display (start-system (interval-length x-ext) (interval-length y-ext))
+		 port)
+	(output-stencil port (ly:stencil-get-expr header-stencil) '(0 . 0))
+	(display (stop-system) port)))
+  "")
 
-;; top-of-file, wtf?
-(define (top-of-file)
-  (header (string-append "GNU LilyPond (" (lilypond-version) "), ")
-          (strftime "%c" (localtime (current-time))))
-  ;;; ugh
-  (ps-string-def
-   "lilypond" 'tagline
-   (string-append "Engraved by LilyPond (" (lilypond-version) ")")))
+(define (no-origin) "")
 
+;; FIXME: duplictates output-scopes, duplicated in other backends
+;; FIXME: silly interface name
 (define (output-paper-def pd)
-  (apply
-   string-append
-   (module-map
-    (lambda (sym var)
-      (let ((val (variable-ref var))
-	    (key (symbol->string sym)))
-	
+  (let ((prefix "lilypondpaper"))
+    
+    (define (scope-entry->string key var)
+      (let ((val (variable-ref var)))
 	(cond
-	 ((string? val)
-	  (ps-string-def "lilypondpaper" sym val))
-	 ((number? val)
-	  (ps-number-def "lilypondpaper" sym
-			 (if (integer? val)
-			     (number->string val)
-			     (number->string (exact->inexact val)))))
+	 ((string? val) (ps-string-def prefix key val))
+	 ((number? val) (ps-number-def prefix key val))
 	 (else ""))))
       
-    (ly:output-def-scope pd))))
-
-
-(define (ps-string-def a b c)
-  (string-append "/" a (symbol->string b) " (" c ") def\n"))
-
-(define (ps-number-def a b c)
-  (string-append "/" a (symbol->string b) " " c " def\n"))
-
+    (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)
 
   ;; FIXME: customise/generate these
@@ -370,25 +320,25 @@
 		  (font-style . roman)
 		  (font-shape . upright)
 		  (font-size . 0))))
-	(stencils '())
+	(prefix "lilypond")
+    	(stencils '())
 	(baseline-skip 2))
 
-    (define (output-scope-entry sym var)
-      (let ((val (variable-ref var))
-	    (tex-key (symbol->string sym)))
+    (define (scope-entry->string key var)
+      (let ((val (variable-ref var)))
 	
-	(if (memq sym fields)
-	    (header-to-file basename sym val))
+	(if (memq key fields)
+	    (header-to-file basename key val))
 	
 	(cond
-	 ((eq? sym 'font)
+	 ((eq? key 'font)
 	  BARF
 	  (format (current-error-port) "PROPS:~S\n" val)
 	  (set! props (cons val props))
 	  "")
 	 
 	 ;; define strings, for /make-lilypond-title to pick up
-	 ((string? val) (ps-string-def "lilypond" sym val))
+	 ((string? val) (ps-string-def prefix key val))
 	 
 	 ;; generate stencil from markup
 	 ((markup? val) (set! stencils
@@ -397,15 +347,11 @@
 			       (list
 				(interpret-markup paper props val))))
 	  "")
-	 ((number? val) (ps-number-def
-			 "lilypond" sym (if (integer? val)
-					    (number->string val)
-					    (number->string
-					     (exact->inexact val)))))
+	 ((number? val) (ps-number-def prefix key val))
 	 (else ""))))
     
     (define (output-scope scope)
-      (apply string-append (module-map output-scope-entry scope)))
+      (apply string-append (module-map scope-entry->string scope)))
 
     (let ((s (string-append (apply string-append (map output-scope scopes)))))
       (set! header-stencil (stack-lines DOWN 0 baseline-skip stencils))
@@ -414,20 +360,6 @@
       (ly:stencil-get-expr header-stencil)
       s)))
 
-(define (offset-add a b)
-  (cons (+ (car a) (car b))
-	(+ (cdr a) (cdr b))))
-
-(define (make-title port)
-  (if header-stencil
-      (let ((x-ext (ly:stencil-get-extent header-stencil Y))
-	    (y-ext (ly:stencil-get-extent header-stencil X)))
-	(display (start-system (interval-length x-ext) (interval-length y-ext))
-		 port)
-	(output-stencil port (ly:stencil-get-expr header-stencil) '(0 . 0))
-	(display (stop-system) port)))
-  "")
-
 ;; hmm, looks like recursing call is always last statement, does guile
 ;; think so too?
 (define (output-stencil port expr offset)
@@ -449,3 +381,78 @@
 	  (display (placebox (car offset) (cdr offset)
 			     (expression->string expr)) port))))))
 
+(define (placebox x y s) 
+  (string-append 
+   (ly:number->string x) " " (ly:number->string y) " {" s "} place-box\n"))
+
+(define (polygon points blotdiameter)
+  (string-append
+   " "
+   (numbers->string points)
+   (ly:number->string (/ (length points) 2))
+   (ly:number->string blotdiameter)
+   " draw_polygon"))
+
+(define (repeat-slash wid slope thick)
+  (string-append
+   (numbers->string (list wid slope thick))
+   " draw_repeat_slash"))
+
+(define (round-filled-box x y width height blotdiam)
+   (string-append
+    " "
+    (numbers->string
+     (list x y width height blotdiam)) " draw_round_box"))
+
+(define (symmetric-x-triangle thick w h)
+  (string-append
+   (numbers->string (list h w thick))
+   " draw_symmetric_x_triangle"))
+
+(define (start-system width height)
+  (string-append
+   "\n" (ly:number->string height)
+   " start-system\n"
+   "{\n"
+   "set-ps-scale-to-lily-scale\n"))
+
+(define (stem breapth width depth height) 
+  (string-append
+   (numbers->string (list breapth width depth height))
+   " draw_box" ))
+
+(define (stop-last-system)
+  (stop-system))
+
+(define (stop-system)
+  "}\nstop-system\n")
+
+(define (text s)
+  (string-append "(" (escape-parentheses s) ") show "))
+
+;; top-of-file, wtf?
+(define (top-of-file)
+  (header (string-append "GNU LilyPond (" (lilypond-version) "), ")
+          (strftime "%c" (localtime (current-time))))
+  ;;; ugh
+  (ps-string-def
+   "lilypond" 'tagline
+   (string-append "Engraved by LilyPond (" (lilypond-version) ")")))
+
+(define (unknown) 
+  "\n unknown\n")
+
+(define (zigzag-line centre? zzw zzh thick dx dy)
+  (string-append
+    (if centre? "true" "false")
+    " "
+    (ly:number->string zzw)
+    " "
+    (ly:number->string zzh)
+    " "
+    (ly:number->string thick)
+    " 0 0 "
+    (ly:number->string dx)
+    " "
+    (ly:number->string dy)
+    " draw_zigzag_line "))