From 952736abcb4ef09e4905fa37d525c72e6a09fe59 Mon Sep 17 00:00:00 2001
From: fred <fred>
Date: Wed, 27 Mar 2002 00:59:46 +0000
Subject: [PATCH] lilypond-1.3.145

---
 input/test/bagpipe.ly          |  7 +--
 lily/system-start-delimiter.cc |  9 ++++
 ly/paper-as5.ly                | 17 ++----
 ly/paper-as9.ly                | 18 ++-----
 ly/params-as.ly                | 20 ++-----
 mf/as-number1.af               |  8 +--
 mf/as-number4.af               |  8 +--
 scm/ascii-script.scm           | 96 +++++++++++++++++++++++++++++++---
 scm/font.scm                   | 37 ++++++-------
 scm/lily.scm                   | 14 +----
 scripts/as2text.scm            | 93 ++++++++++++++++++++------------
 11 files changed, 201 insertions(+), 126 deletions(-)

diff --git a/input/test/bagpipe.ly b/input/test/bagpipe.ly
index df732da9bf..6bea16c5ce 100644
--- a/input/test/bagpipe.ly
+++ b/input/test/bagpipe.ly
@@ -14,7 +14,7 @@
 
 	NoteHead \override #'font-relative-size = #-2
 	NoteHead \override #'font-relative-size = #-2	
-        Stem \override #'flag-style = ##f
+        Stem \override #'flag-style = #""
     % The following determines the length of stems without beams
     % default is between 2.8 and 4.0 depending on the number of flags
          Stem \override #'length = #6	
@@ -24,8 +24,9 @@
  
   }
   \translator { \StaffContext
-  	TimeSignature \override #'style = #"C4/4"
-  	TimeSignature \override #'visibility-function = #begin-of-line-visible
+  	TimeSignature \override #'style = #'C4/4
+%  	TimeSignature \override #'visibility-function = #begin-of-line-visible
+  	TimeSignature \override #'visibility-lambda = #begin-of-line-visible
   }	
 }
 
