;;;; Note: currently misused as testbed for titles with markup, see
;;;; input/test/title-markup.ly
-;;;;
+;;;;
;;;; TODO:
;;;; * %% Papersize in (header ...)
;;;; * text setting, kerning.
(use-modules (guile)
(ice-9 regex)
+ (ice-9 optargs)
(srfi srfi-1)
(srfi srfi-13)
(scm framework-ps)
(ly:number->string num)))
(define (number-pair->string4 numpair)
- (ly:format "~4l" numpair))
+ (ly:format "~4l" numpair))
;;;
;;; Lily output interface, PostScript implementation --- cleanup and docme
;; two beziers
(define (bezier-sandwich lst thick)
- (ly:format "~l ~4f draw_bezier_sandwich"
+ (ly:format "~l ~4f draw_bezier_sandwich"
(map number-pair->string4 lst)
thick))
(- x2 x1) (- y2 y1)
x1 y1 thick))
+(define (connected-shape pointlist thick x-scale y-scale connect fill)
+ (ly:format "~a~4f ~4f ~4f ~4f ~a ~a draw_connected_shape"
+ (string-concatenate
+ (map (lambda (x)
+ (apply (if (eq? (length x) 6)
+ (lambda (x1 x2 x3 x4 x5 x6)
+ (ly:format "~4f ~4f ~4f ~4f ~4f ~4f 6 "
+ x1
+ x2
+ x3
+ x4
+ x5
+ x6))
+ (lambda (x1 x2)
+ (ly:format "~4f ~4f 2 " x1 x2)))
+ x))
+ (reverse pointlist)))
+ (length pointlist)
+ x-scale
+ y-scale
+ thick
+ (if connect "true" "false")
+ (if fill "true" "false")))
+
+(define (partial-ellipse x-radius y-radius start-angle end-angle thick connect fill)
+ (ly:format "~a ~a ~4f ~4f ~4f ~4f ~4f draw_partial_ellipse"
+ (if fill "true" "false")
+ (if connect "true" "false")
+ x-radius
+ y-radius
+ start-angle
+ end-angle
+ thick))
+
(define (ellipse x-radius y-radius thick fill)
(ly:format
"~a ~4f ~4f ~4f draw_ellipse"
(ly:format "~4f ~4f ~4f ~a~a"
w x y
prefix g)))
-
- (ly:format
+
+ (ly:format
(if cid?
"/~a /CIDFont findresource ~a output-scale div scalefont setfont
~a
;; Backslashes are not valid
;; file URI path separators.
- (ly:string-substitute
- "\\" "/" (ly:string-percent-encode file))
+ (ly:string-percent-encode
+ (ly:string-substitute "\\" "/" file))
(cadr location)
(caddr location)
"false")
x-radius y-radius thick))
-(define (placebox x y s)
+(define (placebox x y s)
(if (not (string-null? s))
(ly:format "~4f ~4f moveto ~a\n" x y s)
""))
(define (resetrotation ang x y)
"grestore ")
-
-(define (text font s)
- ;; (ly:warning (_ "TEXT backend-command encountered in Pango backend"))
- ;; (ly:warning (_ "Arguments: ~a ~a"" font str))
-
- (let* ((space-length (cdar (ly:text-dimension font " ")))
- (space-move (string-append (number->string space-length)
- ;; how much precision do we need here?
- " 0.0 rmoveto "))
- (out-vec (decode-byte-string s)))
-
- (string-append
- (ps-font-command font) " "
- (string-join
- (vector->list
- (vector-for-each
-
- (lambda (sym)
- (if (eq? sym 'space)
- space-move
- (string-append "/" (symbol->string sym) " glyphshow")))
- out-vec))))))
-
-(define (unknown)
+(define (unknown)
"\n unknown\n")
(define (url-link url x y)
(cdr y)
url))
-(define (path thickness exps)
+(define* (path thickness exps #:optional (cap 'round) (join 'round) (fill? #f))
(define (convert-path-exps exps)
(if (pair? exps)
(let*
((head (car exps))
(rest (cdr exps))
- (arity
+ (arity
(cond
((memq head '(rmoveto rlineto lineto moveto)) 2)
((memq head '(rcurveto curveto)) 6)
;; WARNING: this is a vulnerability: a user can output arbitrary PS code here.
(cons (ly:format
"~l ~a "
- args
+ args
head)
(convert-path-exps (drop rest arity))))
'()))
-
-
- (ly:format
- "gsave currentpoint translate 1 setlinecap ~a setlinewidth\n~l stroke grestore"
- thickness
- (convert-path-exps exps)))
-
+
+ (let ((cap-numeric (case cap ((butt) 0) ((round) 1) ((square) 2)))
+ (join-numeric (case join ((miter) 0) ((round) 1) ((bevel) 2))))
+ (ly:format
+ "gsave currentpoint translate
+~a setlinecap ~a setlinejoin ~a setlinewidth
+~l gsave stroke grestore ~a grestore"
+ cap-numeric
+ join-numeric
+ thickness
+ (convert-path-exps exps)
+ (if fill? "fill" ""))))