fix scriblib/gui-eval and pre-build pictures for Quick

This commit is contained in:
Matthew Flatt 2011-04-14 12:20:16 -06:00
parent e734cd6127
commit df4ffe3573
7 changed files with 20 additions and 5 deletions

View File

@ -18,11 +18,13 @@
((2) 0 () 0 () () (void))
((2) 0 () 0 () () (c send c f c show c #f))
((2) 0 () 0 () () (void))
((2) 0 () 0 () () (c require c slideshow/flash))
((2) 0 () 0 () () (void))
((2) 0 () 0 () () (c define c (c add-drawing c p) c (c let c (c (c drawer c (c make-pict-drawer c p))) c (c new c canvas% c (c parent c f) c (c style c (c quote c (c border))) c (c paint-callback c (c lambda c (c self c dc) c (c drawer c dc c 0 c 0)))))))
((2) 0 () 0 () () (void))
((2) 0 () 0 () () (c add-drawing c (c pict+code c (c circle c 10))))
((2) 1 (((lib "scribble/core.rkt") . deserialize-info:element-v0)) 0 () () (0 #f (c (u . "#(struct:object:canvas% ...)"))))
((2) 0 () 0 () () (c add-drawing c (c colorize c (c filled-flash c 50 c 30) c "yellow")))
((2) 1 (((lib "scriblib/private/gui-eval-exn.rkt") . deserialize-info:gui-exn-v0)) 0 () () (0 "reference to undefined identifier: filled-flash"))
((2) 1 (((lib "scribble/core.rkt") . deserialize-info:element-v0)) 0 () () (0 #f (c (u . "#(struct:object:canvas% ...)"))))
((2) 0 () 0 () () (c scale c (c bitmap c (c build-path c (c collection-path c "scribblings/quick") c "art.png")) c 0.5))
((2) 1 (((lib "scribble/core.rkt") . deserialize-info:image-element-v0)) 0 () () (0 #f (c "[image]") (u . "images/img2") (c ".pdf" c ".png") 1.0))

Binary file not shown.

Before

Width:  |  Height:  |  Size: 4.8 KiB

After

Width:  |  Height:  |  Size: 4.7 KiB

View File

@ -542,6 +542,8 @@ exposes a picture's drawing function. We can use
@racket[make-pict-drawer] in a canvas-painting callback to draw a
picture into a canvas:
@(mr-interaction-eval (require slideshow/flash))
@mr-def+int[
(define (add-drawing p)
(let ([drawer (make-pict-drawer p)])

View File

@ -9,6 +9,7 @@
racket/serialize
"private/gui-eval-exn.ss"
racket/system
racket/sandbox
(for-syntax racket/base))
(define-syntax define-mr
@ -37,8 +38,13 @@
(define gui-eval (make-base-eval))
(define mred? (getenv "MREVAL"))
(define-namespace-anchor anchor)
(when mred?
(call-in-sandbox-context gui-eval
(lambda ()
(namespace-attach-module (namespace-anchor->namespace anchor)
'racket/class)))
(gui-eval '(require racket/gui/base))
(gui-eval '(require slideshow)))
@ -132,15 +138,20 @@
(set! image-counter (add1 image-counter))
(let ([dc (let ([pss (make-object (gui-eval 'ps-setup%))])
(send pss set-mode 'file)
(send pss set-file (path-replace-suffix fn #".ps"))
(send pss set-file (path-replace-suffix fn #".pdf"))
(parameterize ([(gui-eval 'current-ps-setup) pss])
(make-object (gui-eval 'post-script-dc%) #f)))])
(let ([xb (box 0)]
[yb (box 0)])
(send pss get-scaling xb yb)
(new (gui-eval 'pdf-dc%)
[interactive #f]
[width (* (unbox xb) (get-width v))]
[height (* (unbox yb) (get-height v))]))))])
(send dc start-doc "Image")
(send dc start-page)
(render v dc 0 0)
(send dc end-page)
(send dc end-doc)
(system (format "epstopdf ~a" (path-replace-suffix fn #".ps"))))
(send dc end-doc))
(let* ([bm (make-object (gui-eval 'bitmap%)
(inexact->exact (ceiling (get-width v)))
(inexact->exact (ceiling (get-height v))))]