X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-ps.scm;h=3766fa6a4ea5f2b1790fff9b5b784894b7bc1332;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=7a2972525b8a6620081862c89010924c2b4d1830;hpb=ac1340846e81661575ba3036b251e8ab55b13023;p=lilypond.git diff --git a/scm/output-ps.scm b/scm/output-ps.scm index 7a2972525b..3766fa6a4e 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2006 Jan Nieuwenhuizen +;;;; (c) 1998--2008 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;; Note: currently misused as testbed for titles with markup, see @@ -26,9 +26,11 @@ dashed-slur dot draw-line + ellipse embedded-ps named-glyph no-origin + oval placebox polygon repeat-slash @@ -38,7 +40,7 @@ setcolor setrotation text - zigzag-line)) + )) (use-modules (guile) @@ -67,25 +69,6 @@ (define (number-pair->string4 numpair) (ly:format "~4l" numpair)) -(define (numbers->string4 numlist) - (string-join (map str4 numlist) " ")) - -;; FIXME: lily-def -(define-public (ps-string-def prefix key val) - (ly:format "/ ~a~a (~a) def\n" - prefix - (symbol->string key) - (escape-parentheses val))) - -(define (ps-number-def prefix key val) - (let ((s (if (integer? val) - (ly:number->string val) - (ly:number->string (exact->inexact val))))) - (ly:format "/~a~a ~a def\n" - prefix - (symbol->string key) s))) - - ;;; ;;; Lily output interface, PostScript implementation --- cleanup and docme ;;; @@ -122,7 +105,7 @@ (define (dashed-slur thick on off l) (ly:format "~l ~4f [ ~4f ~4f ] 0 draw_dashed_slur" (let ((control-points (append (cddr l) (list (car l) (cadr l))))) - (map number-pair->string4 control-points) " ") + (map number-pair->string4 control-points)) thick on off)) @@ -135,6 +118,14 @@ (- x2 x1) (- y2 y1) x1 y1 thick)) +(define (ellipse x-radius y-radius thick fill) + (ly:format + "~a ~4f ~4f ~4f draw_ellipse" + (if fill + "true" + "false") + x-radius y-radius thick)) + (define (embedded-ps string) string) @@ -166,45 +157,39 @@ (define (grob-cause offset grob) - (let* ((cause (ly:grob-property grob 'cause)) - (music-origin (if (ly:stream-event? cause) - (ly:event-property cause 'origin)))) - (if (not (ly:input-location? music-origin)) - "" - (let* ((location (ly:input-file-line-char-column music-origin)) - (raw-file (car location)) - (file (if (is-absolute? raw-file) - raw-file - (string-append (ly-getcwd) "/" raw-file))) - (x-ext (ly:grob-extent grob grob X)) - (y-ext (ly:grob-extent grob grob Y))) - - (if (and (< 0 (interval-length x-ext)) - (< 0 (interval-length y-ext))) - (ly:format "~4f ~4f ~4f ~4f (textedit://~a:~a:~a:~a) mark_URI\n" - (+ (car offset) (car x-ext)) - (+ (cdr offset) (car y-ext)) - (+ (car offset) (cdr x-ext)) - (+ (cdr offset) (cdr y-ext)) - - ;; TODO - ;;full escaping. - - ;; backslash is interpreted by GS. - (ly:string-substitute "\\" "/" - (ly:string-substitute " " "%20" file)) - (cadr location) - (caddr location) - (cadddr location)) - ""))))) - -(define (lily-def key val) - (let ((prefix "lilypondlayout")) - (if (string=? - (substring key 0 (min (string-length prefix) (string-length key))) - prefix) - (format "/~a { ~a } bind def\n" key val) - (format "/~a (~a) def\n" key val)))) + (if (ly:get-option 'point-and-click) + (let* ((cause (ly:grob-property grob 'cause)) + (music-origin (if (ly:stream-event? cause) + (ly:event-property cause 'origin)))) + (if (ly:input-location? music-origin) + (let* ((location (ly:input-file-line-char-column music-origin)) + (raw-file (car location)) + (file (if (is-absolute? raw-file) + raw-file + (string-append (ly-getcwd) "/" raw-file))) + (x-ext (ly:grob-extent grob grob X)) + (y-ext (ly:grob-extent grob grob Y))) + + (if (and (< 0 (interval-length x-ext)) + (< 0 (interval-length y-ext))) + (ly:format "~4f ~4f ~4f ~4f (textedit://~a:~a:~a:~a) mark_URI\n" + (+ (car offset) (car x-ext)) + (+ (cdr offset) (car y-ext)) + (+ (car offset) (cdr x-ext)) + (+ (cdr offset) (cdr y-ext)) + + ;; TODO + ;;full escaping. + + ;; backslash is interpreted by GS. + (ly:string-substitute "\\" "/" + (ly:string-substitute " " "%20" file)) + (cadr location) + (caddr location) + (cadddr location)) + "")) + "")) + "")) (define (named-glyph font glyph) (ly:format "~a /~a glyphshow " ;;Why is there a space at the end? @@ -214,6 +199,14 @@ (define (no-origin) "") +(define (oval x-radius y-radius thick fill) + (ly:format + "~a ~4f ~4f ~4f draw_oval" + (if fill + "true" + "false") + x-radius y-radius thick)) + (define (placebox x y s) (ly:format "~4f ~4f moveto @@ -251,7 +244,7 @@ (list r g b))) ;; restore color from stack -(define (resetcolor) "grestore \n") +(define (resetcolor) "grestore\n") ;; rotation around given point (define (setrotation ang x y) @@ -290,7 +283,7 @@ "\n unknown\n") (define (url-link url x y) - (ly:format "~a ~a ~a ~a (~a) mark_URI" + (ly:format "~a ~a currentpoint vector_add ~a ~a currentpoint vector_add (~a) mark_URI" (car x) (car y) (cdr x) @@ -300,17 +293,6 @@ (define (utf-8-string pango-font-description string) (ly:warning (_ "utf-8-string encountered in PS backend"))) - -(define (zigzag-line is-center zzw zzh thick dx dy) - (ly:format "~a ~4f ~4f ~4f 0 0 ~4f ~4f draw_zigzag_line" - (if is-center "true" "false") - zzw - zzh - thick - dx - dy)) - - (define (path thickness exps) (define (convert-path-exps exps) (if (pair? exps)