diff --git a/collects/redex/private/pict.rkt b/collects/redex/private/pict.rkt index fd8a1be3cb..16840c4b6e 100644 --- a/collects/redex/private/pict.rkt +++ b/collects/redex/private/pict.rkt @@ -134,8 +134,9 @@ (define (render-reduction-relation rr [filename #f] #:style [style (rule-pict-style)]) (if filename - (save-as-ps (λ () (do-reduction-relation->pict 'render-reduction-relation rr style)) - filename) + (save-as-ps/pdf + (λ () (do-reduction-relation->pict 'render-reduction-relation rr style)) + filename) (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))]) (do-reduction-relation->pict 'render-reduction-relation rr style)))) @@ -476,7 +477,7 @@ (define (render-language lang [filename #f] #:nts [nts (render-language-nts)]) (if filename - (save-as-ps (λ () (do-language->pict 'render-language lang nts)) filename) + (save-as-ps/pdf (λ () (do-language->pict 'render-language lang nts)) filename) (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))]) (do-language->pict 'render-language lang nts)))) @@ -512,23 +513,26 @@ (map (λ (x) (format " ~a" x)) (cdr langs-nts))))))) nts))) -;; save-as-ps : (-> pict) string -> void -(define (save-as-ps mk-pict filename) - (let ([ps-dc (make-ps-dc filename)]) - (parameterize ([dc-for-text-size ps-dc]) - (send ps-dc start-doc "x") - (send ps-dc start-page) - (draw-pict (mk-pict) ps-dc 0 0) - (send ps-dc end-page) - (send ps-dc end-doc)))) +;; save-as-ps/pdf : (-> pict) path-string -> void +(define (save-as-ps/pdf mk-pict filename) + (let ([ps/pdf-dc (make-ps/pdf-dc filename)]) + (parameterize ([dc-for-text-size ps/pdf-dc]) + (send ps/pdf-dc start-doc "x") + (send ps/pdf-dc start-page) + (draw-pict (mk-pict) ps/pdf-dc 0 0) + (send ps/pdf-dc end-page) + (send ps/pdf-dc end-doc)))) -(define (make-ps-dc filename) +(define (make-ps/pdf-dc filename) (let ([ps-setup (make-object ps-setup%)]) (send ps-setup copy-from (current-ps-setup)) (send ps-setup set-file filename) (send ps-setup set-mode 'file) + (define % (if (regexp-match #rx#"[.]pdf$" (path->bytes filename)) + pdf-dc% + post-script-dc%)) (parameterize ([current-ps-setup ps-setup]) - (make-object post-script-dc% #f #f)))) + (make-object % #f #f)))) ;; raw-info : language-pict-info ;; nts : (listof symbol) -- the nts that the user expects to see @@ -1015,8 +1019,8 @@ (define (render-metafunction/proc mfs filename name) (cond [filename - (save-as-ps (λ () (metafunctions->pict/proc mfs name)) - filename)] + (save-as-ps/pdf (λ () (metafunctions->pict/proc mfs name)) + filename)] [else (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))]) (metafunctions->pict/proc mfs name))])) @@ -1035,7 +1039,7 @@ (define (render-pict make-pict filename) (cond [filename - (save-as-ps make-pict filename)] + (save-as-ps/pdf make-pict filename)] [else (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))]) (make-pict))])) @@ -1132,7 +1136,7 @@ (define (render-term/proc lang lw [filename #f]) (if filename - (save-as-ps (λ () (do-term->pict lang lw)) filename) + (save-as-ps/pdf (λ () (do-term->pict lang lw)) filename) (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))]) (do-term->pict lang lw)))) diff --git a/collects/redex/scribblings/ref.scrbl b/collects/redex/scribblings/ref.scrbl index e7e782131c..b58013f333 100644 --- a/collects/redex/scribblings/ref.scrbl +++ b/collects/redex/scribblings/ref.scrbl @@ -2213,7 +2213,7 @@ turned into a pict for viewing in the REPL or using with Slideshow (see @other-manual['(lib "scribblings/slideshow/slideshow.scrbl")]). -@subsection{Picts & PostScript} +@subsection{Picts, PDF, & PostScript} This section documents two classes of operations, one for direct use of creating postscript figures for use in papers @@ -2240,10 +2240,12 @@ sets @racket[dc-for-text-size] and the latter does not. @defproc[(render-term [lang compiled-lang?] [term any/c] [file (or/c #f path-string?)]) (if file void? pict?)]{ Renders the term @racket[term]. If @racket[file] is @racket[#f], - it produces a pict; if @racket[file] is a path, it saves - Encapsulated PostScript in the provided filename. See - @racket[render-language] for details on the construction of the pict. - } + it produces a pict; if @racket[file] is a path, it saves + Encapsulated PostScript in the provided filename, unless the filename + ends with @filepath{.pdf}, in which case it saves PDF. + + See @racket[render-language] for details on the construction of the pict. +} @defproc[(term->pict [lang compiled-lang?] [term any/c]) pict?]{ @@ -2263,7 +2265,9 @@ sets @racket[dc-for-text-size] and the latter does not. Renders a language. If @racket[file] is @racket[#f], it produces a pict; if @racket[file] is a path, it saves -Encapsulated PostScript in the provided filename. See +Encapsulated PostScript in the provided filename, unless the filename +ends with @filepath{.pdf}, in which case it saves PDF. +See @racket[render-language-nts] for information on the @racket[nts] argument. @@ -2293,8 +2297,9 @@ Slideshow or with other tools that combine picts together. Renders a reduction relation. If @racket[file] is @racket[#f], it produces a pict; if @racket[file] is a path, it saves -Encapsulated PostScript in the provided filename. See -@racket[rule-pict-style] for information on the +Encapsulated PostScript in the provided filename, unless the filename +ends with @filepath{.pdf}, in which case it saves PDF. +See @racket[rule-pict-style] for information on the @racket[style] argument. This function parameterizes @racket[dc-for-text-size] to install a diff --git a/collects/redex/tests/pict-test.rkt b/collects/redex/tests/pict-test.rkt index f28c65bc0b..b575d8a569 100644 --- a/collects/redex/tests/pict-test.rkt +++ b/collects/redex/tests/pict-test.rkt @@ -1,4 +1,5 @@ -(module pict-test mzscheme +#lang racket/base +(require racket/file) ;; these tests just make sure that errors don't ;; happen. These tests are really only last resorts ;; for testing functions that aren't easily extraced @@ -14,30 +15,32 @@ (define-language var-ab [var (a b)]) - (render-language var-ab) + (void (render-language var-ab)) (define-language var-not-ab [var (variable-except x y)]) - (render-language var-not-ab) + (void (render-language var-not-ab)) (let () (define-metafunction empty-language [(zero any_in) 0]) - (render-metafunction zero)) + (void (render-metafunction zero))) - (render-reduction-relation - (reduction-relation - empty-language - (--> number_const - ,(term - (+ number_const 0))))) + (void + (render-reduction-relation + (reduction-relation + empty-language + (--> number_const + ,(term + (+ number_const 0)))))) - (render-reduction-relation - (reduction-relation - empty-language - (--> a b - (fresh x) - (fresh y)))) + (void + (render-reduction-relation + (reduction-relation + empty-language + (--> a b + (fresh x) + (fresh y))))) (define-language x1-9 @@ -46,6 +49,10 @@ (define-extended-language x0-10 x1-9 (x 0 .... 10)) - (render-language x0-10) + (void (render-language x0-10)) - (printf "pict-test.rkt passed\n")) + (let ([tmp (make-temporary-file "redex-pict-test~a.pdf")]) + (render-language x0-10 tmp) + (delete-file tmp)) + + (printf "pict-test.rkt passed\n") diff --git a/doc/release-notes/redex/HISTORY.txt b/doc/release-notes/redex/HISTORY.txt index 4fe659cd88..e52c2539e8 100644 --- a/doc/release-notes/redex/HISTORY.txt +++ b/doc/release-notes/redex/HISTORY.txt @@ -6,6 +6,8 @@ v5.2.2 * added define-extended-judgment-form + * extended render-* functions so they can produce PDF + v5.2.1 * rewrote the internals of the pattern matcher to be more consistent