Attached is a patch for fret-diagrams, including ChangeLog entries. The
patch does the following:

Cleans up font selection (label fonts for dots were previously broken)
Moves the labeled dots as low as possible.
Cleans up some outdated comments.
Better centers and sizes the white fonts on the black dots.

Thanks,

Carl
Index: ChangeLog
===================================================================
RCS file: /cvsroot/lilypond/lilypond/ChangeLog,v
retrieving revision 1.2300
diff -u -r1.2300 ChangeLog
--- ChangeLog	1 Jul 2004 21:36:09 -0000	1.2300
+++ ChangeLog	5 Jul 2004 18:57:24 -0000
@@ -1,3 +1,20 @@
+2004-07-02  Carl Sorensen  <[EMAIL PROTECTED]>
+
+	* scm/output-ps.scm (white-text): Add scale paramter to allow scaling
+
+	* scm/output-tex.scm (white-text): Add scale parameter to allow font scaling
+
+	* scm/stencil.scm (fontify-text-white) : Adjust to better center, properly
+	scale white text
+
+	* scm/fret-diagrams.scm (make-fret-diagram): change default dot position for numbered dots so dot will
+	touch fret.
+	(various routines): move to font-metric interface, rather than name, size interface.
+	Clean up comments.
+
+	* ps/music-drawing-routines.ps: (/draw_white_text)  Adjust font
+	size and offset to better center white text.
+
 2004-07-01  Jan Nieuwenhuizen  <[EMAIL PROTECTED]>
 
 	* scripts/abc2ly.py (try_parse_chord_delims): Bugfix: update to
Index: scm/fret-diagrams.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/fret-diagrams.scm,v
retrieving revision 1.9
diff -u -r1.9 fret-diagrams.scm
--- scm/fret-diagrams.scm	29 Jun 2004 07:27:03 -0000	1.9
+++ scm/fret-diagrams.scm	5 Jul 2004 18:57:25 -0000
@@ -5,9 +5,7 @@
 ;;;; (c) 2004 Carl D. Sorensen <[EMAIL PROTECTED]>
 
 (define ly:paper-lookup ly:output-def-lookup) ; compat for 2.3, remove  when using 2.2
-
-;;TODO -- Change font interface from name, magnification to family, weight, size
-;      Right now, using the desired interface gives an error, so we use name, magnification
+(define my-font-encoding 'TeX-text )
 
 (define (fret-parse-marking-list marking-list fret-count)
    (let* ((fret-range (list 1 fret-count))
@@ -122,30 +120,23 @@
                  (- size th) 0))) 
                  
 
-(define (centered-text-stencil procedure font text)
-"Create a centered text stencil of @var{text} in font @var{font} using stencil creation procedure @var{procedure}"
-;UGH -- version check is necessary because 2.3 is not available on cygwin, so CDS development
-;   needs 2.2 compatible ly:stencil-align-to!
-;   Once 2.3 is built on cygwin, version check can go (fret-diagrams.scm is not part of dist for 2.2)
-(let* ((text-stencil (procedure font text)))
-     (if (= (cadr (ly:version)) 3)
+(define (centered-stencil stencil)
+ "Center stencil @var{stencil} in both the X and Y directions"
+ (let* ((output-stencil stencil))
+;     (if (= (cadr (ly:version)) 3)
 	 (begin
-	   (ly:stencil-align-to! text-stencil Y 0)
-	   (ly:stencil-align-to! text-stencil X 0)
-	   text-stencil)
-	 (ly:stencil-align-to (ly:stencil-align-to text-stencil X 0) Y 0))))
+	   (ly:stencil-align-to! output-stencil Y 0)
+	   (ly:stencil-align-to! output-stencil X 0)
+	   output-stencil)))
+;	 (ly:stencil-align-to (ly:stencil-align-to text-stencil X 0) Y 0))))
 
