]> git.donarmstrong.com Git - lilypond.git/commitdiff
* scm/sodipodi.scm: Add more output functions.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 24 Nov 2002 17:01:33 +0000 (17:01 +0000)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 24 Nov 2002 17:01:33 +0000 (17:01 +0000)
* mf/feta-nummer.mf:
* mf/feta-beugel.mf: Add font_coding_scheme.

* lily/paper-outputter.cc (output_header): Fix creator string.

ChangeLog
lily/paper-outputter.cc
ly/declarations-init.ly
ly/engraver-init.ly
mf/feta-beugel.mf
mf/feta-nummer.mf
mf/parmesan-generic.mf
scm/ps.scm
scm/sodipodi.scm

index 8377de06dd7e2003d5abce3b36c2c1d0c8a78889..81e0da51e9043eda2c2f473b4078dc33b17a8ea8 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2002-11-24  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+       * scm/sodipodi.scm: Add more output functions.
+
+       * mf/feta-nummer.mf: 
+       * mf/feta-beugel.mf: Add font_coding_scheme.
+
+       * lily/paper-outputter.cc (output_header): Fix creator string.
+
 2002-11-23  Heikki Junes <hjunes@cc.hut.fi>
 
        * lilypond-mode.el (LilyPond-autocompletion): invoked with
index 1ecba007553c43b3e79a25519cdc8f7d2b16d8a4..45001766d64fe4cf5d1c700a58dae6e205271711 100644 (file)
@@ -59,19 +59,21 @@ Paper_outputter::~Paper_outputter ()
 void
 Paper_outputter::output_header ()
 {
-  String       generate = _ (", at ");
   time_t t (time (0));
-  generate += ctime (&t);
-  generate = generate.left_string (generate.length () - 1);
+  String generate = ctime (&t);
+  generate = generate.left_string (generate.length () - 1) + " " + *tzname;
   
-  /*
-    Make fixed length time stamps
-   */
-  generate = generate + to_string (' ' * (120 - generate.length ())>? 0)  ;
-  String creator = "lelie";
+  /* Fixed length time stamp */
+  generate = generate + to_string (' ', (50 - generate.length ()) >? 0);
+  
+  /* Fixed length creator string */
+  String creator = gnu_lilypond_version_string ();
+  creator += " (http://lilypond.org)";
+  creator = creator + to_string (' ', (50 - creator.length ()) >? 0);
   
   SCM args_scm = scm_list_n (scm_makfrom0str (creator.to_str0 ()),
-                            scm_makfrom0str (generate.to_str0 ()), SCM_UNDEFINED);
+                            scm_makfrom0str (generate.to_str0 ()),
+                            SCM_UNDEFINED);
 
 
   SCM scm = gh_cons (ly_symbol2scm ("header"), args_scm);
index cec3097a7f7dc24eb1ff211ed1b1eeb430ad3096..4526287cfa2ea43361b2ecfda3d317d289a06932 100644 (file)
@@ -59,7 +59,7 @@ paperfile = \papersize + "-init.ly"
 
 
 % reset default duration
-unusedEntry = \notes { c4 }    
+unusedEntry = \notes { c4 }
 
 % music = "\melodic\relative c"
 
