scripts/lilypond-ps2png.scm

   1 #!@GUILE@ \
   2 -e main -s
   3 !#
   4 ;;;; lilypond-ps2png.scm -- Convert PostScript file to PNG images using GS
   5 ;;;;
   6 ;;;; source file of the GNU LilyPond music typesetter
   7 ;;;;
   8 ;;;; (c)  2005 Jan Nieuwenhuizen <janneke@gnu.org>
   9
  10 (use-modules
  11  (ice-9 getopt-long)
  12  (ice-9 regex)
  13  (srfi srfi-13))
  14
  15 (define PROGRAM-NAME "lilypond-ps2png")
  16 (define TOPLEVEL-VERSION "@TOPLEVEL_VERSION@")
  17 (define DATADIR "@datadir@")
  18 (define COMPILE-TIME-PREFIX
  19   (format #f "~a/lilypond/~a" DATADIR TOPLEVEL-VERSION))
  20
  21 (define paper-size "a4")
  22 (define resolution 90)
  23 (define verbose? #f)
  24 (define rename-page-1 #f)
  25
  26 ;; argv0 relocation -- do in wrapper?
  27 (define LILYPONDPREFIX
  28   (or (getenv "LILYPONDPREFIX")
  29       (let* ((bindir (dirname (car (command-line))))
  30              (prefix (dirname bindir))
  31              (lilypond-prefix
  32               (if (eq? prefix (dirname DATADIR)) COMPILE-TIME-PREFIX
  33                   (format #f "~a/share/lilypond/~a"
  34                           prefix TOPLEVEL-VERSION))))
  35         lilypond-prefix)))
  36
  37 ;; gettext wrapper for guile < 1.7.2
  38 (if (defined? 'gettext)
  39     (define-public _ gettext)
  40     (define-public (_ x) x))
  41
  42 (define (show-version port)
  43   (format port "~a (GNU LilyPond) ~a \n" PROGRAM-NAME TOPLEVEL-VERSION))
  44
  45 (define (show-help port)
  46   (format port (_ "Usage: lilypond-ps2png FILE
  47
  48 Convert PostScript file to PNG images.
  49
  50 Options:
  51   -h, --help              show this help
  52   -P, --paper-size=PAPER  use paper size PAPER
  53   -R, --resolution=RES    use resolution RES
  54   -V, --verbose           be verbose
  55   -v, --version           show version
  56 ")))
  57
  58 (define (parse-options args)
  59   (let* ((options (getopt-long args
  60                                '((help (single-char #\h))
  61                                  (verbose (single-char #\V))
  62                                  (version (single-char #\v))
  63                                  (paper-size (single-char #\P) (value #t))
  64                                  ;; compatibility
  65                                  (papersize (value #t))
  66                                  (resolution (single-char #\R) (value #t)))))
  67          (files (cdr (assq '() options))))
  68     (if (assq 'help options)
  69         (begin
  70           (show-version (current-output-port))
  71           (show-help (current-output-port))
  72         (exit 0)))
  73     (if (assq 'version options)
  74         (begin (show-version (current-output-port)) (exit 0)))
  75     (if (assq 'verbose options)
  76         (begin
  77           (set! verbose? #t)
  78           (debug-enable 'debug)
  79           (debug-enable 'backtrace)))
  80
  81     (let ((o (or (assq-ref 'paper-size options)
  82                  (assq-ref 'papersize options))))
  83           (if o (set! paper-size o)))
  84     (let ((o (assq-ref 'resolution options)))
  85           (if o (set! resolution o)))
  86     (show-version (current-error-port))
  87     files))
  88
  89 (define (main args)
  90   (let ((files (parse-options args)))
  91     (if (= (length files) 0)
  92         (begin
  93           (show-help (current-error-port))
  94           (exit 2)))
  95     (set! %load-path (cons LILYPONDPREFIX %load-path))
  96     (primitive-eval '(use-modules (scm ps-to-png)))
  97     (for-each
  98      (lambda
  99       (x)
 100       (let ((png-files
 101              (make-ps-images x resolution paper-size rename-page-1 verbose?)))
 102         (format (current-error-port) (_ "Wrote `~a'") (string-join png-files))
 103         (newline (current-error-port))))
 104      files)))