diff --git a/lily/system-start-delimiter.cc b/lily/system-start-delimiter.cc
index 5d4cb3d67a..811a4171e3 100644
--- a/lily/system-start-delimiter.cc
+++ b/lily/system-start-delimiter.cc
@@ -141,8 +141,17 @@ System_start_delimiter::brew_molecule (SCM smob)
 Molecule
 System_start_delimiter::staff_brace (Grob*me,Real y)  
 {
+
+  /*
+    FIXME: should look at afm/tfm file for dimensions.
+    
+    (This breaks ascii-art output: it hasn't got 255 symbols)
+   */
+
+  // ugrhn
   int lo = 0;
   int hi = 255;
+  
   Font_metric *fm = Font_interface::get_default_font (me);
   Box b;
 
diff --git a/ly/paper-as5.ly b/ly/paper-as5.ly
index 3ce1bf58af..78959978db 100644
--- a/ly/paper-as5.ly
+++ b/ly/paper-as5.ly
@@ -4,20 +4,13 @@
 
 paperAsFive = \paper {
 	staffheight = 5.\char;
-	%% aiai only have these:
-%{	
-	mf/as5.af
-	mf/as9.af
-	mf/as-braces5.af
-	mf/as-braces9.af
-	mf/as-dummy1.af
-	mf/as-dummy.af
-	mf/as-number1.af
-	mf/as-number4.af
-%}
+
+	\stylesheet #(as-make-style-sheet 'as5)
 	
-	\stylesheet #(make-style-sheet 'paper16)
+	\translator { \StaffContext barSize = \staffheight; }
 
+	% no beam-slope
+	%\translator { \VoiceContext beamHeight = #0; }
 	\include "params-as.ly";
 }
 
diff --git a/ly/paper-as9.ly b/ly/paper-as9.ly
index 828bb961d3..49e80c4b28 100644
--- a/ly/paper-as9.ly
+++ b/ly/paper-as9.ly
@@ -4,21 +4,13 @@
 
 paperAsNine = \paper {
 	staffheight = 9.\char;
-	%% aiai only have these:
-%{	
-	mf/as5.af
-	mf/as9.af
-	mf/as-braces5.af
-	mf/as-braces9.af
-	mf/as-dummy1.af
-	mf/as-dummy.af
-	mf/as-number1.af
-	mf/as-number4.af
-%}
-	\stylesheet #(make-style-sheet 'paper16)
-	
+
+	%\translator { \StaffContext barSize = \staffheight; }
+
+	\stylesheet #(as-make-style-sheet 'as9)
 
 	\include "params-as.ly";
+	
 }
 
 \paper { \paperAsNine }
diff --git a/ly/params-as.ly b/ly/params-as.ly
index 78deb13655..2d2a6fb83c 100644
--- a/ly/params-as.ly
+++ b/ly/params-as.ly
@@ -1,29 +1,15 @@
 % params-as.ly
 % generic paper parameters
 
-%%paperfile = \papersize + ".ly";
-%%% paperfile = "a4.ly";
-%%\include \paperfile;
-%hsize = 60.0\char;
-%vsize = 60.0\char;  %?
+outputscale = \staffheight / 4.0;
 
-%%\include "paper.ly";
-linewidth = 60.0\char;
-textheight = 60.0\char;
+linewidth = 60.0 \char;
+textheight = 60.0 \char;
 indent = 8.0\char;
 
 staffspace = (\staffheight - 1.0 ) / 4.0;
 stafflinethickness = \staffspace / 2.0;
 
-% paperfile = "a4.ly";
-%\include \paperfile;
-%\include "paper.ly";
-
-%staffspace = \staffheight / 4.0;
-%stafflinethickness = \staffspace / 10.0;
-
-outputscale = \staffheight / 4.0;
-
 \translator { \NoteNamesContext }
 \translator { \ScoreContext }
 \translator { \ChoirStaffContext }
diff --git a/mf/as-number1.af b/mf/as-number1.af
index dbcf6cc2a6..78fb1dce5c 100644
--- a/mf/as-number1.af
+++ b/mf/as-number1.af
@@ -35,13 +35,13 @@
 4
  C 53; WX 1; N Numeral-5; B 0 0 1000 1000;
 5
- C 53; WX 1; N Numeral-6; B 0 0 1000 1000;
+ C 54; WX 1; N Numeral-6; B 0 0 1000 1000;
 6
- C 53; WX 1; N Numeral-7; B 0 0 1000 1000;
+ C 55; WX 1; N Numeral-7; B 0 0 1000 1000;
 7
- C 53; WX 1; N Numeral-8; B 0 0 1000 1000;
+ C 56; WX 1; N Numeral-8; B 0 0 1000 1000;
 8
- C 53; WX 1; N Numeral-9; B 0 0 1000 1000;
+ C 57; WX 1; N Numeral-9; B 0 0 1000 1000;
 9
 	EndCharMetrics
 	EndFontMetrics %d
diff --git a/mf/as-number4.af b/mf/as-number4.af
index 8e58b1b5b1..82d9ea9feb 100644
--- a/mf/as-number4.af
+++ b/mf/as-number4.af
@@ -58,22 +58,22 @@ ___|_
 (___
     \
 .___/
- C 53; WX 1; N Numeral-6; B 0 1000 5000 5000;
+ C 54; WX 1; N Numeral-6; B 0 1000 5000 5000;
   ___
  /__
 /   \
 \___/
- C 53; WX 1; N Numeral-7; B 0 1000 5000 5000;
+ C 55; WX 1; N Numeral-7; B 0 1000 5000 5000;
 ____
    /
  -/-
  /
- C 53; WX 1; N Numeral-8; B 0 1000 5000 5000;
+ C 56; WX 1; N Numeral-8; B 0 1000 5000 5000;
   __
  (__)
 /    \
 \____/
- C 53; WX 1; N Numeral-9; B 0 1000 5000 5000;
+ C 57; WX 1; N Numeral-9; B 0 1000 5000 5000;
  ___
 /   \
 \___/
diff --git a/scm/ascii-script.scm b/scm/ascii-script.scm
index c2f45d67d5..ddbeacd7c1 100644
--- a/scm/ascii-script.scm
+++ b/scm/ascii-script.scm
@@ -1,6 +1,77 @@
 (debug-enable 'backtrace)
 
-;;;; AsciiScript as
+; (define cmr-alist
+;   '(("bold" . "as-dummy") 
+;     ("brace" . "as-braces")
+;     ("dynamic" . "as-dummy") 
+;     ("default" . "as-dummy") 
+;     ("feta" . "feta") 
+;     ("feta-1" . "feta") 
+;     ("feta-2" . "feta") 
+;     ("finger" . "as-number") 
+;     ("typewriter" . "as-dummy") 
+;     ("italic" . "as-dummy") 
+;     ("roman" . "as-dummy") 
+;     ("script" . "as-dummy") 
+;     ("large" . "as-dummy") 
+;     ("Large" . "as-dummy") 
+;     ("mark" . "as-number") 
+;     ("number" . "as-number") 
+;     ("timesig" . "as-number")
+;     ("volta" . "as-number"))
+; )
+
+
+(define as-font-alist-alist
+  '(
+    (as5 .
+	 (
+	  (feta16 . as5)
+	  (feta20 . as5)
+	  (feta-nummer6 . as-number1)
+	  (feta-nummer8 . as-number1)
+	  (feta-braces16 . as-braces9)
+	  (cmr7 . as-dummy)
+	  (cmr8 . as-dummy)
+	  (cmr10 . as-dummy)
+	  ))
+    (as9 .
+	 (
+	  (feta16 . as9)
+	  (feta20 . as9)
+	  (feta-nummer4 . as-number1)
+	  (feta-nummer8 . as-number4)
+	  (feta-braces16 . as-braces9)
+	  (cmr7 . as-dummy)
+	  (cmr8 . as-dummy)
+	  (cmr10 . as-dummy)
+	  (cmr12 . as-dummy)
+	 ))
+  ))
+
+(define (as-properties-to-font-name size fonts properties-alist-list)
+  (let* ((feta-name (properties-to-font-name fonts properties-alist-list))
+	 (as-font-alist (cdr (assoc size as-font-alist-alist)))
+	 (font (assoc (string->symbol feta-name) as-font-alist)))
+    (if font (symbol->string (cdr font))
+	(let ((e (current-error-port)))
+	  (newline e)
+	  (display "can't find font: " e)
+	  (write feta-name e)
+	  ;;(symbol->string size)
+	  "as-dummy"
+	  ))))
+
+;; FIXME: making a full style-sheet is a pain, so we parasite on
+;; paper16 and translate the result.
+;;
+(define (as-make-style-sheet size)
+  (let ((sheet (make-style-sheet 'paper16)))
+    (assoc-set! sheet 'properties-to-font
+		(lambda (x y) (as-properties-to-font-name size x y)))
+    sheet))
+
+;;;; AsciiScript as  -- ascii art output
 (define (as-scm action-name)
 
   (define (beam width slope thick)
@@ -32,7 +103,10 @@
 		      (func "rmove-to" (- dx 1) (if (< 0 dir) -1 0))
 		      (func "put" (if (< 0 dir) "\\\\" "/"))))))
 
-  (define (bracket arch_angle arch_width arch_height width height arch_thick thick)
+
+  (define (bracket arch_angle arch_width arch_height height arch_thick thick)
+    ;; width now fixed?
+    (let ((width 1))
 	  (string-append
 	   (func "rmove-to" (+ width 1) (- (/ height -2) 1))
 	   (func "put" "\\\\")
@@ -41,7 +115,7 @@
 	   (func "v-line" (+ height 1))
 	   (func "rmove-to" 0 (+ height 1))
 	   (func "put" "/")
-	   ))
+	   )))
 
   (define (char i)
     (func "char" i))
@@ -70,6 +144,10 @@
 		    (func "h-line" dx))))))
 
   (define (font-load-command name-mag command)
+   ;; (display "name-mag: ")
+   ;; (write name-mag)
+   ;; (display "command: ")
+   ;; (write command)
     (func "load-font" (car name-mag) (cdr name-mag)))
 
   (define (header creator generate) 
@@ -83,11 +161,13 @@
 	  (string-append "(define " key " " (arg->string val) ")\n"))
 
   (define (lily-def key val)
-	  (if 
-	   (or (equal? key "lilypondpaperlinewidth")
-	       (equal? key "lilypondpaperstaffheight"))
-	   (string-append "(define " key " " (arg->string val) ")\n")
-	   ""))
+    (if
+     ;; let's not have all bloody definitions
+     (or (equal? key "lilypondpaperlinewidth")
+	 (equal? key "lilypondpaperstaffheight")
+	 (equal? key "lilypondpaperoutputscale"))
+     (string-append "(define " key " " (arg->string val) ")\n")
+     ""))
 
   (define (no-origin) "")
   