index 22d48f70a8ffd1a46292ecc1be0c670d4a8413ed..7058c1de0718c83d48ebd3e103eade58d2401515 100644 (file)
@@ -251,7 +251,7 @@ StaffGroupContext = \translator {
 LyricsVoiceContext= \translator{
        \type "Engraver_group_engraver"
        \consistsend "Axis_group_engraver"
-       minimumVerticalExtent = #(cons -1.2 1.2)
+       minimumVerticalExtent = #'(-1.2 . 1.2)
        extraVerticalExtent = ##f
        verticalExtent = ##f 
        \name LyricsVoice 
@@ -281,8 +281,9 @@ NoteNamesContext = \translator {
 LyricsContext = \translator {
        \type "Engraver_group_engraver"
        \name Lyrics
-       \consists Vertical_align_engraver %need this for getting folded repeats right.
-
+       
+       %% To get folded repeats right.
+       \consists Vertical_align_engraver 
 
        \consistsend "Axis_group_engraver"
        minimumVerticalExtent = ##f
@@ -388,9 +389,8 @@ ScoreContext = \translator {
        systemStartDelimiter =#'SystemStartBar
 
 
-       %  name, glyph id, clef position 
-       % where is c0 in this clef?
-
+       %% name, glyph id, clef position 
+       %% where is c0 in this clef?
        clefGlyph = #"clefs-G"
        clefPosition = #-2
        centralCPosition = #-6
@@ -412,8 +412,10 @@ ScoreContext = \translator {
        pedalSustainStrings = #'("Ped." "*Ped." "*")
        pedalUnaCordaStrings = #'("una corda" "" "tre corde")
 
-       %% these are in ordinary italic font, including the *, but they are unlikely to be used, 
-       %% as the default pedal-style for SostenutoPedal is 'mixed': i.e.  Sost. Ped_____________________ 
+       %% These are in ordinary italic font, including the *,
+       %% but they are unlikely to be used, 
+       %% as the default pedal-style for SostenutoPedal is 'mixed':
+       %% i.e.  Sost. Ped_____________________ 
        pedalSostenutoStrings = #'("Sost. Ped." "*Sost. Ped." "*") 
 
        tupletNumberFormatFunction = #denominator-tuplet-formatter
index 8f779e1c6894a129cc70ef503c45f2d59eff9d24..61ec9abec0624cf8b284d2ba0cb511abf1077ce3 100644 (file)
@@ -2,6 +2,9 @@ input feta-autometric;
 input feta-macros;
 input feta-params;
 
+font_coding_scheme "feta braces";
+
+
 fet_beginfont("feta-braces", 16);
 mode_setup;
 
index bdefb0680915385c93651b05ab0abc388d74e9c8..c7c24fdf29dfaaf9e8898d1a7c9c733ec601e0a2 100644 (file)
@@ -20,6 +20,7 @@ space# := design_size/2;
 
 font_x_height height#;
 font_normal_space space#;
+font_coding_scheme "feta number";
 
 
 %
index 4ded9c8c04ceadc58d3f7256e7444256cc903606..b7e699bd7220a5f814c9ed59515583f3535b77dd 100644 (file)
@@ -1,3 +1,4 @@
+
 % -*-Fundamental-*-
 % parmesan-generic.mf --  implement generic stuff: include lots of files,
 % but don't set dims.
index 29d14c0e5b4229c2cd93fe0436a98addb4939859..f46dcf475f909c58f1fc89497a55641aa850a06c 100644 (file)
     (numbers->string
      (list x y width height blotdiam)) " draw_round_box"))
 
-;; TODO: use HEIGHT argument
 (define (start-system width height)
   (string-append
    "\n" (ly:number->string height)
index 7a12ac9f69de19c407df5e1ecd9df491dfe7496f..b062660d4feab6794d72fa9474e980ca148759c1 100644 (file)
@@ -4,15 +4,17 @@
 ;;;; 
 ;;;; (c) 1998--2002 Jan Nieuwenhuizen <janneke@gnu.org>
 
-;;;; NOTE that Sodipodi
+;;;; NOTE:
 ;;;;
-;;;;  * dumps core on displaying feta characters
-;;;;  * needs PFBs (ie, not PFAs like sketch)
-;;;;  * must have (LilyPond/feta) fonts registered through GNOME's
-;;;;    gnome-font-install (ie, not through X11, like sketch and xfontsel),
-;;;;    which in turn is very picky about afm files
-;;;;  * has it's own svg-like language: possibly this file should be
-;;;;    moved to svg.scm
+;;;; * Get mftrace 1.0.12 or newer
+
+;;;; * Get sodipodi-cvs from 2002-11-23 or newer
+;;;;
+;;;; * Put in your ~/.sodipodi/private-fonts:
+;;;;     mf/out/parmesan20.pfa,LilyPond Parmesan,LilyPond,
+;;;;     mf/out/feta-nummer10.pfa,LilyPond Nummer,LilyPond,
+;;;;     mf/out/feta20.pfa,LilyPond Feta,LilyPond,
+
 
 
 (debug-enable 'backtrace)
 ;; Global vars
 
 (define output-scale 1)
+(define system-x 1)
+(define system-y 0)
+(define line-thickness 0.1)
+(define half-lt (/ line-thickness 2))
+
 
 (define scale-to-unit
   (cond
    string "\n</" tag ">\n"))
 
 
-;; Interface functions
-
-(define (char i)
-  (if (or
-       #t
-       (= i #x9)
-       (= i #xa)
-       (= i #xd)
-       (>= i #x20))
-      ;;(tagify "tspan" (format #f "&#x~2,'0x;" i))
-      (tagify "tspan" (format #f "&#xe0~2,'0x;" i))
-      ;; how to access remaining characters??
-      ;;;(tagify "tspan" (format #f "&#x~2,'0x;" #x20)
-      (begin
-       (format #t "can't display char: ~x\n" i)
-       " ")))
+(define (ascii->string i) (make-string 1 (integer->char i)))
+(define (ascii->upm-string i)
+  (let* ((i+1 (+ i 1))
+        (u1 #xee)
+        (u2 (+ #x80 (quotient i+1 #x40)))
+        (u3 (+ #x80 (modulo i+1 #x40))))
+    (apply string-append
+          (map ascii->string
+               (list u1 u2 u3)))))
 
-(define (end-output)
-  "</g></svg>")
+(define (control->list c)
+  (list (car c) (cdr c)))
 
-
-(define (filledbox breapth width depth height)
-  (tagify "rect" ""
-
-         '(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-opacity:1;stroke-width:1pt;stroke-linejoin:miter;stroke-linecap:butt;")
-         `(x . ,(number->string (* output-scale (- 0 breapth))))
-         `(y . ,(number->string (* output-scale (- 0 height))))
-         `(width . ,(number->string (* output-scale (+ breapth width))))
-         `(height . ,(number->string (* output-scale (+ depth height))))))
-
-
-(define font-alist '(("feta13" . ("LilyPond-Feta13" . "13"))
-                    ("feta20" . "fill:black;stroke:none;font-family:lilypond;font-style:feta;font-weight:normal;font-size:20;fill-opacity:1;stroke-opacity:1;stroke-width:1pt;stroke-linejoin:miter;stroke-linecap:butt;text-anchor:start;writing-mode:lr;")
-                    ("parmesan20" . "fill:black;stroke:none;font-family:lilypond;font-style:parmesan;font-weight:normal;font-size:20;fill-opacity:1;stroke-opacity:1;stroke-width:1pt;stroke-linejoin:miter;stroke-linecap:butt;text-anchor:start;writing-mode:lr;")
-                    ))
-(define (get-font name-mag-pair)
-  ;; name-mag-pair: (quote ("feta20" . 0.569055118110236))"feta20"(quote ("feta20" . 0.569055118110236))
-  (let ((f (assoc (caadr name-mag-pair) font-alist)))
-    (if (pair? f)
-       (cdr f)
-       (begin
-         (format #t "font not found: ~s\n" (caadr name-mag-pair))
-         (cdr (assoc "feta20" font-alist))))))
-
-(define (fontify name-mag-pair expr)
+(define (control->string c)
   (string-append
-   (tagify "text" (dispatch expr) (cons 'style (get-font name-mag-pair)))))
+   (number->string (* output-scale (car c))) ","
+   (number->string (* -1 (* output-scale (cdr c)))) " "))
 
+(define (control-flip-y c)
+  (cons (car c) (* -1 (cdr c))))
 
-(define (header creator generate)
+(define (numbers->string l)
+  (string-append
+   (number->string (car l))
+   (if (null? (cdr l))
+       ""
+       (string-append ","  (numbers->string (cdr l))))))
+
+(define (svg-bezier l)
+  (let* ((c0 (car (list-tail l 3)))
+        (c123 (list-head l 3)))
+    (string-append
+     "M " (control->string c0)
+     "C " (apply string-append (map control->string c123)))))
+     
+        
+(define xml-header
 "<?xml version='1.0' standalone='no'?>
 <!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 20010904//EN'
 'http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd'
  <!ATTLIST svg
  xmlns:xlink CDATA #FIXED 'http://www.w3.org/1999/xlink'>
 ]>
-<!-- Created with Sodipodi ('http://www.sodipodi.com/') -->
-<svg
+"
+;;"
+)
+
+(define svg-header
+"<svg
    id='svg1'
    sodipodi:version='0.26'
    xmlns='http://www.w3.org/2000/svg'
   ")
 
 
-(define (placebox x y expr)
-  (tagify "g" (dispatch expr) `(transform .
-                                         ,(string-append
-                                           "translate(" (number->string
-                                                         (* output-scale x))
-                                           ","
-                                           (number->string (- 0 (* output-scale y)))
-                                           ")"))))
-                                
+
+;; Interface functions
+
+(define (sqr x)
+  (* x x))
+
+(define (beam width slope thick)
+  (let* ((x width)
+        (y (* slope width))
+        (z (sqrt (+ (sqr x) (sqr y)))))
+    (tagify "rect" ""
+
+         '(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-opacity:1;stroke-width:1pt;stroke-linejoin:miter;stroke-linecap:butt;")
+         `(x . ,(number->string (* output-scale half-lt)))
+         `(y . ,(number->string (* output-scale (- half-lt (/ thick 2)))))
+         `(width . ,(number->string (* output-scale width)))
+         `(height . ,(number->string (* output-scale thick)))
+;;       `(ry . ,(number->string (* output-scale half-lt)))
+         `(ry . ,(number->string line-thickness))
+         `(transform . ,(format #f "matrix(~f,~f,0,1,0,0)"
+                                (/ x z)
+                                (* -1 (/ y z)))))))
+
+;; TODO: bezier-ending, see ps.scm
+(define (bezier-bow l thick)
+  (bezier-sandwich l thick))
+
+(define (bezier-sandwich l thick)
+  (let* ((urg (eval l this-module))
+        (first (list-tail urg 4))
+        (second (list-head urg 4)))
+    (string-append
+     "<path\n"
+     "style='stroke-width:"
+     (number->string (* output-scale line-thickness)) ";'\n"
+     "d='"
+     (svg-bezier first)
+     (svg-bezier second)
+     "'/>\n")))
+  
+(define (char i)
+  (if #t
+      ;;(tagify "tspan" (format #f "&#xe0~2,'0x;" i))
+      (tagify "tspan" (ascii->upm-string i))
+      (begin
+       (format #t "can't display char: ~x\n" i)
+       " ")))
+
+
+(define (comment s)
+  (string-append "<!-- " s " -->\n"))
+
+(define (define-fonts internal-external-name-mag-pairs)
+  (comment (format #f "Fonts used: ~S" internal-external-name-mag-pairs)))
+
+(define (end-output)
+  "</g></svg>")
+
+(define (filledbox breapth width depth height)
+  (roundfilledbox breapth width depth height line-thickness))
+
+(define font-cruft
+  "fill:black;stroke:none;font-style:normal;font-weight:normal;text-anchor:start;writing-mode:lr;")
+
+;; FIXME
+(define font-alist
+  `(  
+    ("cmr8" . ,(string-append
+                 font-cruft
+                 "font-family:cmr;font-size:8;"))
+    ("feta13" . ,(string-append
+                 font-cruft
+                 "font-family:LilyPond-Feta;font-size:13;"))
+    ("feta-nummer10" . ,(string-append
+                        font-cruft
+                        "font-family:LilyPond-Feta-nummer;font-size:13;"))
+    ("feta20" . ,(string-append
+                 font-cruft
+                 "font-family:LilyPond-Feta;font-size:20;"))
+    ("parmesan20" . ,(string-append
+                     font-cruft
+                     "font-family:LilyPond-Parmesan;font-size:20;"))))
+
+(define (get-font name-mag-pair)
+  ;; name-mag-pair: (quote ("feta20" . 0.569055118110236))"feta20"(quote ("feta20" . 0.569055118110236))
+  (let ((f (assoc (caadr name-mag-pair) font-alist)))
+    (if (pair? f)
+       (cdr f)
+       (begin
+         (format #t "font not found: ~s\n" (caadr name-mag-pair))
+         (cdr (assoc "feta20" font-alist))))))
+
+(define (fontify name-mag-pair expr)
+  (string-append
+   (tagify "text" (dispatch expr) (cons 'style (get-font name-mag-pair)))))
+
+(define (header-end)
+  (comment "header-end"))
+
+(define (header creator generate)
+  (string-append
+   xml-header
+   (comment creator)
+   (comment generate)
+   svg-header))
+  
+
 (define (lily-def key val)
   (if (equal? key "lilypondpaperoutputscale")
       ;; ugr
       (set! output-scale (* scale-to-unit (string->number val))))
   "")
 
+(define (no-origin)
+  "")
+
+
+(define (placebox x y expr)
+  (tagify "g" (dispatch expr)
+         `(transform .
+                     ,(string-append
+                       "translate("
+                       ;; urg
+                       ;; (number->string (* output-scale x))
+                       (number->string (* output-scale (+ system-x x)))
+                       ","
+                       ;; urg
+                       ;; (number->string (- 0 (* output-scale y)))
+                       (number->string (* output-scale (- system-y y)))
+                       ")"))))
+
+(define (roundfilledbox breapth width depth height blot-diameter)
+  (tagify "rect" ""
+
+         '(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-opacity:1;stroke-width:1pt;stroke-linejoin:miter;stroke-linecap:butt;")
+         `(x . ,(number->string (* output-scale (- 0 breapth))))
+         `(y . ,(number->string (* output-scale (- 0 height))))
+         `(width . ,(number->string (* output-scale (+ breapth width))))
+         `(height . ,(number->string (* output-scale (+ depth height))))
+         ;;`(ry . ,(number->string (* output-scale half-lt)))
+         `(ry . ,(number->string blot-diameter))))
 
+
+  
+;; TODO: use height, set scaling?
+(define (start-system width height)
+  (let ((y system-y))
+    ;;"<g tranform='translate(50,-250)'>
+  (set! system-y (+ system-y height))
+  ;;(format #f "<g tranform='translate(0,~1,'~f)'>" y)))
+  (string-append
+   "\n"
+   (comment "start-system")
+   (comment "URG, transform does not work!")
+   (format #f "<g tranform='translate(0.0,~f)'>\n" (* output-scale y)))))
+  
+(define (stop-system)
+  (string-append
+   "\n"
+   (comment "stop-system")
+   "</g>\n"))
+
+(define stop-last-system stop-system)
+
+(define (text s)
+  ;; to unicode or not?
+  (if #t
+      (tagify "tspan" s)
+      (tagify "tspan"
+             (apply string-appendb
+                    (map (lambda (x) (ascii->upm-string (char->integer x)))
+                         (string->list s))))))