adjusted the render-* functions so they produce .pdf if the given

filename ends with #rx#"[.]pdf".
This commit is contained in:
Robby Findler 2012-03-17 08:35:35 -05:00
parent 145efa622e
commit 9d43203990
4 changed files with 62 additions and 44 deletions

View File

@ -134,8 +134,9 @@
(define (render-reduction-relation rr [filename #f] (define (render-reduction-relation rr [filename #f]
#:style [style (rule-pict-style)]) #:style [style (rule-pict-style)])
(if filename (if filename
(save-as-ps (λ () (do-reduction-relation->pict 'render-reduction-relation rr style)) (save-as-ps/pdf
filename) (λ () (do-reduction-relation->pict 'render-reduction-relation rr style))
filename)
(parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))]) (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
(do-reduction-relation->pict 'render-reduction-relation rr style)))) (do-reduction-relation->pict 'render-reduction-relation rr style))))
@ -476,7 +477,7 @@
(define (render-language lang [filename #f] #:nts [nts (render-language-nts)]) (define (render-language lang [filename #f] #:nts [nts (render-language-nts)])
(if filename (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))]) (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
(do-language->pict 'render-language lang nts)))) (do-language->pict 'render-language lang nts))))
@ -512,23 +513,26 @@
(map (λ (x) (format " ~a" x)) (cdr langs-nts))))))) (map (λ (x) (format " ~a" x)) (cdr langs-nts)))))))
nts))) nts)))
;; save-as-ps : (-> pict) string -> void ;; save-as-ps/pdf : (-> pict) path-string -> void
(define (save-as-ps mk-pict filename) (define (save-as-ps/pdf mk-pict filename)
(let ([ps-dc (make-ps-dc filename)]) (let ([ps/pdf-dc (make-ps/pdf-dc filename)])
(parameterize ([dc-for-text-size ps-dc]) (parameterize ([dc-for-text-size ps/pdf-dc])
(send ps-dc start-doc "x") (send ps/pdf-dc start-doc "x")
(send ps-dc start-page) (send ps/pdf-dc start-page)
(draw-pict (mk-pict) ps-dc 0 0) (draw-pict (mk-pict) ps/pdf-dc 0 0)
(send ps-dc end-page) (send ps/pdf-dc end-page)
(send ps-dc end-doc)))) (send ps/pdf-dc end-doc))))
(define (make-ps-dc filename) (define (make-ps/pdf-dc filename)
(let ([ps-setup (make-object ps-setup%)]) (let ([ps-setup (make-object ps-setup%)])
(send ps-setup copy-from (current-ps-setup)) (send ps-setup copy-from (current-ps-setup))
(send ps-setup set-file filename) (send ps-setup set-file filename)
(send ps-setup set-mode 'file) (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]) (parameterize ([current-ps-setup ps-setup])
(make-object post-script-dc% #f #f)))) (make-object % #f #f))))
;; raw-info : language-pict-info ;; raw-info : language-pict-info
;; nts : (listof symbol) -- the nts that the user expects to see ;; nts : (listof symbol) -- the nts that the user expects to see
@ -1015,8 +1019,8 @@
(define (render-metafunction/proc mfs filename name) (define (render-metafunction/proc mfs filename name)
(cond (cond
[filename [filename
(save-as-ps (λ () (metafunctions->pict/proc mfs name)) (save-as-ps/pdf (λ () (metafunctions->pict/proc mfs name))
filename)] filename)]
[else [else
(parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))]) (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
(metafunctions->pict/proc mfs name))])) (metafunctions->pict/proc mfs name))]))
@ -1035,7 +1039,7 @@
(define (render-pict make-pict filename) (define (render-pict make-pict filename)
(cond (cond
[filename [filename
(save-as-ps make-pict filename)] (save-as-ps/pdf make-pict filename)]
[else [else
(parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))]) (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
(make-pict))])) (make-pict))]))
@ -1132,7 +1136,7 @@
(define (render-term/proc lang lw [filename #f]) (define (render-term/proc lang lw [filename #f])
(if filename (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))]) (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
(do-term->pict lang lw)))) (do-term->pict lang lw))))

View File

@ -2213,7 +2213,7 @@ turned into a pict for viewing in the REPL or using with
Slideshow (see Slideshow (see
@other-manual['(lib "scribblings/slideshow/slideshow.scrbl")]). @other-manual['(lib "scribblings/slideshow/slideshow.scrbl")]).
@subsection{Picts & PostScript} @subsection{Picts, PDF, & PostScript}
This section documents two classes of operations, one for This section documents two classes of operations, one for
direct use of creating postscript figures for use in papers 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?)]) @defproc[(render-term [lang compiled-lang?] [term any/c] [file (or/c #f path-string?)])
(if file void? pict?)]{ (if file void? pict?)]{
Renders the term @racket[term]. If @racket[file] is @racket[#f], Renders the term @racket[term]. If @racket[file] is @racket[#f],
it produces a pict; if @racket[file] is a path, it saves 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
@racket[render-language] for details on the construction of the pict. 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?]{ @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], Renders a language. If @racket[file] is @racket[#f],
it produces a pict; if @racket[file] is a path, it saves 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[render-language-nts] for information on the
@racket[nts] argument. @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], Renders a reduction relation. If @racket[file] is @racket[#f],
it produces a pict; if @racket[file] is a path, it saves 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
@racket[rule-pict-style] for information on the ends with @filepath{.pdf}, in which case it saves PDF.
See @racket[rule-pict-style] for information on the
@racket[style] argument. @racket[style] argument.
This function parameterizes @racket[dc-for-text-size] to install a This function parameterizes @racket[dc-for-text-size] to install a

View File

@ -1,4 +1,5 @@
(module pict-test mzscheme #lang racket/base
(require racket/file)
;; these tests just make sure that errors don't ;; these tests just make sure that errors don't
;; happen. These tests are really only last resorts ;; happen. These tests are really only last resorts
;; for testing functions that aren't easily extraced ;; for testing functions that aren't easily extraced
@ -14,30 +15,32 @@
(define-language var-ab (define-language var-ab
[var (a [var (a
b)]) b)])
(render-language var-ab) (void (render-language var-ab))
(define-language var-not-ab (define-language var-not-ab
[var (variable-except x [var (variable-except x
y)]) y)])
(render-language var-not-ab) (void (render-language var-not-ab))
(let () (let ()
(define-metafunction empty-language [(zero any_in) 0]) (define-metafunction empty-language [(zero any_in) 0])
(render-metafunction zero)) (void (render-metafunction zero)))
(render-reduction-relation (void
(reduction-relation (render-reduction-relation
empty-language (reduction-relation
(--> number_const empty-language
,(term (--> number_const
(+ number_const 0))))) ,(term
(+ number_const 0))))))
(render-reduction-relation (void
(reduction-relation (render-reduction-relation
empty-language (reduction-relation
(--> a b empty-language
(fresh x) (--> a b
(fresh y)))) (fresh x)
(fresh y)))))
(define-language x1-9 (define-language x1-9
@ -46,6 +49,10 @@
(define-extended-language x0-10 x1-9 (define-extended-language x0-10 x1-9
(x 0 .... 10)) (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")

View File

@ -6,6 +6,8 @@ v5.2.2
* added define-extended-judgment-form * added define-extended-judgment-form
* extended render-* functions so they can produce PDF
v5.2.1 v5.2.1
* rewrote the internals of the pattern matcher to be more consistent * rewrote the internals of the pattern matcher to be more consistent