diff --git a/scm/font.scm b/scm/font.scm
index 874e8fcc43..ecef130454 100644
--- a/scm/font.scm
+++ b/scm/font.scm
@@ -55,6 +55,7 @@
 ;; (also tried to vary the order of this list, with little effect)
 (define paper20-style-sheet-alist
   '(
+    ;; why are font-names strings, not symbols?
     ((3 medium upright number feta-nummer 13) . "feta-nummer13")
     ((2 medium upright number feta-nummer 13) . "feta-nummer13")
     ((1 medium upright number feta-nummer 11) . "feta-nummer11")
@@ -255,15 +256,17 @@
       )
   ))
 
+(define (wild-eq? x y)
+  (or (eq? x y)
+      (eq? x '*)
+      (eq? y '*)))
+       
 (define (font-qualifies? qualifiers font-desc)
   "does FONT-DESC satisfy QUALIFIERS?"
   (if (null? qualifiers) #t
-      (if (eq? (font-field (caar qualifiers) font-desc) (cdar qualifiers))
+      (if (wild-eq? (font-field (caar qualifiers) font-desc) (cdar qualifiers))
 	  (font-qualifies? (cdr qualifiers) font-desc)
-	  #f
-	  )
-	)
-  )
+	  #f)))
 
 (define (find-first-font qualifiers fonts)
   (if (null? fonts)
@@ -304,29 +307,27 @@ and warn if the selected font is not unique.
 (define (chain-assoc x alist-list)
   (if (null? alist-list)
       #f
-      (let* (
-	     (handle (assoc x (car alist-list)))
-	     )
+      (let* ((handle (assoc x (car alist-list))))
 	(if (pair? handle)
 	    handle
-	    (chain-assoc x (cdr alist-list))
-	    )
-	)
-      )
-  )
+	    (chain-assoc x (cdr alist-list))))))
 
 ;; TODO
 ;; the C++ version  in font-interface.cc is usually used.
+;;
+;; FIXME: this has silently been broken by the introduction
+;;        of wildcards in the font list.    
 (define (properties-to-font-name fonts properties-alist-list)
   (let*  (
 	  ;; change order to change priorities of qualifiers.
-	  (q-order    '(font-name font-family font-series font-shape font-design-size font-relative-size))
-	  (rawqualifiers (map (lambda (x) (chain-assoc x  properties-alist-list))
+	  (q-order '(font-name font-family font-series font-shape
+			       font-design-size font-relative-size))
+	  (rawqualifiers (map (lambda (x)
+				(chain-assoc x properties-alist-list))
 			      q-order))
 	  (qualifiers (filter-list pair? rawqualifiers))
-	  (selected     (find-first-font qualifiers fonts))
-	  (err (current-error-port))	  
-	  )
+	  (selected (find-first-font qualifiers fonts))
+	  (err (current-error-port)))
 
     (if (equal? selected "")
 	(begin
diff --git a/scm/lily.scm b/scm/lily.scm
index 1e6fab4f69..a84fbdf041 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -53,7 +53,7 @@
 
 ;;; Un-assorted stuff
 
-;; URG guile-1.3/1.4 compatibility
+;; URG guile-1.4/1.4.x compatibility
 (define (ly-eval x) (eval2 x #f))
 
 (define (sign x)
@@ -62,18 +62,6 @@
       (if (< x 0) -1 1)))
 
 
-;;(define major-scale
-;;  '(
-;;    (0 . 0)
-;;    (1 . 0)
-;;    (2 . 0)
-;;    (3 . 0)
-;;    (4 . 0)
-;;    (5 . 0)
-;;    (6 . 0)
-;;   ))
-
-
 (map (lambda (x) (eval-string (ly-gulp-file x)))
      '("output-lib.scm"
        "tex.scm"
diff --git a/scripts/as2text.scm b/scripts/as2text.scm
index b3d127a8ce..d9a41a0834 100644
--- a/scripts/as2text.scm
+++ b/scripts/as2text.scm
@@ -123,6 +123,8 @@ Options:
 
 (define first-line #t)
 
+(define scaling 1)
+
 ;; cursor
 (define cur-x 0)
 (define cur-y 0)
@@ -189,32 +191,38 @@ Options:
   (cond ((equal? new " ") old)
 	(else new)))
 
-(define (plot x y c)
-  (let ((ny (- (* -1 y) 1)))
-       (if (array-in-bounds? canvas ny x)
-	   (array-set! canvas (merge-chars (array-ref canvas ny x) c) ny x)
-	   (display (string-append "ouch: " (number->string x)  ","
-				   (number->string ny) "\n")))))
+(define (plot-raw x y c)
+  (if (array-in-bounds? canvas y x)
+      (array-set! canvas (merge-chars (array-ref canvas y x) c) y x)
+      (display (string-append "ouch: " (number->string x)  ","
+			      (number->string y) "\n")
+	       (current-error-port))))
+
+(define (plot x neg-y c)
+  (let ((y (- (* -1 neg-y) 1)))
+    (plot-raw (inexact->exact x) (inexact->exact y) c)))
 
 (define (plot-char c)
   (let ((bbox (car c))
-	(glyph (cadr c))) 
-       ;; BBox: (llx lly urx ury) * 1000
-       (let ((dx (inexact->exact (* .001 (car bbox))))
-	     ;(dy (inexact->exact (* .001 (cadr bbox))))
-	     (dy (inexact->exact (- (* .001 (cadddr bbox)) 1)))
-	     (len (length glyph)))
-	    ;;(display "Bbox: ") (display bbox) (newline)
-	    ;;(display "dy: ") (display dy) (newline)
-	    (do ((line glyph (cdr line))
-		 (i 0 (+ i 1)))
-		((= i len))
-		(plot-string (+ cur-x dx) (+ (- cur-y i) dy) (car line))))))
-
+	(glyph (cadr c))
+	(scur-x (* scaling cur-x))
+	(scur-y (* scaling cur-y)))
+    ;; BBox: (llx lly urx ury) * 1000
+    (let ((dx (inexact->exact (* .001 (car bbox))))
+	  ;;(dy (inexact->exact (* .001 (cadr bbox))))
+	  (dy (inexact->exact (- (* .001 (cadddr bbox)) 1)))
+	  (len (length glyph)))
+      ;;(display "Bbox: ") (display bbox) (newline)
+      ;;(display "dy: ") (display dy) (newline)
+      (do ((line glyph (cdr line))
+	   (i 0 (+ i 1)))
+	  ((= i len))
+	(plot-string (+ scur-x dx) (+ (- scur-y i) dy) (car line))))))
+  
 (define (plot-string x y s)
   (do ((i 0 (+ i 1)))
       ((= i (string-length s)))
-      (plot (+ x i) y (substring s i (+ i 1)))))
+    (plot (+ x i) y (substring s i (+ i 1)))))
 
 (define (show-char char)
   (display char))
@@ -274,7 +282,7 @@ Options:
 		   (assoc (+ n 0.5) font))
 	      (get-char font (+ n 0.5))
 	      (get-char font n))))
-	 (if c
+	 (if (pair? c)
 	     (plot-char c))))
 
 (define (end-output) 
@@ -286,16 +294,24 @@ Options:
   (close cur-output-file)
   (set! cur-output-file '()))
 
+;; use plot-string
 (define (h-line len)
-  (let ((step (sign len)))
-       (do ((i 0 (+ i step)))
-	   ((= i len))
-	   (plot (+ cur-x i) cur-y line-char))))
+  (let ((scur-x (* scaling cur-x))
+	(scur-y (* scaling cur-y))
+	(slen (* scaling len)))
+    (let ((step (sign len)))
+	  (do ((i 0 (+ i step)))
+	      ((= i slen))
+	    (plot (+ scur-x i) scur-y line-char)))))
 
 (define (v-line len)
-  (let ((step (sign len)))
-       (do ((i 0 (+ i step)))
-	   ((= i len)) (plot cur-x (+ cur-y i) line-char))))
+  (let ((scur-x (* scaling cur-x))
+	(scur-y (* scaling cur-y))
+	(slen (* scaling len)))
+    (let ((step (sign len)))
+      (do ((i 0 (+ i step)))
+	  ((= i len))
+	(plot scur-x (+ scur-y i) line-char)))))
 
 (define (header x y)
   ;(display (string-append x y "\n") (current-error-port))
@@ -303,6 +319,7 @@ Options:
 
 (define (header-end) "")
 
+;; FIXME: scale
 (define (rline-to dx dy)
   (plot (inexact->exact cur-x) (inexact->exact cur-y) line-char)
   (plot (inexact->exact (+ cur-x dx)) (inexact->exact (+ cur-y dy)) line-char)
@@ -378,11 +395,19 @@ Options:
       (begin
        (set! fonts (cons (cons "default" (generate-default-font)) fonts))
        (display "\n" (current-error-port))
-       (if (and (defined? 'lilypondpaperlinewidth)
-		(> (string->number lilypondpaperlinewidth) 0))
-	   (set! canvas-width 
-		 (inexact->exact (string->number lilypondpaperlinewidth))))))
-  (set! canvas-height height)
+       (if (defined? 'lilypondpaperoutputscale)
+	   (set! scaling (inexact->exact (string->number lilypondpaperoutputscale))))
+       (if (defined? 'lilypondpaperlinewidth)
+	   (let ((width (inexact->exact
+			 (string->number lilypondpaperlinewidth))))
+	     (if (> width 0)
+		 (set! canvas-width width)
+		 ;; need long line...
+		 ;;(set! canvas-width 200)
+		 (set! canvas-width 80)
+		 )))
+       ))
+  (set! canvas-height (inexact->exact (* scaling height)))
   (set! canvas (make-array " " canvas-height canvas-width)))
 
 (define (stop-line)
@@ -410,6 +435,6 @@ Options:
 	   ((= i n)) 
 	    (let* ((n (char->integer (string-ref s i)))
 		   (c (get-char font n)))
-		  (plot-char c)
+	      (if (pair? c) (plot-char c))
 		  (rmove-to (char-width c) 0)))))
 
-- 
2.39.5