-(define (draw-dots paper props string-count fret-range size finger-code dot-circle-font-mag dot-position dot-radius dot-list)
+(define (draw-dots paper props string-count fret-range size finger-code dot-position dot-radius dot-list)
   "Make dots for fret diagram."
-;TODO -- move away from name,magnification font spec to family, size
-;  Note -- family, size doesn't work with fontify-text procedure; need to fix that before we can make the switch
   (let* ((scale-dot-radius (* size dot-radius))
          (dot-color (chain-assoc-get 'dot-color props 'black))
          (finger-xoffset (chain-assoc-get 'finger-xoffset props -0.25))
          (finger-yoffset (chain-assoc-get 'finger-yoffset props (- size)))
-;part of deprecated font interface 
-         (label-font-name (chain-assoc-get 'label-font-name props "cmss8"))
-         (dot-label-font-mag (* scale-dot-radius (chain-assoc-get 'dot-label-font-mag props 1.2)))
+         (dot-label-font-mag (* scale-dot-radius (chain-assoc-get 'dot-label-font-mag props 1.0)))
          (string-label-font-mag (* size (chain-assoc-get 'string-label-font-mag props 0.6)))
          (fret-count (+ (- (cadr fret-range) (car fret-range) 1)))
          (mypair (car dot-list))
@@ -157,24 +148,10 @@
          (extent (cons (- scale-dot-radius) scale-dot-radius))
          (finger (caddr mypair))
          (finger (if (number? finger) (number->string finger) finger))
-; desired font interface
-          (string-label-font (ly:paper-get-font paper `(((font-family . sans)(font-encoding . latin1)(font-series . medium) (font-shape . upright)
-                                        (font-size . ,(stepmag (* size string-label-font-mag)))))))
-; deprecated font interface
-;         (string-label-font (ly:paper-get-font paper `(((font-magnification . ,string-label-font-mag)
-;                                                        (font-name . ,label-font-name)))))
-; desired font interface
-          (dot-label-font (ly:paper-get-font paper `(((font-family . sans)(font-encoding . latin1)(font-series . medium) (font-shape . upright)
-                                        (font-size . ,(stepmag (* size dot-label-font-mag)))))))
-; deprecated font interface
-;         (dot-label-font (ly:paper-get-text-font paper `(((font-magnification . ,dot-label-font-mag)
-;                                                     (font-name . ,label-font-name)))))
-; desired font interface
-          (dot-circle-font (ly:paper-get-font paper `(((font-family . sans)(font-encoding . latin1)(font-series . medium) (font-shape . upright)
-                                        (font-size . ,(stepmag (* size dot-circle-font-mag)))))))
-; deprecated font interface
-;         (dot-circle-font (ly:paper-get-font paper `(((font-magnification . ,dot-circle-font-mag)
-;                                                      (font-name . ,label-font-name)))))
+          (string-label-font (ly:paper-get-font paper `(((font-family . sans)(font-encoding . ,my-font-encoding)(font-series . medium) (font-shape . upright)
+                                        (font-size . ,(stepmag  string-label-font-mag))))))
+          (dot-label-font (ly:paper-get-font paper `(((font-family . sans)(font-encoding . ,my-font-encoding)(font-series . medium) (font-shape . upright)
+                                        (font-size . ,(stepmag  dot-label-font-mag))))))
          (dotstencil  (if (eq? dot-color 'white)
                           (begin
                           (ly:make-stencil (list 'white-dot 0 0 scale-dot-radius) extent extent))
@@ -186,12 +163,15 @@
                  (if (or (eq? finger '())(eq? finger-code 'none))
                      positioned-dot
                  (if (eq? finger-code 'in-dot)
-                    (let*  ((dot-proc (if (eq? dot-color 'white) 'white-dot 'dot))
-                            (text-proc (if (eq? dot-color 'white) fontify-text fontify-text-white)))
+                    (let*  ((dot-proc (if (eq? dot-color 'white) 'white-dot 'dot)))
                      (ly:stencil-add 
                         (ly:stencil-translate-axis 
                           (ly:stencil-translate-axis 
-                              (centered-text-stencil text-proc dot-label-font finger) xpos X)
+                              (if (eq? dot-color 'white)
+                              (centered-stencil (fontify-text dot-label-font finger))
+                              (centered-stencil (fontify-text-white dot-label-font-mag 
+                                                                    dot-label-font  finger)))
+                               xpos X)
                               ypos Y)
                         (ly:stencil-translate-axis
                            (ly:stencil-translate-axis 
@@ -203,30 +183,25 @@
                          positioned-dot
                          (ly:stencil-translate-axis 
                              (ly:stencil-translate-axis 
-                                 (centered-text-stencil fontify-text string-label-font finger) xpos  X)
+                                 (centered-stencil (fontify-text string-label-font finger)) xpos  X)
                              (* size finger-yoffset) Y))
                      ;unknown finger-code
                      positioned-dot)))))
     (if (null? restlist) 
         labeled-dot-stencil
         (ly:stencil-add 
-            (draw-dots paper props string-count fret-range size finger-code dot-circle-font-mag
+            (draw-dots paper props string-count fret-range size finger-code 
                           dot-position dot-radius restlist)
             labeled-dot-stencil))))
 
 (define (draw-xo paper props string-count fret-range size xo-list) 
 "Put open and mute string indications on diagram, as contained in @var{xo-list}."
-;TODO -- Move away from name,mag font spec to family, size
     (let* ((fret-count (+ (- (cadr fret-range) (car fret-range) 1)))
            (xo-font-mag (* size (chain-assoc-get 'xo-font-magnification props 0.5)))
-           (xo-font-name (chain-assoc-get 'xo-font-name props "cmss8"))
            (xo-horizontal-offset (* size (chain-assoc-get 'xo-horizontal-offset props -0.35)))
-; desired font interface
-;           (font (ly:paper-get-font paper `(((font-family . sans)(font-series . medium) (font-shape . upright)
-;                                        (font-size . ,(stepmag (* size xo-font-mag)))))))
-; deprecated font interface
-           (font (ly:paper-get-font paper `(((font-magnification . ,xo-font-mag)
-                                             (font-name . ,xo-font-name)))))
+           (font (ly:paper-get-font paper `(((font-encoding . ,my-font-encoding)(font-family . sans)
+                                        (font-series . medium) (font-shape . upright)
+                                        (font-size . ,(stepmag (* size xo-font-mag)))))))
            (mypair (car xo-list))
            (restlist (cdr xo-list))
            (glyph-string (if (eq? (car mypair) 'mute) "X" "O"))
@@ -251,7 +226,7 @@
        (list (cons x1 bottom-control-point-height) (cons x2 bottom-control-point-height) (cons right bottom) (cons left bottom)
              (cons x2 top-control-point-height) (cons x1 top-control-point-height) (cons left bottom) (cons right bottom))))
 
-(define (draw-barre paper props string-count fret-range size finger-code dot-circle-font-mag dot-position dot-radius barre-list)
+(define (draw-barre paper props string-count fret-range size finger-code dot-position dot-radius barre-list)
    "Create barre indications for a fret diagram"
    (if (not (null? barre-list))
      (let* ((string1 (caar barre-list))
@@ -277,7 +252,7 @@
                                   (cons bottom (+ bottom (* size bezier-height)))))))
         (if (not (null? (cdr barre-list)))
             (ly:stencil-add barre-stencil
-                 (draw-barre paper props string-count fret-range size finger-code dot-circle-font-mag
+                 (draw-barre paper props string-count fret-range size finger-code 
                       dot-position dot-radius (cdr barre-list)))
             barre-stencil ))))
 
@@ -288,24 +263,18 @@
 
 (define (label-fret paper props string-count fret-range size)
    "Label the base fret on a fret diagram"
-;TODO -- move away from name,magnification font spec to family, size
    (let* ((base-fret (car fret-range))
           (label-font-mag (chain-assoc-get 'fret-label-font-magnification props 0.7))
-;          (label-horizontal-offset (chain-assoc-get 'fret-label-horizontal-offset props -0.5))
           (label-vertical-offset (chain-assoc-get 'fret-label-vertical-offset props -0.2))
           (fret-count (+ (- (cadr fret-range) (car fret-range)) 1))
-; desired font interface
-;          (font (ly:paper-get-font paper `(((font-family . sans)(font-series . medium) (font-shape . upright)
-;                                        (font-size . ,(stepmag (* size label-font-mag))))))))
-; deprecated font interface
-          (font (ly:paper-get-font paper `(((font-magnification . ,label-font-mag)
-                                                      (font-name . "cmss8"))))))          
+          (font (ly:paper-get-font paper `(((font-encoding . ,my-font-encoding)(font-family . sans)
+                                            (font-series . medium) (font-shape . upright)
+                                            (font-size . ,(stepmag (* size label-font-mag))))))))
        (ly:stencil-translate-axis (fontify-text font (format #f "~(~:@r~)" base-fret)) 
                        (* size (+ fret-count label-vertical-offset)) Y)))
  
 (def-markup-command (fret-diagram-verbose paper props marking-list)
   (list?)
-;TODO -- put table in doc string
   "Make a fret diagram containing the symbols indicated in @var{marking-list}
   
   Syntax: \\fret-diagram   marking-list
@@ -353,10 +322,9 @@
          (fret-count (chain-assoc-get 'fret-count props 4)) ; needed for everything
          (finger-code (chain-assoc-get 'finger-code props 'none))  ; needed for both draw-dots and draw-barre
          (default-dot-radius (if (eq? finger-code 'in-dot) 0.45 0.25))  ; bigger dots if labeled
-         (default-dot-position (if (eq? finger-code 'in-dot) 0.5 0.6))  ; move up to make room for bigger if labeled
+         (default-dot-position (if (eq? finger-code 'in-dot) (- 1 default-dot-radius) 0.6))  ; move up to make room for bigger if labeled
          (dot-radius (chain-assoc-get 'dot-radius props default-dot-radius))  ; needed for both draw-dots and draw-barre
          (dot-position (chain-assoc-get 'dot-position props default-dot-position)) ; needed for both draw-dots and draw-barre
-         (dot-circle-font-mag (* size (chain-assoc-get 'dot-circle-font-mag props .75))) ; needed for both draw-dots and draw-barre
          (th (* (ly:paper-lookup paper 'linethickness)
                 (chain-assoc-get 'thickness props 0.5))) ; needed for both draw-frets and draw-strings
                 
@@ -373,12 +341,12 @@
                             (draw-frets paper props fret-range string-count th size))))
          (if (not (null? barre-list))
              (set! fret-diagram-stencil (ly:stencil-add
-                                    (draw-barre paper props string-count fret-range size finger-code dot-circle-font-mag 
+                                    (draw-barre paper props string-count fret-range size finger-code  
                                                 dot-position dot-radius barre-list)
                                     fret-diagram-stencil)))
          (if (not (null? dot-list))
              (set! fret-diagram-stencil (ly:stencil-add
-                                    (draw-dots paper props string-count fret-range size finger-code dot-circle-font-mag
+                                    (draw-dots paper props string-count fret-range size finger-code 
                                           dot-position dot-radius dot-list)
                                     fret-diagram-stencil)))
          (if (not (null? xo-list))
@@ -394,7 +362,6 @@
          
 (def-markup-command (fret-diagram paper props definition-string)
   (string?)
-;TODO -- put table in doc string
   "Syntax: \\fret-diagram definition-string
   
 eg: \\markup \\fret-diagram #\"s:0.75;6-x;5-x;4-o;3-2;2-3;1-2;\"
@@ -451,8 +418,6 @@
 @end itemize
     
 "
-;       (define new-props (acons 'size size '()))
-;       (set! props (cons new-props props))
        (let ((definition-list (fret-parse-definition-string props definition-string)))
        (make-fret-diagram paper (car definition-list) (cdr definition-list))))
 
@@ -462,10 +427,6 @@
   a fret-indication list with the appropriate values"
    (let* ((fret-count 4)
           (string-count 6)
-   ;       (thickness 0.05)
-   ;       (finger-code 0)
-   ;       (dot-size 0.25)
-   ;       (dot-position 0.6)
           (fret-range (list 1 fret-count))
           (barre-list '())
           (dot-list '())
@@ -529,7 +490,6 @@
            
 (def-markup-command (fret-diagram-terse paper props definition-string)
   (string?)
-;TODO -- put table in doc string
   "Make a fret diagram markup using terse string-based syntax.
 
 Syntax: \\fret-diagram-terse definition-string
@@ -574,7 +534,6 @@
     props, modified to include the string-count determined by the definition-string
     a fret-indication list with the appropriate values"
 ;TODO -- change syntax to  fret\string-finger
-;TODO -- fix bug that doesn't allow multiple indications per string
    (let* ((barre-start-list '())
           (output-list '())
           (new-props '())
@@ -591,11 +550,11 @@
                                   (max-element-index (- (length this-list) 1))
                                   (last-element (car (list-tail this-list max-element-index)))
                                   (fret (if (string->number (car this-list)) (string->number (car this-list)) (car this-list))))
-                               (if (equal? last-element "(") ; here I add ) to balance parentheses for my editor
+                               (if (equal? last-element "(")
                                    (begin
                                      (set! barre-start-list (cons-fret (list current-string fret) barre-start-list))
                                      (set! this-list (list-head this-list max-element-index))))
-                               (if (equal? last-element ")") ; here I add ( to balance parentheses for my editor
+                               (if (equal? last-element ")")
                                    (let* ((this-barre (get-sub-list fret barre-start-list))
                                           (insert-index (- (length this-barre) 1)))
                                      (set! output-list (cons-fret (cons* 'barre (car this-barre) current-string (cdr this-barre)) 
Index: scm/output-ps.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/output-ps.scm,v
retrieving revision 1.85
diff -u -r1.85 output-ps.scm
--- scm/output-ps.scm	29 Jun 2004 07:27:02 -0000	1.85
+++ scm/output-ps.scm	5 Jul 2004 18:57:26 -0000
@@ -253,8 +253,9 @@
     ))
   
 
-(define (white-text s)
-   (let ((mystring (string-append "(" s ")" " /Helvetica-bold" " draw_white_text")))
+(define (white-text scale s)
+   (let ((mystring (string-append "(" s  ") " (number->string scale)   " /Helvetica-bold "
+          " draw_white_text")))
   mystring))
 
 (define (unknown) 
Index: scm/output-tex.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/output-tex.scm,v
retrieving revision 1.65
diff -u -r1.65 output-tex.scm
--- scm/output-tex.scm	29 Jun 2004 07:27:01 -0000	1.65
+++ scm/output-tex.scm	5 Jul 2004 18:57:26 -0000
@@ -170,8 +170,8 @@
 			s))
 		   "}")))
 
-(define (white-text s)
-   (embedded-ps (list 'white-text s)))
+(define (white-text scale s)
+   (embedded-ps (list 'white-text scale s)))
    
 (define (tuplet ht gapx dx dy thick dir)
   (embedded-ps (list 'tuplet  ht gapx dx dy thick dir)))
Index: scm/stencil.scm
===================================================================
RCS file: /cvsroot/lilypond/lilypond/scm/stencil.scm,v
retrieving revision 1.8
diff -u -r1.8 stencil.scm
--- scm/stencil.scm	29 Jun 2004 07:27:01 -0000	1.8
+++ scm/stencil.scm	5 Jul 2004 18:57:26 -0000
@@ -81,8 +81,8 @@
     (ly:make-stencil
      `(text ,font-metric ,text) (car b) (cdr b))))
      
-(define-public (fontify-text-white font-metric text)
-  "Set TEXT with font FONT-METRIC, in color white, returning a stencil."
+(define-public (fontify-text-white scale font-metric text)
+  "Set TEXT with scale factor s"
   (let* ((b  (ly:text-dimension font-metric text))
-         (c  `(white-text ,text)))
+         (c  `(white-text ,(* 2 scale) ,text))) ;urg -- workaround for using ps font
     (ly:make-stencil c  (car b) (cdr b))))  ;urg -- extent is not from ps font, but we hope it's close
Index: ps/music-drawing-routines.ps
===================================================================
RCS file: /cvsroot/lilypond/lilypond/ps/music-drawing-routines.ps,v
retrieving revision 1.21
diff -u -r1.21 music-drawing-routines.ps
--- ps/music-drawing-routines.ps	29 Jun 2004 07:27:04 -0000	1.21
+++ ps/music-drawing-routines.ps	5 Jul 2004 18:57:26 -0000
@@ -153,12 +153,15 @@
 } bind def
 
 
-/draw_white_text % text font
+/draw_white_text  % text scale font
 {
   %font
-  findfont 0.8 scalefont setfont
+  findfont
+  %scale
+  exch scalefont setfont
   1 setgray
   0 0 moveto
+  %-0.05 -0.05 moveto
   % text
   show
 } bind def
_______________________________________________
lilypond-devel mailing list
[EMAIL PROTECTED]
http://lists.gnu.org/mailman/listinfo/lilypond-devel

Reply via email to