From cd9e822d8daa2af3303f7e1a35e0852edb2282c7 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 3 Aug 2008 21:21:51 -0300 Subject: [PATCH 1/1] Fix #268. Undirected rounding caused slices of up to half a point (1/144 inch) to go lost at image edges when creating EPS images. --- scm/framework-ps.scm | 32 +++++++++++++++++--------------- scm/stencil.scm | 4 ++-- 2 files changed, 19 insertions(+), 17 deletions(-) diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 44427dbd09..56507ce0e3 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -535,20 +535,22 @@ (define-public (dump-stencil-as-EPS-with-bbox paper dump-me filename load-fonts bbox) - (define (to-bp-box mmbox) + "Create an EPS file from stencil DUMP-ME to FILENAME. BBOX has format + (left-x, lower-y, right x, up-y). If LOAD-FONTS set, include fonts inline." + + (define (to-rounded-bp-box box) + "Convert box to 1/72 inch with rounding to enlarge the box." (let* ((scale (ly:output-def-lookup paper 'output-scale)) - (box (map - (lambda (x) - (if (or (nan? x) (inf? x)) - 0 - (inexact->exact - (round (/ (* x scale) (ly:bp 1)))))) mmbox))) - - (list (car box) - (cadr box) - (max (1+ (car box)) (caddr box)) - (max (1+ (cadr box)) (cadddr box)) - ))) + (strip-non-number (lambda (x) + (if (or (nan? x) (inf? x)) 0.0 x))) + (directed-round (lambda (x rounder) + (inexact->exact + (rounder (/ (* x scale) (ly:bp 1))))))) + (list (directed-round (car box) floor) + (directed-round (cadr box) floor) + (max (1+ (car box)) (directed-round (caddr box) ceiling) + (max (1+ (cadr box)) (directed-round (cadddr box) ceiling) + ))))) (let* ((outputter (ly:make-paper-outputter ;; FIXME: better wrap open/open-file, @@ -558,7 +560,7 @@ 'ps)) (port (ly:outputter-port outputter)) - (rounded-bbox (to-bp-box bbox)) + (rounded-bbox (to-rounded-bp-box bbox)) (port (ly:outputter-port outputter)) (header (eps-header paper rounded-bbox load-fonts))) @@ -597,7 +599,7 @@ ((xext (car ext-system-pair)) (paper-system (cdr ext-system-pair)) (yext (paper-system-extent paper-system Y)) - (bbox (list (car xext) (car yext) + (bbox (list (car xext) (car yext) (cdr xext) (cdr yext))) (filename (if (< 0 count) (format "~a-~a" basename count) diff --git a/scm/stencil.scm b/scm/stencil.scm index fb46ef7251..6a4b88d7b2 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -94,8 +94,8 @@ encloses the contents. " (let* ((xext (ly:grob-extent grob grob 0)) (yext (ly:grob-extent grob grob 1)) - (thick 0.1)) - + (thick 0.01)) + (ly:stencil-add (make-filled-box-stencil xext (cons (- (car yext) thick) (car yext))) (make-filled-box-stencil xext (cons (cdr yext) (+ (cdr yext) thick))) -- 2.39.2