CVSROOT: /cvsroot/lilypond
Module name: lilypond
Branch: lilypond_2_6
Changes by: Han-Wen Nienhuys <[EMAIL PROTECTED]> 05/10/09 21:57:12
Modified files:
. : ChangeLog
lily : general-scheme.cc
ly : engraver-init.ly
scm : ps-to-png.scm
Log message:
(make-ps-images): backport: make PS images
without globbing.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/lilypond/lilypond/ChangeLog.diff?only_with_tag=lilypond_2_6&tr1=1.3836.2.37&tr2=1.3836.2.38&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/lilypond/lilypond/lily/general-scheme.cc.diff?only_with_tag=lilypond_2_6&tr1=1.21&tr2=1.21.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/lilypond/lilypond/ly/engraver-init.ly.diff?only_with_tag=lilypond_2_6&tr1=1.236.2.1&tr2=1.236.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/lilypond/lilypond/scm/ps-to-png.scm.diff?only_with_tag=lilypond_2_6&tr1=1.12&tr2=1.12.2.1&r1=text&r2=text
Patches:
Index: lilypond/ChangeLog
diff -u lilypond/ChangeLog:1.3836.2.37 lilypond/ChangeLog:1.3836.2.38
--- lilypond/ChangeLog:1.3836.2.37 Sun Oct 9 08:02:16 2005
+++ lilypond/ChangeLog Sun Oct 9 21:57:11 2005
@@ -1,3 +1,8 @@
+2005-10-09 Han-Wen Nienhuys <[EMAIL PROTECTED]>
+
+ * scm/ps-to-png.scm (make-ps-images): backport: make PS images
+ without globbing.
+
2005-10-09 Jan Nieuwenhuizen <[EMAIL PROTECTED]>
* flower/file-name.cc (dos_to_posix)[__CYGWIN__]: Return
Index: lilypond/lily/general-scheme.cc
diff -u /dev/null lilypond/lily/general-scheme.cc:1.21.2.1
--- /dev/null Sun Oct 9 21:57:13 2005
+++ lilypond/lily/general-scheme.cc Sun Oct 9 21:57:12 2005
@@ -0,0 +1,317 @@
+/*
+ lily-guile.cc -- implement assorted Guile bindings
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 1998--2005 Jan Nieuwenhuizen <[EMAIL PROTECTED]>
+ Han-Wen Nienhuys <[EMAIL PROTECTED]>
+*/
+
+#include "config.hh"
+
+#include <math.h> /* isinf */
+#include <stdio.h>
+#include <string.h> /* memset */
+
+#include "international.hh"
+#include "libc-extension.hh"
+#include "lily-guile.hh"
+#include "string.hh"
+#include "misc.hh"
+#include "warn.hh"
+#include "version.hh"
+#include "dimensions.hh"
+#include "main.hh"
+#include "file-path.hh"
+
+/* MacOS S fix:
+ source-file.hh includes cmath which undefines isinf and isnan
+*/
+#ifdef __APPLE__
+inline int my_isinf (Real r) { return isinf (r); }
+inline int my_isnan (Real r) { return isnan (r); }
+#endif
+
+LY_DEFINE (ly_find_file, "ly:find-file",
+ 1, 0, 0, (SCM name),
+ "Return the absolute file name of @var{name}, "
+ "or @code{#f} if not found.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__,
"string");
+
+ String nm = ly_scm2string (name);
+ String file_name = global_path.find (nm);
+ if (file_name.is_empty ())
+ return SCM_BOOL_F;
+
+ return scm_makfrom0str (file_name.to_str0 ());
+}
+
+/*
+ Ugh. Gulped file is copied twice. (maybe thrice if you count stdio
+ buffering.)
+*/
+LY_DEFINE (ly_gulp_file, "ly:gulp-file",
+ 1, 0, 0, (SCM name),
+ "Read the file @var{name}, and return its contents in a string. "
+ "The file is looked up using the search path.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (name), name,
+ SCM_ARG1, __FUNCTION__, "string");
+ String contents = gulp_file_to_string (ly_scm2string (name), true);
+ return scm_from_locale_stringn (contents.get_str0 (), contents.length ());
+}
+
+LY_DEFINE (ly_error, "ly:error",
+ 1, 0, 1, (SCM str, SCM rest),
+ "Scheme callable function to issue the error @code{msg}. "
+ "The error is formatted with @code{format} and @code{rest}.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
+ str = scm_simple_format (SCM_BOOL_F, str, rest);
+ error (ly_scm2string (str));
+ return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_message, "ly:message",
+ 1, 0, 1, (SCM str, SCM rest),
+ "Scheme callable function to issue the message @code{msg}. "
+ "The message is formatted with @code{format} and @code{rest}.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
+ str = scm_simple_format (SCM_BOOL_F, str, rest);
+ message (ly_scm2string (str));
+ return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_progress, "ly:progress",
+ 1, 0, 1, (SCM str, SCM rest),
+ "Scheme callable function to print progress @code{str}. "
+ "The message is formatted with @code{format} and @code{rest}.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
+ str = scm_simple_format (SCM_BOOL_F, str, rest);
+ progress_indication (ly_scm2string (str));
+ return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_programming_error, "ly:programming-error",
+ 1, 0, 1, (SCM str, SCM rest),
+ "Scheme callable function to issue the warning @code{msg}. "
+ "The message is formatted with @code{format} and @code{rest}.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
+ str = scm_simple_format (SCM_BOOL_F, str, rest);
+ programming_error (ly_scm2string (str));
+ return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_warning, "ly:warning",
+ 1, 0, 1, (SCM str, SCM rest),
+ "Scheme callable function to issue the warning @code{str}. "
+ "The message is formatted with @code{format} and @code{rest}.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
+ str = scm_simple_format (SCM_BOOL_F, str, rest);
+ warning (ly_scm2string (str));
+ return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_dir_p, "ly:dir?",
+ 1, 0, 0, (SCM s),
+ "type predicate. A direction is @code{-1}, @code{0} or "
+ "@code{1}, where @code{-1} represents "
+ "left or down and @code{1} represents right or up.")
+{
+ if (scm_is_number (s))
+ {
+ int i = scm_to_int (s);
+ return (i >= -1 && i <= 1) ? SCM_BOOL_T : SCM_BOOL_F;
+ }
+ return SCM_BOOL_F;
+}
+
+LY_DEFINE (ly_assoc_get, "ly:assoc-get",
+ 2, 1, 0,
+ (SCM key, SCM alist, SCM default_value),
+ "Return value if KEY in ALIST, else DEFAULT-VALUE "
+ "(or #f if not specified).")
+{
+ SCM handle = scm_assoc (key, alist);
+
+ if (default_value == SCM_UNDEFINED)
+ default_value = SCM_BOOL_F;
+
+ if (scm_is_pair (handle))
+ return scm_cdr (handle);
+ return default_value;
+}
+
+LY_DEFINE (ly_number2string, "ly:number->string",
+ 1, 0, 0, (SCM s),
+ "Convert @var{num} to a string without generating many decimals.")
+{
+ SCM_ASSERT_TYPE (scm_is_number (s), s, SCM_ARG1, __FUNCTION__, "number");
+
+ char str[400]; // ugh.
+
+ if (scm_exact_p (s) == SCM_BOOL_F)
+ {
+ Real r (scm_to_double (s));
+#ifdef __APPLE__
+ if (my_isinf (r) || my_isnan (r))
+#else
+ if (isinf (r) || isnan (r))
+#endif
+ {
+ programming_error (_ ("infinity or NaN encountered while converting
Real number"));
+ programming_error (_ ("setting to zero"));
+
+ r = 0.0;
+ }
+
+ snprintf (str, sizeof (str), "%08.4f", r);
+ }
+ else
+ snprintf (str, sizeof (str), "%d", scm_to_int (s));
+
+ return scm_makfrom0str (str);
+}
+
+LY_DEFINE (ly_version, "ly:version", 0, 0, 0, (),
+ "Return the current lilypond version as a list, e.g. @code{(1 3 127
uu1)}. ")
+{
+ char const *vs = "\'(" MAJOR_VERSION " " MINOR_VERSION " " PATCH_LEVEL " "
MY_PATCH_LEVEL ")";
+
+ return scm_c_eval_string ((char *)vs);
+}
+
+LY_DEFINE (ly_unit, "ly:unit", 0, 0, 0, (),
+ "Return the unit used for lengths as a string.")
+{
+ return scm_makfrom0str (INTERNAL_UNIT);
+}
+
+LY_DEFINE (ly_dimension_p, "ly:dimension?", 1, 0, 0, (SCM d),
+ "Return @var{d} is a number. Used to distinguish length "
+ "variables from normal numbers.")
+{
+ return scm_number_p (d);
+}
+
+/*
+ Debugging mem leaks:
+*/
+LY_DEFINE (ly_protects, "ly:protects",
+ 0, 0, 0, (),
+ "Return hash of protected objects.")
+{
+ return scm_protects;
+}
+
+LY_DEFINE (ly_gettext, "ly:gettext",
+ 1, 0, 0, (SCM string),
+ "Gettext wrapper.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (string), string, SCM_ARG1,
+ __FUNCTION__, "string");
+ return scm_makfrom0str (_ (scm_i_string_chars (string)).to_str0 ());
+}
+
+LY_DEFINE (ly_output_backend, "ly:output-backend",
+ 0, 0, 0, (),
+ "Return name of output backend.")
+{
+ return scm_makfrom0str (output_backend_global.to_str0 ());
+}
+
+LY_DEFINE (ly_output_formats, "ly:output-formats",
+ 0, 0, 0, (),
+ "Formats passed to --format as a list of strings, "
+ "used for the output.")
+{
+ Array<String> output_formats = split_string (output_format_global, ',');
+
+ SCM lst = SCM_EOL;
+ int output_formats_count = output_formats.size ();
+ for (int i = 0; i < output_formats_count; i ++)
+ lst = scm_cons (scm_makfrom0str (output_formats[i].to_str0 ()), lst);
+
+ return lst;
+}
+
+LY_DEFINE (ly_wchar_to_utf_8, "ly:wide-char->utf-8",
+ 1, 0, 0, (SCM wc),
+ "Encode the Unicode codepoint @var{wc} as UTF-8")
+{
+ char buf[5];
+
+ SCM_ASSERT_TYPE (scm_is_integer (wc), wc, SCM_ARG1, __FUNCTION__, "integer");
+ unsigned wide_char = (unsigned) scm_to_int (wc);
+ char *p = buf;
+
+ if (wide_char < 0x0080)
+ {
+ *p++ = (char)wide_char;
+ }
+ else if (wide_char < 0x0800)
+ {
+ *p++ = (char) (((wide_char >> 6)) | 0xC0);
+ *p++ = (char) (((wide_char) & 0x3F) | 0x80);
+ }
+ else if (wide_char < 0x10000)
+ {
+ *p++ = (char) (((wide_char >> 12)) | 0xE0);
+ *p++ = (char) (((wide_char >> 6) & 0x3F) | 0x80);
+ *p++ = (char) (((wide_char) & 0x3F) | 0x80);
+ }
+ else
+ {
+ *p++ = (char) (((wide_char >> 18)) | 0xF0);
+ *p++ = (char) (((wide_char >> 12) & 0x3F) | 0x80);
+ *p++ = (char) (((wide_char >> 6) & 0x3F) | 0x80);
+ *p++ = (char) (((wide_char) & 0x3F) | 0x80);
+ }
+ *p = 0;
+
+ return scm_makfrom0str (buf);
+}
+
+LY_DEFINE (ly_effective_prefix, "ly:effective-prefix",
+ 0, 0, 0, (),
+ "Return effective prefix.")
+{
+ return scm_makfrom0str (prefix_directory.to_str0 ());
+}
+
+LY_DEFINE (ly_chain_assoc_get, "ly:chain-assoc-get",
+ 2, 1, 0, (SCM key, SCM achain, SCM dfault),
+ "Return value for @var{key} from a list of alists @var{achain}. "
+ "If no if no entry is found, return DFAULT, "
+ "or #f if no DFAULT not specified.")
+{
+ if (scm_is_pair (achain))
+ {
+ SCM handle = scm_assoc (key, scm_car (achain));
+ if (scm_is_pair (handle))
+ return scm_cdr (handle);
+ else
+ return ly_chain_assoc_get (key, scm_cdr (achain), dfault);
+ }
+ return dfault == SCM_UNDEFINED ? SCM_BOOL_F : dfault;
+}
+
+LY_DEFINE (ly_stderr_redirect, "ly:stderr-redirect",
+ 1, 1, 0, (SCM file_name, SCM mode),
+ "Redirect stderr to FILE-NAME, opened with MODE.")
+{
+ SCM_ASSERT_TYPE (scm_string_p (file_name), file_name, SCM_ARG1,
+ __FUNCTION__, "file_name");
+ char const* m = "w";
+ if (mode != SCM_UNDEFINED && scm_string_p (mode))
+ m = ly_scm2newstr (mode, 0);
+ /* dup2 and (fileno (current-error-port)) do not work with mingw'c
+ gcc -mwindows. */
+ freopen (ly_scm2newstr (file_name, 0), m, stderr);
+ return SCM_UNSPECIFIED;
+}
Index: lilypond/ly/engraver-init.ly
diff -u lilypond/ly/engraver-init.ly:1.236.2.1
lilypond/ly/engraver-init.ly:1.236.2.2
--- lilypond/ly/engraver-init.ly:1.236.2.1 Fri Sep 23 21:22:27 2005
+++ lilypond/ly/engraver-init.ly Sun Oct 9 21:57:12 2005
@@ -606,6 +606,7 @@
\context {
\Voice
\name "TabVoice"
+ \alias "Voice"
\consists "Tab_note_heads_engraver"
\remove "Note_heads_engraver"
\remove "Fingering_engraver"
Index: lilypond/scm/ps-to-png.scm
diff -u /dev/null lilypond/scm/ps-to-png.scm:1.12.2.1
--- /dev/null Sun Oct 9 21:57:13 2005
+++ lilypond/scm/ps-to-png.scm Sun Oct 9 21:57:12 2005
@@ -0,0 +1,202 @@
+;;;; ps-to-png.scm --
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2005 Jan Nieuwenhuizen <[EMAIL PROTECTED]>
+
+(define-module (scm ps-to-png))
+
+(use-modules
+ (ice-9 optargs)
+ (ice-9 regex)
+ (ice-9 rw)
+ (srfi srfi-1)
+ (srfi srfi-13)
+ (srfi srfi-14))
+
+;; gettext wrapper for guile < 1.7.2
+(if (defined? 'gettext)
+ (define-public _ gettext)
+ (define-public (_ x) x))
+
+(define PLATFORM
+ (string->symbol
+ (string-downcase
+ (car (string-tokenize (vector-ref (uname) 0) char-set:letter)))))
+
+(define (re-sub re sub string)
+ (regexp-substitute/global #f re string 'pre sub 'post))
+
+(define (search-executable names)
+ (define (helper path lst)
+ (if (null? (cdr lst))
+ (car lst)
+ (if (search-path path (car lst)) (car lst)
+ (helper path (cdr lst)))))
+
+ (let ((path (parse-path (getenv "PATH"))))
+ (helper path names)))
+
+(define (search-gs)
+ (search-executable '("gs-nox" "gs-8.15" "gs")))
+
+(define (gulp-port port max-length)
+ (let ((str (make-string max-length)))
+ (read-string!/partial str port)
+ str))
+
+(define (dir-listing dir-name)
+ (define (dir-helper dir lst)
+ (let ((e (readdir dir)))
+ (if (eof-object? e) lst (dir-helper dir (cons e lst)))))
+ (reverse (dir-helper (opendir dir-name) '())))
+
+(define (dir-re dir re)
+ (filter (lambda (x) (string-match re x)) (dir-listing dir)))
+
+(define BOUNDING-BOX-RE
+ "^%%BoundingBox: (-?[0-9]+) (-?[0-9]+) (-?[0-9]+) (-?[0-9]+)")
+
+(define (get-bbox file-name)
+ (let* ((bbox (string-append file-name ".bbox"))
+ ;; -sOutputFile does not work with bbox?
+ (cmd (format #t "gs\
+ -sDEVICE=bbox\
+ -q\
+ -dNOPAUSE\
+ ~S\
+ -c showpage\
+ -c quit 2>~S"
+ file-name bbox))
+ (status (system cmd))
+ (s (gulp-port (open-file bbox "r") 10240))
+ (m (string-match BOUNDING_BOX_RE s)))
+ (display m)
+ (newline)
+ (if m
+ (list->vector
+ (map (lambda (x) (string->number (car x))) (vector->list m)))
+ #f)))
+
+
+;; copy of ly:system. ly:* not available via lilypond-ps2png.scm
+(define (my-system be-verbose exit-on-error cmd)
+ (define status 0)
+ (if be-verbose
+ (begin
+ (format (current-error-port) (_ "Invoking `~a'...") cmd)
+ (newline (current-error-port))))
+
+
+ (set! status (system cmd))
+
+ (if (not (= status 0))
+ (begin
+ (format (current-error-port)
+ (format #f (_ "~a exited with status: ~S") "GS" status))
+ (if exit-on-error
+ (exit 1))))
+
+ status)
+
+(define (scale-down-image be-verbose factor file)
+ (let* ((status 0)
+ (percentage (* 100 (/ 1.0 factor)))
+ (old (string-append file ".old")))
+
+ (rename-file file old)
+ (my-system be-verbose
+ #t
+ (format #f "convert -scale \"~a%\" ~a ~a" percentage old file))
+ (delete-file old)
+ ))
+
+(define-public (ps-page-count ps-name)
+ (let*
+ ((header (gulp-port (open-file ps-name "r") 10240))
+ (match (string-match "%%Pages: ([0-9]+)" header))
+ (count (if match
+ (string->number (match:substring match 1))
+ 0)))
+ count))
+
+(define-public (make-ps-images ps-name . rest)
+ (let-optional
+ rest ((resolution 90)
+ (paper-size "a4")
+ (rename-page-1? #f)
+ (verbose? #f)
+ (aa-factor 1)
+ )
+
+ (let* ((base (basename (re-sub "[.]e?ps" "" ps-name)))
+ (header (gulp-port (open-file ps-name "r") 10240))
+ (png1 (string-append base ".png"))
+ (pngn (string-append base "-page%d.png"))
+ (page-count (ps-page-count ps-name))
+
+ (multi-page? (> page-count 1))
+ (output-file (if multi-page? pngn png1))
+
+ ;; png16m is because Lily produces color nowadays.
+ ;; can't use pngalpha device, since IE is broken.
+ ;;
+ (gs-variable-options
+ (if multi-page?
+ (format #f "-sPAPERSIZE=~a" paper-size)
+ "-dEPSCrop"))
+
+ (cmd (format #f "~a\
+ ~a\
+ ~a\
+ -dGraphicsAlphaBits=4\
+ -dTextAlphaBits=4\
+ -dNOPAUSE\
+ -sDEVICE=png16m\
+ -sOutputFile=~S\
+ -r~S\
+ ~S\
+ -c quit"
+ (search-gs)
+ (if verbose? "" "-q")
+ gs-variable-options
+ output-file
+ (* aa-factor resolution) ps-name))
+ (status 0)
+ (files '()))
+
+ ;; The wrapper on windows cannot handle `=' signs,
+ ;; gs has a workaround with #.
+ (if (eq? PLATFORM 'windows)
+ (begin
+ (set! cmd (re-sub "=" "#" cmd))
+ (set! cmd (re-sub "-dSAFER " "" cmd))))
+
+ (set! status (my-system verbose? #f cmd))
+
+ (set! files
+ (if multi-page?
+ (map
+ (lambda (n)
+ (format "~a-page~a.png" base (1+ n)))
+ (iota page-count))
+ (list (format "~a.png" base))))
+
+ (if (not (= 0 status))
+ (begin
+ (map delete-file files)
+ (exit 1)))
+
+ (if (and rename-page-1? multi-page?)
+ (begin
+ (rename-file (re-sub "%d" "1" pngn) png1)
+ (set! files
+ (cons png1
+ (cdr files)))
+ ))
+
+ (if (not (= 1 aa-factor))
+ (for-each (lambda (f) (scale-down-image verbose? aa-factor f))
+ files))
+
+ files)))
_______________________________________________
Lilypond-cvs mailing list
Lilypond-cvs@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-cvs
