suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

avoids attaching texpict, just requires it now -- in addition to getting of the attaching problems, also works better when the drawing callbacks have errors or other effects

Browse Source 
svn: r6478
This commit is contained in:
Robby Findler 2007-06-05 03:07:38 +00:00
parent 24f850fe0c
commit 02a8f5cdef
1 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/slideshow/tool.ss
View File

@ -889,14 +889,26 @@ pict snip :
(define orig-namespace (current-namespace))
(define (pict->image-snip p)
(let* ([pict-width (dynamic-require '(lib "mrpict.ss" "texpict") 'pict-width)]
[pict-height (dynamic-require '(lib "mrpict.ss" "texpict") 'pict-height)]
[draw-pict (dynamic-require '(lib "mrpict.ss" "texpict") 'draw-pict)]
[bm (make-object bitmap%
(inexact->exact (ceiling (pict-width p)))
(inexact->exact (ceiling (pict-height p))))]
[bdc (make-object bitmap-dc% bm)])
(send bdc clear)
(draw-pict p bdc 0 0)
(send bdc set-bitmap #f)
(make-object image-snip% bm)))
(drscheme:language:add-snip-value
;; Convert to print?
(lambda (x) (pict? x))
(lambda (x) ((dynamic-require '(lib "mrpict.ss" "texpict") 'pict?) x))
;; Converter:
(lambda (pict) (new pict-value-snip% (pict pict)))
pict->image-snip
;; Namespace setup:
(lambda ()
(namespace-attach-module orig-namespace '(lib "mrpict.ss" "texpict"))))
(λ () (dynamic-require '(lib "mrpict.ss" "texpict") #f)))
(define lib-pict-snipclass (make-object lib-pict-snipclass%))
(send lib-pict-snipclass set-version 2)