slideshow: add pict->pre-render-pict

Uses `make-bitmap` from the viewer's canvas to optimize drawing.

pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/slides.scrbl

@@ -204,6 +204,13 @@ pixels tall. The result is @racket[pict] when using a 1024 by 768
 display.}
 
 
+@defproc[(pict->pre-render-pict [pict pict?]) pict?]{
+
+Produces a pict that is like @racket[pict], but optimized for drawing
+on some platforms (currently Mac OS X). This function may be useful
+to reduce drawing times for for large bitmaps or complex drawings.}
+
+
 @defproc[(make-outline [name (or/c symbol? (listof symbol?))]
                        [title (or/c string? pict?)]
                        [subitems (or/c #f null?

pkgs/slideshow-pkgs/slideshow-lib/slideshow/HISTORY.txt

@@ -1,3 +1,6 @@
+Version 1.2
+slideshow/base: added pict->pre-render-pict
+
 Version 1.1
 slideshow/pict: added 'outline style for text
 

pkgs/slideshow-pkgs/slideshow-lib/slideshow/base.rkt

@@ -46,4 +46,5 @@
            current-titlet current-para-width
 	   set-page-numbers-visible! done-making-slides
            set-spotlight-style!
+           pict->pre-render-pict
            clickback interactive make-slide-inset slide-inset? apply-slide-inset))

pkgs/slideshow-pkgs/slideshow-lib/slideshow/core.rkt

@@ -168,6 +168,9 @@
       (define (set-spotlight-style! #:size [size #f] #:color [color #f])
         (viewer:set-spotlight-style! #:size size #:color color))
 
+      (define (pict->pre-render-pict p)
+        (viewer:pict->pre-render-pict p))
+
       (define current-page-number-font 
 	(make-parameter
 	 (make-object font% 10 'default 'normal 'normal)

pkgs/slideshow-pkgs/slideshow-lib/slideshow/info.rkt

@@ -4,4 +4,4 @@
 
 (define release-note-files '(("Slideshow" "HISTORY.txt")))
 
-(define version "1.1")
+(define version "1.2")

pkgs/slideshow-pkgs/slideshow-lib/slideshow/sig.rkt

@@ -31,7 +31,9 @@
      ;; Called when a clickback-containing slide is rendered:
      add-click-region!
      ;; Called when a interactive-containing slide is rendered:
-     add-interactive!))
+     add-interactive!
+     ;; To potentially speed up display:
+     pict->pre-render-pict))
 
   ;; The core unit's exports, which are the functions used by a 
   ;; Slideshow program:
@@ -82,6 +84,7 @@
      current-titlet current-para-width
      set-page-numbers-visible! done-making-slides
      set-spotlight-style!
+     pict->pre-render-pict
      clickback
      interactive
      make-slide-inset

pkgs/slideshow-pkgs/slideshow-lib/slideshow/slide.rkt

@@ -129,6 +129,7 @@
            current-titlet current-para-width
 	   set-page-numbers-visible! done-making-slides
            set-spotlight-style!
+           pict->pre-render-pict
            slide/timeout
            slide/title/timeout
            slide/center/timeout

pkgs/slideshow-pkgs/slideshow-lib/slideshow/slides-to-picts.rkt

@@ -63,6 +63,7 @@
                                           (define (set-spotlight-style! #:size [size #f] 
                                                                         #:color [color #f])
                                             (void))
+                                          (define (pict->pre-render-pict p) p)
                                           (define done-making-slides void))
                    CORE]))))
 	(parameterize ([current-namespace ns])

pkgs/slideshow-pkgs/slideshow-lib/slideshow/viewer.rkt

@@ -31,6 +31,7 @@
                       (viewer:enable-click-advance! enable-click-advance!)
                       (viewer:set-page-numbers-visible! set-page-numbers-visible!)
                       (viewer:set-spotlight-style! set-spotlight-style!)
+                      (viewer:pict->pre-render-pict pict->pre-render-pict)
                       (viewer:done-making-slides done-making-slides)))
               
       (define-accessor margin get-margin)
@@ -1238,6 +1239,18 @@
       (define c (make-object c% f))
       (define c-both (make-object two-c% f-both))
 
+      (define (viewer:pict->pre-render-pict p)
+        (case (system-type)
+          [(macosx)
+           (let ([bm (send c make-bitmap
+                           (inexact->exact (ceiling (pict-width p)))
+                           (inexact->exact (ceiling (pict-height p))))])
+             (define dc (send bm make-dc))
+             ((make-pict-drawer p) dc 0 0)
+             (send dc set-bitmap #f)
+             (refocus (lt-superimpose (ghost p) (bitmap bm)) p))]
+          [else (refocus (cc-superimpose (blank) p) p)]))
+
       (define time-update-thread #f)
       (define (start-time-update!)
         (when config:show-time?