From 83123726eb23cdfd91e16ac6286eb311df5ca999 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 23 Nov 2013 11:35:04 -0700 Subject: [PATCH] slideshow: add pict->pre-render-pict Uses `make-bitmap` from the viewer's canvas to optimize drawing. --- .../scribblings/slideshow/slides.scrbl | 7 +++++++ .../slideshow-lib/slideshow/HISTORY.txt | 3 +++ .../slideshow-pkgs/slideshow-lib/slideshow/base.rkt | 1 + .../slideshow-pkgs/slideshow-lib/slideshow/core.rkt | 3 +++ .../slideshow-pkgs/slideshow-lib/slideshow/info.rkt | 2 +- pkgs/slideshow-pkgs/slideshow-lib/slideshow/sig.rkt | 5 ++++- .../slideshow-lib/slideshow/slide.rkt | 1 + .../slideshow-lib/slideshow/slides-to-picts.rkt | 1 + .../slideshow-lib/slideshow/viewer.rkt | 13 +++++++++++++ 9 files changed, 34 insertions(+), 2 deletions(-) diff --git a/pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/slides.scrbl b/pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/slides.scrbl index 76c5ff9327..ac1a18d0f7 100644 --- a/pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/slides.scrbl +++ b/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? diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/HISTORY.txt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/HISTORY.txt index 264d894241..7fd2767f3c 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/HISTORY.txt +++ b/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 diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/base.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/base.rkt index a3629fccf2..20ad947c97 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/base.rkt +++ b/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)) diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/core.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/core.rkt index a3333f0fd2..94660504fc 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/core.rkt +++ b/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) diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/info.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/info.rkt index c38491f46c..0172480e37 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/info.rkt +++ b/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") diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/sig.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/sig.rkt index c816b46280..b582695357 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/sig.rkt +++ b/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 diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slide.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slide.rkt index 94dab47b7f..ecb077f182 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slide.rkt +++ b/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 diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slides-to-picts.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slides-to-picts.rkt index d9a5e5418f..cdbf0fa64f 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slides-to-picts.rkt +++ b/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]) diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/viewer.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/viewer.rkt index 60b1f6d6ae..1800002d2e 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/viewer.rkt +++ b/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?