X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-ps.scm;h=9abd2774e8e46d057ad8b96182af5eef0d55ade6;hb=712e575fb12d02d58e04553a3474afb9f6d2391b;hp=da3c25a211ad7127a1baed82e3f8bcc4cec44648;hpb=b6b251afb3d68e32df8b84274f28c864ecd2beff;p=lilypond.git diff --git a/scm/output-ps.scm b/scm/output-ps.scm index da3c25a211..9abd2774e8 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -1,9 +1,20 @@ -;;;; output-ps.scm -- implement Scheme output interface for PostScript +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 1998--2007 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2009 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . ;;;; Note: currently misused as testbed for titles with markup, see ;;;; input/test/title-markup.ly @@ -14,34 +25,7 @@ ;;;; * document output-interface (define-module (scm output-ps) - #:re-export (quote) - - ;; JUNK this -- see lily.scm: ly:all-output-backend-commands - #:export (unknown - bezier-sandwich - char - circle - comment - dashed-line - dashed-slur - dot - draw-line - ellipse - embedded-ps - named-glyph - no-origin - oval - placebox - polygon - repeat-slash - resetcolor - resetrotation - round-filled-box - setcolor - setrotation - text - )) - + #:re-export (quote)) (use-modules (guile) (ice-9 regex) @@ -136,8 +120,8 @@ (define (glyph-spec w x y g) (let ((prefix (if (string? g) "/" ""))) - (ly:format "~4f ~4f ~a~a" - (+ w x) y + (ly:format "~4f ~4f ~4f ~a~a" + w x y prefix g))) (ly:format @@ -208,9 +192,9 @@ x-radius y-radius thick)) (define (placebox x y s) - (ly:format -"~4f ~4f moveto -~a\n" x y s)) + (if (not (string-null? s)) + (ly:format "~4f ~4f moveto ~a\n" x y s) + "")) (define (polygon points blot-diameter filled?) (ly:format "~a ~4l ~a ~4f draw_polygon" @@ -290,9 +274,6 @@ (cdr y) url)) -(define (utf-8-string pango-font-description string) - (ly:warning (_ "utf-8-string encountered in PS backend"))) - (define (path thickness exps) (define (convert-path-exps exps) (if (pair? exps) @@ -303,6 +284,7 @@ (cond ((memq head '(rmoveto rlineto lineto moveto)) 2) ((memq head '(rcurveto curveto)) 6) + ((eq? head 'closepath) 0) (else 1))) (args (take rest arity)) ) @@ -317,7 +299,7 @@ (ly:format - "1 setlinecap ~a setlinewidth\n~l stroke" + "gsave currentpoint translate 1 setlinecap ~a setlinewidth\n~l stroke grestore" thickness - (convert-path-exps exps) )) + (convert-path-exps exps)))